X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FSchema%2FTable.pm;h=50a185556dc6cb187d1ab8779c56a8201743bf00;hb=821a0fde221f5accf93e3f65efa77b5a6733cb5e;hp=6aa6faedb790c45048c089e6e45af5b14a5fe5ca;hpb=9371be50d82c80f4b62e1a682818ebae69fa9583;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Schema/Table.pm b/lib/SQL/Translator/Schema/Table.pm index 6aa6fae..50a1855 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.28 2004-11-05 13:19:31 grommit Exp $ +# $Id$ # ---------------------------------------------------------------------- # Copyright (C) 2002-4 SQLFairy Authors # @@ -51,8 +51,7 @@ use base 'SQL::Translator::Schema::Object'; use vars qw( $VERSION $FIELD_ORDER ); -$VERSION = sprintf "%d.%02d", q$Revision: 1.28 $ =~ /(\d+)\.(\d+)/; - +$VERSION = sprintf "%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/; # Stringify to our name, being careful not to pass any args through so we don't # accidentally set it to undef. We also have to tweak bool so the object is @@ -113,7 +112,7 @@ C object. my %args = @_; $args{'table'} = $self; $constraint = $constraint_class->new( \%args ) or - return $self->error( $constraint_class->error ); + return $self->error( $constraint_class->error ); } # @@ -124,6 +123,9 @@ C object. my $pk = $self->primary_key; if ( $pk && $constraint->type eq PRIMARY_KEY ) { $self->primary_key( $constraint->fields ); + $pk->name($constraint->name) if $constraint->name; + my %extra = $constraint->extra; + $pk->extra(%extra) if keys %extra; $constraint = $pk; $ok = 0; } @@ -164,6 +166,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 @@ -198,12 +237,51 @@ C object. $index = $index_class->new( \%args ) or return $self->error( $index_class->error ); } - + foreach my $ex_index ($self->get_indices) { + return if ($ex_index->equals($index)); + } push @{ $self->{'indices'} }, $index; return $index; } # ---------------------------------------------------------------------- +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 @@ -257,6 +335,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 { @@ -361,6 +491,14 @@ Returns a field by the name provided. my $self = shift; my $field_name = shift or return $self->error('No field name'); + my $case_insensitive = shift; + if ( $case_insensitive ) { + $field_name = uc($field_name); + foreach my $field ( keys %{$self->{fields}} ) { + return $self->{fields}{$field} if $field_name eq uc($field); + } + return $self->error(qq[Field "$field_name" does not exist]); + } return $self->error( qq[Field "$field_name" does not exist] ) unless exists $self->{'fields'}{ $field_name }; return $self->{'fields'}{ $field_name }; @@ -715,7 +853,7 @@ an array or array reference. push @{ $self->{'options'} }, @$options; if ( ref $self->{'options'} ) { - return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'}; + return wantarray ? @{ $self->{'options'} || [] } : ($self->{'options'} || ''); } else { return wantarray ? () : []; @@ -773,6 +911,95 @@ avoid the overload magic of the Field objects returned by the get_fields method. } # ---------------------------------------------------------------------- +sub equals { + +=pod + +=head2 equals + +Determines if this table is the same as another + + my $isIdentical = $table1->equals( $table2 ); + +=cut + + my $self = shift; + my $other = shift; + my $case_insensitive = shift; + + return 0 unless $self->SUPER::equals($other); + return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name; + return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options); + return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra); + + # Fields + # Go through our fields + my %checkedFields; + foreach my $field ( $self->get_fields ) { + my $otherField = $other->get_field($field->name, $case_insensitive); + return 0 unless $field->equals($otherField, $case_insensitive); + $checkedFields{$field->name} = 1; + } + # Go through the other table's fields + foreach my $otherField ( $other->get_fields ) { + next if $checkedFields{$otherField->name}; + return 0; + } + + # Constraints + # Go through our constraints + my %checkedConstraints; +CONSTRAINT: + foreach my $constraint ( $self->get_constraints ) { + foreach my $otherConstraint ( $other->get_constraints ) { + if ( $constraint->equals($otherConstraint, $case_insensitive) ) { + $checkedConstraints{$otherConstraint} = 1; + next CONSTRAINT; + } + } + return 0; + } + # Go through the other table's constraints +CONSTRAINT2: + foreach my $otherConstraint ( $other->get_constraints ) { + next if $checkedFields{$otherConstraint}; + foreach my $constraint ( $self->get_constraints ) { + if ( $otherConstraint->equals($constraint, $case_insensitive) ) { + next CONSTRAINT2; + } + } + return 0; + } + + # Indices + # Go through our indices + my %checkedIndices; +INDEX: + foreach my $index ( $self->get_indices ) { + foreach my $otherIndex ( $other->get_indices ) { + if ( $index->equals($otherIndex, $case_insensitive) ) { + $checkedIndices{$otherIndex} = 1; + next INDEX; + } + } + return 0; + } + # Go through the other table's indices +INDEX2: + foreach my $otherIndex ( $other->get_indices ) { + next if $checkedIndices{$otherIndex}; + foreach my $index ( $self->get_indices ) { + if ( $otherIndex->equals($index, $case_insensitive) ) { + next INDEX2; + } + } + return 0; + } + + return 1; +} + +# ---------------------------------------------------------------------- =head1 LOOKUP METHODS