view release on metacpan or  search on metacpan

lib/SQL/Translator/Schema.pm  view on Meta::CPAN

  }

  return $g;
}

has _tables => (is => 'ro', init_arg => undef, default => quote_sub(q{ +{} }));

sub add_table {

=pod

=head2 add_table

Add a table object.  Returns the new L<SQL::Translator::Schema::Table> object.
The "name" parameter is required.  If you try to create a table with the
same name as an existing table, you will get an error and the table will
not be created.

  my $t1 = $schema->add_table( name => 'foo' ) or die $schema->error;
  my $t2 = SQL::Translator::Schema::Table->new( name => 'bar' );
  $t2    = $schema->add_table( $table_bar ) or die $schema->error;

=cut

  my $self        = shift;
  my $table_class = 'SQL::Translator::Schema::Table';
  my $table;

  if (UNIVERSAL::isa($_[0], $table_class)) {
    $table = shift;
    $table->schema($self);
  } else {
    my %args = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_;
    $args{'schema'} = $self;
    $table = $table_class->new(\%args)
        or return $self->error($table_class->error);
  }

  $table->order(++$self->_order->{table});

  # We know we have a name as the Table->new above errors if none given.
  my $table_name = $table->name;

  if (defined $self->_tables->{$table_name}) {
    return $self->error(qq[Can't use table name "$table_name": table exists]);
  } else {
    $self->_tables->{$table_name} = $table;
  }

  return $table;
}

sub drop_table {

=pod

=head2 drop_table

Remove a table from the schema. Returns the table object if the table was found
and removed, an error otherwise. The single parameter can be either a table
name or an L<SQL::Translator::Schema::Table> object. The "cascade" parameter
can be set to 1 to also drop all triggers on the table, default is 0.

  $schema->drop_table('mytable');
  $schema->drop_table('mytable', cascade => 1);

=cut

  my $self        = shift;
  my $table_class = 'SQL::Translator::Schema::Table';
  my $table_name;

  if (UNIVERSAL::isa($_[0], $table_class)) {
    $table_name = shift->name;
  } else {
    $table_name = shift;
  }
  my %args    = @_;
  my $cascade = $args{'cascade'};

  if (!exists $self->_tables->{$table_name}) {
    return $self->error(qq[Can't drop table: "$table_name" doesn't exist]);
  }

  my $table = delete $self->_tables->{$table_name};

  if ($cascade) {

    # Drop all triggers on this table
    $self->drop_trigger() for (grep { $_->on_table eq $table_name } values %{ $self->_triggers });
  }
  return $table;
}

has _procedures => (is => 'ro', init_arg => undef, default => quote_sub(q{ +{} }));

sub add_procedure {

=pod

=head2 add_procedure

Add a procedure object.  Returns the new L<SQL::Translator::Schema::Procedure>
object.  The "name" parameter is required.  If you try to create a procedure
with the same name as an existing procedure, you will get an error and the
procedure will not be created.

  my $p1 = $schema->add_procedure( name => 'foo' );
  my $p2 = SQL::Translator::Schema::Procedure->new( name => 'bar' );
  $p2    = $schema->add_procedure( $procedure_bar ) or die $schema->error;

=cut

  my $self            = shift;
  my $procedure_class = 'SQL::Translator::Schema::Procedure';
  my $procedure;

  if (UNIVERSAL::isa($_[0], $procedure_class)) {
    $procedure = shift;
    $procedure->schema($self);
  } else {
    my %args = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_;
    $args{'schema'} = $self;
    return $self->error('No procedure name') unless $args{'name'};
    $procedure = $procedure_class->new(\%args)
        or return $self->error($procedure_class->error);
  }

  $procedure->order(++$self->_order->{proc});
  my $procedure_name = $procedure->name
      or return $self->error('No procedure name');

  if (defined $self->_procedures->{$procedure_name}) {
    return $self->error(qq[Can't create procedure: "$procedure_name" exists]);
  } else {
    $self->_procedures->{$procedure_name} = $procedure;
  }

  return $procedure;
}

sub drop_procedure {

=pod

=head2 drop_procedure