From: Jess Robinson Date: Sat, 27 Nov 2004 16:33:33 +0000 (+0000) Subject: Drop functions X-Git-Tag: v0.11008~587 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=650f87eb1975f9fd8214abde49e383a960335b37;p=dbsrgits%2FSQL-Translator.git Drop functions --- diff --git a/lib/SQL/Translator/Schema.pm b/lib/SQL/Translator/Schema.pm index 576526a..478feb2 100644 --- a/lib/SQL/Translator/Schema.pm +++ b/lib/SQL/Translator/Schema.pm @@ -1,7 +1,7 @@ package SQL::Translator::Schema; # ---------------------------------------------------------------------- -# $Id: Schema.pm,v 1.20 2004-11-05 13:19:31 grommit Exp $ +# $Id: Schema.pm,v 1.21 2004-11-27 16:32:16 schiffbruechige Exp $ # ---------------------------------------------------------------------- # Copyright (C) 2002-4 SQLFairy Authors # @@ -54,7 +54,7 @@ use SQL::Translator::Utils 'parse_list_arg'; use base 'SQL::Translator::Schema::Object'; use vars qw[ $VERSION $TABLE_ORDER $VIEW_ORDER $TRIGGER_ORDER $PROC_ORDER ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.20 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.21 $ =~ /(\d+)\.(\d+)/; # ---------------------------------------------------------------------- @@ -126,17 +126,61 @@ not be created. } # ---------------------------------------------------------------------- +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 C 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 } + @{ $self->{'triggers'}} + ); + } + return $table; +} + +# ---------------------------------------------------------------------- sub add_procedure { =pod =head2 add_procedure -Add a procedure object. Returns the new -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. +Add a procedure object. Returns the new 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' ); @@ -175,6 +219,41 @@ be created. return $procedure; } +# ---------------------------------------------------------------------- +sub drop_procedure { + +=pod + +=head2 drop_procedure + +Remove a procedure from the schema. Returns the procedure object if the +procedure was found and removed, an error otherwise. The single parameter +can be either a procedure name or an C +object. + + $schema->drop_procedure('myprocedure'); + +=cut + + my $self = shift; + my $proc_class = 'SQL::Translator::Schema::Procedure'; + my $proc_name; + + if ( UNIVERSAL::isa( $_[0], $proc_class ) ) { + $proc_name = shift->name; + } + else { + $proc_name = shift; + } + + if ( ! exists $self->{'procedures'}{ $proc_name } ) { + return $self->error(qq[Can't drop procedure: $proc_name" doesn't exist]); + } + + my $proc = delete $self->{'procedures'}{ $proc_name }; + + return $proc; +} # ---------------------------------------------------------------------- sub add_trigger { @@ -222,6 +301,40 @@ not be created. return $trigger; } +# ---------------------------------------------------------------------- +sub drop_trigger { + +=pod + +=head2 drop_trigger + +Remove a trigger from the schema. Returns the trigger object if the trigger was +found and removed, an error otherwise. The single parameter can be either a +trigger name or an C object. + + $schema->drop_trigger('mytrigger'); + +=cut + + my $self = shift; + my $trigger_class = 'SQL::Translator::Schema::Trigger'; + my $trigger_name; + + if ( UNIVERSAL::isa( $_[0], $trigger_class ) ) { + $trigger_name = shift->name; + } + else { + $trigger_name = shift; + } + + if ( ! exists $self->{'triggers'}{ $trigger_name } ) { + return $self->error(qq[Can't drop trigger: $trigger_name" doesn't exist]); + } + + my $trigger = delete $self->{'triggers'}{ $trigger_name }; + + return $trigger; +} # ---------------------------------------------------------------------- sub add_view { @@ -270,6 +383,41 @@ not be created. } # ---------------------------------------------------------------------- +sub drop_view { + +=pod + +=head2 drop_view + +Remove a view from the schema. Returns the view object if the view was found +and removed, an error otherwise. The single parameter can be either a view +name or an C object. + + $schema->drop_view('myview'); + +=cut + + my $self = shift; + my $view_class = 'SQL::Translator::Schema::View'; + my $view_name; + + if ( UNIVERSAL::isa( $_[0], $view_class ) ) { + $view_name = shift->name; + } + else { + $view_name = shift; + } + + if ( ! exists $self->{'views'}{ $view_name } ) { + return $self->error(qq[Can't drop view: $view_name" doesn't exist]); + } + + my $view = delete $self->{'views'}{ $view_name }; + + return $view; +} + +# ---------------------------------------------------------------------- sub database { =pod @@ -519,7 +667,7 @@ tables. Accepts the following arguments: =over 4 -=item * join_pk_only +=item * join_pk_only A True or False argument which determins whether or not to perform the joins from primary keys to fields of the same name in other tables @@ -573,9 +721,9 @@ A list of fields to skip in the joins reference_table => $table2->name, reference_fields => $field, ); - } + } } - } + } return 1; } diff --git a/lib/SQL/Translator/Schema/Table.pm b/lib/SQL/Translator/Schema/Table.pm index b9c1247..22bf069 100644 --- a/lib/SQL/Translator/Schema/Table.pm +++ b/lib/SQL/Translator/Schema/Table.pm @@ -1,7 +1,7 @@ package SQL::Translator::Schema::Table; # ---------------------------------------------------------------------- -# $Id: Table.pm,v 1.29 2004-11-05 15:03:10 grommit Exp $ +# $Id: Table.pm,v 1.30 2004-11-27 16:32:46 schiffbruechige Exp $ # ---------------------------------------------------------------------- # Copyright (C) 2002-4 SQLFairy Authors # @@ -51,7 +51,7 @@ use base 'SQL::Translator::Schema::Object'; use vars qw( $VERSION $FIELD_ORDER ); -$VERSION = sprintf "%d.%02d", q$Revision: 1.29 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.30 $ =~ /(\d+)\.(\d+)/; # Stringify to our name, being careful not to pass any args through so we don't @@ -167,6 +167,43 @@ C object. } # ---------------------------------------------------------------------- +sub drop_constraint { + +=pod + +=head2 drop_constraint + +Remove a constraint from the table. Returns the constraint object if the index +was found and removed, an error otherwise. The single parameter can be either +an index name or an C object. + + $table->drop_constraint('myconstraint'); + +=cut + + my $self = shift; + my $constraint_class = 'SQL::Translator::Schema::Constraint'; + my $constraint_name; + + if ( UNIVERSAL::isa( $_[0], $constraint_class ) ) { + $constraint_name = shift->name; + } + else { + $constraint_name = shift; + } + + if ( ! grep { $_->name eq $constraint_name } @ { $self->{'constraints'} } ) { + return $self->error(qq[Can't drop constraint: "$constraint_name" doesn't exist]); + } + + my @cs = @{ $self->{'constraints'} }; + my ($constraint_id) = grep { $cs[$_]->name eq $constraint_name } (0..$#cs); + my $constraint = splice(@{$self->{'constraints'}}, $constraint_id, 1); + + return $constraint; +} + +# ---------------------------------------------------------------------- sub add_index { =pod @@ -207,6 +244,43 @@ C object. } # ---------------------------------------------------------------------- +sub drop_index { + +=pod + +=head2 drop_index + +Remove an index from the table. Returns the index object if the index was +found and removed, an error otherwise. The single parameter can be either +an index name of an C object. + + $table->drop_index('myindex'); + +=cut + + my $self = shift; + my $index_class = 'SQL::Translator::Schema::Index'; + my $index_name; + + if ( UNIVERSAL::isa( $_[0], $index_class ) ) { + $index_name = shift->name; + } + else { + $index_name = shift; + } + + if ( ! grep { $_->name eq $index_name } @{ $self->{'indices'} }) { + return $self->error(qq[Can't drop index: "$index_name" doesn't exist]); + } + + my @is = @{ $self->{'indices'} }; + my ($index_id) = grep { $is[$_]->name eq $index_name } (0..$#is); + my $index = splice(@{$self->{'indices'}}, $index_id, 1); + + return $index; +} + +# ---------------------------------------------------------------------- sub add_field { =pod @@ -260,6 +334,58 @@ existing field, you will get an error and the field will not be created. return $field; } +# ---------------------------------------------------------------------- +sub drop_field { + +=pod + +=head2 drop_field + +Remove a field from the table. Returns the field object if the field was +found and removed, an error otherwise. The single parameter can be either +a field name or an C object. + + $table->drop_field('myfield'); + +=cut + + my $self = shift; + my $field_class = 'SQL::Translator::Schema::Field'; + my $field_name; + + if ( UNIVERSAL::isa( $_[0], $field_class ) ) { + $field_name = shift->name; + } + else { + $field_name = shift; + } + my %args = @_; + my $cascade = $args{'cascade'}; + + if ( ! exists $self->{'fields'}{ $field_name } ) { + return $self->error(qq[Can't drop field: "$field_name" doesn't exists]); + } + + my $field = delete $self->{'fields'}{ $field_name }; + + if ( $cascade ) { + # Remove this field from all indices using it + foreach my $i ($self->get_indices()) { + my @fs = $i->fields(); + @fs = grep { $_ ne $field->name } @fs; + $i->fields(@fs); + } + + # Remove this field from all constraints using it + foreach my $c ($self->get_constraints()) { + my @cs = $c->fields(); + @cs = grep { $_ ne $field->name } @cs; + $c->fields(@cs); + } + } + + return $field; +} # ---------------------------------------------------------------------- sub comments { diff --git a/t/13schema.t b/t/13schema.t index 1c776e6..ec08a02 100644 --- a/t/13schema.t +++ b/t/13schema.t @@ -4,7 +4,7 @@ $| = 1; use strict; -use Test::More tests => 206; +use Test::More tests => 232; use SQL::Translator::Schema::Constants; require_ok( 'SQL::Translator' ); @@ -56,16 +56,28 @@ require_ok( 'SQL::Translator::Schema' ); '... because "foo" exists' ); $redundant_table = $schema->add_table(name => ''); - is( $redundant_table, undef, qq[Can't add an anonymouse table...] ); + is( $redundant_table, undef, qq[Can't add an anonymous table...] ); like( $schema->error, qr/No table name/i, - '... because if has no name ' ); + '... because it has no name ' ); $redundant_table = SQL::Translator::Schema::Table->new(name => ''); - is( $redundant_table, undef, qq[Can't create an anonymouse table] ); + is( $redundant_table, undef, qq[Can't create an anonymous table] ); like( SQL::Translator::Schema::Table->error, qr/No table name/i, - '... because if has no name ' ); + '... because it has no name ' ); # + # $schema-> drop_table + # + my $dropped_table = $schema->drop_table($foo_table->name, cascade => 1); + isa_ok($dropped_table, 'SQL::Translator::Schema::Table', 'Dropped table "foo"' ); + $schema->add_table($foo_table); + my $dropped_table2 = $schema->drop_table($foo_table, cascade => 1); + isa_ok($dropped_table2, 'SQL::Translator::Schema::Table', 'Dropped table "foo" by object' ); + my $dropped_table3 = $schema->drop_table($foo_table->name, cascade => 1); + like( $schema->error, qr/doesn't exist/, qq[Can't drop non-existant table "foo"] ); + + $schema->add_table($foo_table); + # # Table default new # is( $foo_table->name, 'foo', 'Table name is "foo"' ); @@ -156,6 +168,19 @@ require_ok( 'SQL::Translator::Schema' ); 'field_names is "foo,f2"' ); # + # $table-> drop_field + # + my $dropped_field = $person_table->drop_field($f2->name, cascade => 1); + isa_ok($dropped_field, 'SQL::Translator::Schema::Field', 'Dropped field "f2"' ); + $person_table->add_field($f2); + my $dropped_field2 = $person_table->drop_field($f2, cascade => 1); + isa_ok($dropped_field2, 'SQL::Translator::Schema::Field', 'Dropped field "f2" by object' ); + my $dropped_field3 = $person_table->drop_field($f2->name, cascade => 1); + like( $person_table->error, qr/doesn't exist/, qq[Can't drop non-existant field "f2"] ); + + $person_table->add_field($f2); + + # # Field methods # is( $f1->name('person_name'), 'person_name', @@ -225,6 +250,20 @@ require_ok( 'SQL::Translator::Schema' ); is( $indices->[1]->name, 'bar', '"bar" index' ); # + # $table-> drop_index + # + my $dropped_index = $person_table->drop_index($index1->name); + isa_ok($dropped_index, 'SQL::Translator::Schema::Index', 'Dropped index "foo"' ); + $person_table->add_index($index1); + my $dropped_index2 = $person_table->drop_index($index1); + isa_ok($dropped_index2, 'SQL::Translator::Schema::Index', 'Dropped index "foo" by object' ); + is($dropped_index2->name, $index1->name, 'Dropped correct index "foo"'); + my $dropped_index3 = $person_table->drop_index($index1->name); + like( $person_table->error, qr/doesn't exist/, qq[Can't drop non-existant index "foo"] ); + + $person_table->add_index($index1); + + # # Constraint # my @constraints = $person_table->get_constraints; @@ -292,6 +331,20 @@ require_ok( 'SQL::Translator::Schema' ); is( $constraints->[1]->name, 'bar', '"bar" constraint' ); # + # $table-> drop_constraint + # + my $dropped_con = $person_table->drop_constraint($constraint1->name); + isa_ok($dropped_con, 'SQL::Translator::Schema::Constraint', 'Dropped constraint "foo"' ); + $person_table->add_constraint($constraint1); + my $dropped_con2 = $person_table->drop_constraint($constraint1); + isa_ok($dropped_con2, 'SQL::Translator::Schema::Constraint', 'Dropped constraint "foo" by object' ); + is($dropped_con2->name, $constraint1->name, 'Dropped correct constraint "foo"'); + my $dropped_con3 = $person_table->drop_constraint($constraint1->name); + like( $person_table->error, qr/doesn't exist/, qq[Can't drop non-existant constraint "foo"] ); + + $person_table->add_constraint($constraint1); + + # # View # my $view = $schema->add_view( name => 'view1' ) or warn $schema->error; @@ -309,6 +362,20 @@ require_ok( 'SQL::Translator::Schema' ); like( $schema->error, qr/can't create view/i, '... because it exists' ); # + # $schema-> drop_view + # + my $dropped_view = $schema->drop_view($view->name); + isa_ok($dropped_view, 'SQL::Translator::Schema::View', 'Dropped view "view1"' ); + $schema->add_view($view); + my $dropped_view2 = $schema->drop_view($view); + isa_ok($dropped_view2, 'SQL::Translator::Schema::View', 'Dropped view "view1" by object' ); + is($dropped_view2->name, $view->name, 'Dropped correct view "view1"'); + my $dropped_view3 = $schema->drop_view($view->name); + like( $schema->error, qr/doesn't exist/, qq[Can't drop non-existant view "view1"] ); + + $schema->add_view($view); + + # # $schema->get_* # my $bad_table = $schema->get_table; @@ -557,8 +624,22 @@ require_ok( 'SQL::Translator::Schema' ); my $t1 = $s->get_trigger( $name ); isa_ok( $t1, 'SQL::Translator::Schema::Trigger', 'Trigger' ); is( $t1->name, $name, qq[Name is "$name"] ); -} + # + # $schema-> drop_trigger + # + my $dropped_trig = $s->drop_trigger($t->name); + isa_ok($dropped_trig, 'SQL::Translator::Schema::Trigger', 'Dropped trigger "foo_trigger"' ); + $s->add_trigger($t); + my $dropped_trig2 = $s->drop_trigger($t); + isa_ok($dropped_trig2, 'SQL::Translator::Schema::Trigger', 'Dropped trigger "foo_trigger" by object' ); + is($dropped_trig2->name, $t->name, 'Dropped correct trigger "foo_trigger"'); + my $dropped_trig3 = $s->drop_trigger($t->name); + like( $s->error, qr/doesn't exist/, qq[Can't drop non-existant trigger "foo_trigger"] ); + + $s->add_trigger($t); +} + # # Procedure # @@ -591,4 +672,18 @@ require_ok( 'SQL::Translator::Schema' ); my $p1 = $s->get_procedure( $name ); isa_ok( $p1, 'SQL::Translator::Schema::Procedure', 'Procedure' ); is( $p1->name, $name, qq[Name is "$name"] ); + + # + # $schema-> drop_procedure + # + my $dropped_proc = $s->drop_procedure($p->name); + isa_ok($dropped_proc, 'SQL::Translator::Schema::Procedure', 'Dropped procedure "foo_proc"' ); + $s->add_procedure($p); + my $dropped_proc2 = $s->drop_procedure($p); + isa_ok($dropped_proc2, 'SQL::Translator::Schema::Procedure', 'Dropped procedure "foo_proc" by object' ); + is($dropped_proc2->name, $p->name, 'Dropped correct procedure "foo_proc"'); + my $dropped_proc3 = $s->drop_procedure($p->name); + like( $s->error, qr/doesn't exist/, qq[Can't drop non-existant procedure "foo_proc"] ); + + $s->add_procedure($p); }