1 package SQL::Translator::Schema::Table;
3 # ----------------------------------------------------------------------
4 # Copyright (C) 2002-2009 SQLFairy Authors
6 # This program is free software; you can redistribute it and/or
7 # modify it under the terms of the GNU General Public License as
8 # published by the Free Software Foundation; version 2.
10 # This program is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 # General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
19 # -------------------------------------------------------------------
25 SQL::Translator::Schema::Table - SQL::Translator table object
29 use SQL::Translator::Schema::Table;
30 my $table = SQL::Translator::Schema::Table->new( name => 'foo' );
34 C<SQL::Translator::Schema::Table> is the table object.
41 use SQL::Translator::Utils 'parse_list_arg';
42 use SQL::Translator::Schema::Constants;
43 use SQL::Translator::Schema::Constraint;
44 use SQL::Translator::Schema::Field;
45 use SQL::Translator::Schema::Index;
48 use base 'SQL::Translator::Schema::Object';
50 use vars qw( $VERSION );
54 # Stringify to our name, being careful not to pass any args through so we don't
55 # accidentally set it to undef. We also have to tweak bool so the object is
56 # still true when it doesn't have a name (which shouldn't happen!).
58 '""' => sub { shift->name },
59 'bool' => sub { $_[0]->name || $_[0] },
63 __PACKAGE__->_attributes( qw/schema name comments options order/ );
71 my $table = SQL::Translator::Schema::Table->new(
80 my $self = $class->SUPER::new (@_)
83 $self->{_order} = { map { $_ => 0 } qw/
96 Add a constraint to the table. Returns the newly created
97 C<SQL::Translator::Schema::Constraint> object.
99 my $c1 = $table->add_constraint(
102 fields => [ 'foo_id' ],
105 my $c2 = SQL::Translator::Schema::Constraint->new( name => 'uniq' );
106 $c2 = $table->add_constraint( $constraint );
111 my $constraint_class = 'SQL::Translator::Schema::Constraint';
114 if ( UNIVERSAL::isa( $_[0], $constraint_class ) ) {
116 $constraint->table( $self );
120 $args{'table'} = $self;
121 $constraint = $constraint_class->new( \%args ) or
122 return $self->error( $constraint_class->error );
126 # If we're trying to add a PK when one is already defined,
127 # then just add the fields to the existing definition.
130 my $pk = $self->primary_key;
131 if ( $pk && $constraint->type eq PRIMARY_KEY ) {
132 $self->primary_key( $constraint->fields );
133 $pk->name($constraint->name) if $constraint->name;
134 my %extra = $constraint->extra;
135 $pk->extra(%extra) if keys %extra;
139 elsif ( $constraint->type eq PRIMARY_KEY ) {
140 for my $fname ( $constraint->fields ) {
141 if ( my $f = $self->get_field( $fname ) ) {
142 $f->is_primary_key( 1 );
147 # See if another constraint of the same type
148 # covers the same fields. -- This doesn't work! ky
150 # elsif ( $constraint->type ne CHECK_C ) {
151 # my @field_names = $constraint->fields;
153 # grep { $_->type eq $constraint->type }
154 # $self->get_constraints
156 # my %fields = map { $_, 1 } $c->fields;
157 # for my $field_name ( @field_names ) {
158 # if ( $fields{ $field_name } ) {
169 push @{ $self->{'constraints'} }, $constraint;
175 sub drop_constraint {
179 =head2 drop_constraint
181 Remove a constraint from the table. Returns the constraint object if the index
182 was found and removed, an error otherwise. The single parameter can be either
183 an index name or an C<SQL::Translator::Schema::Constraint> object.
185 $table->drop_constraint('myconstraint');
190 my $constraint_class = 'SQL::Translator::Schema::Constraint';
193 if ( UNIVERSAL::isa( $_[0], $constraint_class ) ) {
194 $constraint_name = shift->name;
197 $constraint_name = shift;
200 if ( ! grep { $_->name eq $constraint_name } @ { $self->{'constraints'} } ) {
201 return $self->error(qq[Can't drop constraint: "$constraint_name" doesn't exist]);
204 my @cs = @{ $self->{'constraints'} };
205 my ($constraint_id) = grep { $cs[$_]->name eq $constraint_name } (0..$#cs);
206 my $constraint = splice(@{$self->{'constraints'}}, $constraint_id, 1);
217 Add an index to the table. Returns the newly created
218 C<SQL::Translator::Schema::Index> object.
220 my $i1 = $table->add_index(
222 fields => [ 'name' ],
226 my $i2 = SQL::Translator::Schema::Index->new( name => 'id' );
227 $i2 = $table->add_index( $index );
232 my $index_class = 'SQL::Translator::Schema::Index';
235 if ( UNIVERSAL::isa( $_[0], $index_class ) ) {
237 $index->table( $self );
241 $args{'table'} = $self;
242 $index = $index_class->new( \%args ) or return
243 $self->error( $index_class->error );
245 foreach my $ex_index ($self->get_indices) {
246 return if ($ex_index->equals($index));
248 push @{ $self->{'indices'} }, $index;
258 Remove an index from the table. Returns the index object if the index was
259 found and removed, an error otherwise. The single parameter can be either
260 an index name of an C<SQL::Translator::Schema::Index> object.
262 $table->drop_index('myindex');
267 my $index_class = 'SQL::Translator::Schema::Index';
270 if ( UNIVERSAL::isa( $_[0], $index_class ) ) {
271 $index_name = shift->name;
277 if ( ! grep { $_->name eq $index_name } @{ $self->{'indices'} }) {
278 return $self->error(qq[Can't drop index: "$index_name" doesn't exist]);
281 my @is = @{ $self->{'indices'} };
282 my ($index_id) = grep { $is[$_]->name eq $index_name } (0..$#is);
283 my $index = splice(@{$self->{'indices'}}, $index_id, 1);
294 Add an field to the table. Returns the newly created
295 C<SQL::Translator::Schema::Field> object. The "name" parameter is
296 required. If you try to create a field with the same name as an
297 existing field, you will get an error and the field will not be created.
299 my $f1 = $table->add_field(
301 data_type => 'integer',
305 my $f2 = SQL::Translator::Schema::Field->new(
309 $f2 = $table->add_field( $field2 ) or die $table->error;
314 my $field_class = 'SQL::Translator::Schema::Field';
317 if ( UNIVERSAL::isa( $_[0], $field_class ) ) {
319 $field->table( $self );
323 $args{'table'} = $self;
324 $field = $field_class->new( \%args ) or return
325 $self->error( $field_class->error );
328 $field->order( ++$self->{_order}{field} );
329 # We know we have a name as the Field->new above errors if none given.
330 my $field_name = $field->name;
332 if ( exists $self->{'fields'}{ $field_name } ) {
333 return $self->error(qq[Can't create field: "$field_name" exists]);
336 $self->{'fields'}{ $field_name } = $field;
348 Remove a field from the table. Returns the field object if the field was
349 found and removed, an error otherwise. The single parameter can be either
350 a field name or an C<SQL::Translator::Schema::Field> object.
352 $table->drop_field('myfield');
357 my $field_class = 'SQL::Translator::Schema::Field';
360 if ( UNIVERSAL::isa( $_[0], $field_class ) ) {
361 $field_name = shift->name;
367 my $cascade = $args{'cascade'};
369 if ( ! exists $self->{'fields'}{ $field_name } ) {
370 return $self->error(qq[Can't drop field: "$field_name" doesn't exists]);
373 my $field = delete $self->{'fields'}{ $field_name };
376 # Remove this field from all indices using it
377 foreach my $i ($self->get_indices()) {
378 my @fs = $i->fields();
379 @fs = grep { $_ ne $field->name } @fs;
383 # Remove this field from all constraints using it
384 foreach my $c ($self->get_constraints()) {
385 my @cs = $c->fields();
386 @cs = grep { $_ ne $field->name } @cs;
400 Get or set the comments on a table. May be called several times to
401 set and it will accumulate the comments. Called in an array context,
402 returns each comment individually; called in a scalar context, returns
403 all the comments joined on newlines.
405 $table->comments('foo');
406 $table->comments('bar');
407 print join( ', ', $table->comments ); # prints "foo, bar"
412 my @comments = ref $_[0] ? @{ $_[0] } : @_;
414 for my $arg ( @comments ) {
415 $arg = $arg->[0] if ref $arg;
416 push @{ $self->{'comments'} }, $arg if defined $arg && $arg;
419 if ( @{ $self->{'comments'} || [] } ) {
421 ? @{ $self->{'comments'} }
422 : join( "\n", @{ $self->{'comments'} } )
426 return wantarray ? () : undef;
430 sub get_constraints {
434 =head2 get_constraints
436 Returns all the constraint objects as an array or array reference.
438 my @constraints = $table->get_constraints;
444 if ( ref $self->{'constraints'} ) {
446 ? @{ $self->{'constraints'} } : $self->{'constraints'};
449 $self->error('No constraints');
450 return wantarray ? () : undef;
460 Returns all the index objects as an array or array reference.
462 my @indices = $table->get_indices;
468 if ( ref $self->{'indices'} ) {
470 ? @{ $self->{'indices'} }
471 : $self->{'indices'};
474 $self->error('No indices');
475 return wantarray ? () : undef;
485 Returns a field by the name provided.
487 my $field = $table->get_field('foo');
492 my $field_name = shift or return $self->error('No field name');
493 my $case_insensitive = shift;
494 if ( $case_insensitive ) {
495 $field_name = uc($field_name);
496 foreach my $field ( keys %{$self->{fields}} ) {
497 return $self->{fields}{$field} if $field_name eq uc($field);
499 return $self->error(qq[Field "$field_name" does not exist]);
501 return $self->error( qq[Field "$field_name" does not exist] ) unless
502 exists $self->{'fields'}{ $field_name };
503 return $self->{'fields'}{ $field_name };
512 Returns all the field objects as an array or array reference.
514 my @fields = $table->get_fields;
521 sort { $a->[0] <=> $b->[0] }
522 map { [ $_->order, $_ ] }
523 values %{ $self->{'fields'} || {} };
526 return wantarray ? @fields : \@fields;
529 $self->error('No fields');
530 return wantarray ? () : undef;
540 Determine whether the view is valid or not.
542 my $ok = $view->is_valid;
547 return $self->error('No name') unless $self->name;
548 return $self->error('No fields') unless $self->get_fields;
551 $self->get_fields, $self->get_indices, $self->get_constraints
553 return $object->error unless $object->is_valid;
559 sub is_trivial_link {
563 =head2 is_trivial_link
565 True if table has no data (non-key) fields and only uses single key joins.
570 return 0 if $self->is_data;
571 return $self->{'is_trivial_link'} if defined $self->{'is_trivial_link'};
573 $self->{'is_trivial_link'} = 1;
577 foreach my $field ( $self->get_fields ) {
578 next unless $field->is_foreign_key;
579 $fk{$field->foreign_key_reference->reference_table}++;
582 foreach my $referenced (keys %fk){
583 if($fk{$referenced} > 1){
584 $self->{'is_trivial_link'} = 0;
589 return $self->{'is_trivial_link'};
599 Returns true if the table has some non-key fields.
604 return $self->{'is_data'} if defined $self->{'is_data'};
606 $self->{'is_data'} = 0;
608 foreach my $field ( $self->get_fields ) {
609 if ( !$field->is_primary_key and !$field->is_foreign_key ) {
610 $self->{'is_data'} = 1;
611 return $self->{'is_data'};
615 return $self->{'is_data'};
624 Determine whether the table can link two arg tables via many-to-many.
626 my $ok = $table->can_link($table1,$table2);
630 my ( $self, $table1, $table2 ) = @_;
632 return $self->{'can_link'}{ $table1->name }{ $table2->name }
633 if defined $self->{'can_link'}{ $table1->name }{ $table2->name };
635 if ( $self->is_data == 1 ) {
636 $self->{'can_link'}{ $table1->name }{ $table2->name } = [0];
637 $self->{'can_link'}{ $table2->name }{ $table1->name } = [0];
638 return $self->{'can_link'}{ $table1->name }{ $table2->name };
643 foreach my $field ( $self->get_fields ) {
644 if ( $field->is_foreign_key ) {
645 push @{ $fk{ $field->foreign_key_reference->reference_table } },
646 $field->foreign_key_reference;
650 if ( !defined( $fk{ $table1->name } ) or !defined( $fk{ $table2->name } ) )
652 $self->{'can_link'}{ $table1->name }{ $table2->name } = [0];
653 $self->{'can_link'}{ $table2->name }{ $table1->name } = [0];
654 return $self->{'can_link'}{ $table1->name }{ $table2->name };
657 # trivial traversal, only one way to link the two tables
658 if ( scalar( @{ $fk{ $table1->name } } == 1 )
659 and scalar( @{ $fk{ $table2->name } } == 1 ) )
661 $self->{'can_link'}{ $table1->name }{ $table2->name } =
662 [ 'one2one', $fk{ $table1->name }, $fk{ $table2->name } ];
663 $self->{'can_link'}{ $table1->name }{ $table2->name } =
664 [ 'one2one', $fk{ $table2->name }, $fk{ $table1->name } ];
666 # non-trivial traversal. one way to link table2,
667 # many ways to link table1
669 elsif ( scalar( @{ $fk{ $table1->name } } > 1 )
670 and scalar( @{ $fk{ $table2->name } } == 1 ) )
672 $self->{'can_link'}{ $table1->name }{ $table2->name } =
673 [ 'many2one', $fk{ $table1->name }, $fk{ $table2->name } ];
674 $self->{'can_link'}{ $table2->name }{ $table1->name } =
675 [ 'one2many', $fk{ $table2->name }, $fk{ $table1->name } ];
677 # non-trivial traversal. one way to link table1,
678 # many ways to link table2
680 elsif ( scalar( @{ $fk{ $table1->name } } == 1 )
681 and scalar( @{ $fk{ $table2->name } } > 1 ) )
683 $self->{'can_link'}{ $table1->name }{ $table2->name } =
684 [ 'one2many', $fk{ $table1->name }, $fk{ $table2->name } ];
685 $self->{'can_link'}{ $table2->name }{ $table1->name } =
686 [ 'many2one', $fk{ $table2->name }, $fk{ $table1->name } ];
688 # non-trivial traversal. many ways to link table1 and table2
690 elsif ( scalar( @{ $fk{ $table1->name } } > 1 )
691 and scalar( @{ $fk{ $table2->name } } > 1 ) )
693 $self->{'can_link'}{ $table1->name }{ $table2->name } =
694 [ 'many2many', $fk{ $table1->name }, $fk{ $table2->name } ];
695 $self->{'can_link'}{ $table2->name }{ $table1->name } =
696 [ 'many2many', $fk{ $table2->name }, $fk{ $table1->name } ];
698 # one of the tables didn't export a key
699 # to this table, no linking possible
702 $self->{'can_link'}{ $table1->name }{ $table2->name } = [0];
703 $self->{'can_link'}{ $table2->name }{ $table1->name } = [0];
706 return $self->{'can_link'}{ $table1->name }{ $table2->name };
715 Get or set the table's name.
717 Errors ("No table name") if you try to set a blank name.
719 If provided an argument, checks the schema object for a table of
720 that name and disallows the change if one exists (setting the error to
721 "Can't use table name "%s": table exists").
723 my $table_name = $table->name('foo');
730 my $arg = shift || return $self->error( "No table name" );
731 if ( my $schema = $self->schema ) {
732 return $self->error( qq[Can't use table name "$arg": table exists] )
733 if $schema->get_table( $arg );
735 $self->{'name'} = $arg;
738 return $self->{'name'} || '';
747 Get or set the table's schema object.
749 my $schema = $table->schema;
754 if ( my $arg = shift ) {
755 return $self->error('Not a schema object') unless
756 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' );
757 $self->{'schema'} = $arg;
760 return $self->{'schema'};
769 Gets or sets the table's primary key(s). Takes one or more field
770 names (as a string, list or array[ref]) as an argument. If the field
771 names are present, it will create a new PK if none exists, or it will
772 add to the fields of an existing PK (and will unique the field names).
773 Returns the C<SQL::Translator::Schema::Constraint> object representing
778 $table->primary_key('id');
779 $table->primary_key(['name']);
780 $table->primary_key('id','name']);
781 $table->primary_key(['id','name']);
782 $table->primary_key('id,name');
783 $table->primary_key(qw[ id name ]);
785 my $pk = $table->primary_key;
790 my $fields = parse_list_arg( @_ );
794 for my $f ( @$fields ) {
795 return $self->error(qq[Invalid field "$f"]) unless
796 $self->get_field($f);
800 for my $c ( $self->get_constraints ) {
801 if ( $c->type eq PRIMARY_KEY ) {
803 $c->fields( @{ $c->fields }, @$fields );
809 $constraint = $self->add_constraint(
820 for my $c ( $self->get_constraints ) {
821 return $c if $c->type eq PRIMARY_KEY;
834 Get or set the table's options (e.g., table types for MySQL). Returns
835 an array or array reference.
837 my @options = $table->options;
842 my $options = parse_list_arg( @_ );
844 push @{ $self->{'options'} }, @$options;
846 if ( ref $self->{'options'} ) {
847 return wantarray ? @{ $self->{'options'} || [] } : ($self->{'options'} || '');
850 return wantarray ? () : [];
860 Get or set the table's order.
862 my $order = $table->order(3);
866 my ( $self, $arg ) = @_;
868 if ( defined $arg && $arg =~ /^\d+$/ ) {
869 $self->{'order'} = $arg;
872 return $self->{'order'} || 0;
879 Read-only method to return a list or array ref of the field names. Returns undef
880 or an empty list if the table has no fields set. Useful if you want to
881 avoid the overload magic of the Field objects returned by the get_fields method.
883 my @names = $constraint->field_names;
890 sort { $a->order <=> $b->order }
891 values %{ $self->{'fields'} || {} };
894 return wantarray ? @fields : \@fields;
897 $self->error('No fields');
898 return wantarray ? () : undef;
908 Determines if this table is the same as another
910 my $isIdentical = $table1->equals( $table2 );
916 my $case_insensitive = shift;
918 return 0 unless $self->SUPER::equals($other);
919 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
920 return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options);
921 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
924 # Go through our fields
926 foreach my $field ( $self->get_fields ) {
927 my $otherField = $other->get_field($field->name, $case_insensitive);
928 return 0 unless $field->equals($otherField, $case_insensitive);
929 $checkedFields{$field->name} = 1;
931 # Go through the other table's fields
932 foreach my $otherField ( $other->get_fields ) {
933 next if $checkedFields{$otherField->name};
938 # Go through our constraints
939 my %checkedConstraints;
941 foreach my $constraint ( $self->get_constraints ) {
942 foreach my $otherConstraint ( $other->get_constraints ) {
943 if ( $constraint->equals($otherConstraint, $case_insensitive) ) {
944 $checkedConstraints{$otherConstraint} = 1;
950 # Go through the other table's constraints
952 foreach my $otherConstraint ( $other->get_constraints ) {
953 next if $checkedFields{$otherConstraint};
954 foreach my $constraint ( $self->get_constraints ) {
955 if ( $otherConstraint->equals($constraint, $case_insensitive) ) {
963 # Go through our indices
966 foreach my $index ( $self->get_indices ) {
967 foreach my $otherIndex ( $other->get_indices ) {
968 if ( $index->equals($otherIndex, $case_insensitive) ) {
969 $checkedIndices{$otherIndex} = 1;
975 # Go through the other table's indices
977 foreach my $otherIndex ( $other->get_indices ) {
978 next if $checkedIndices{$otherIndex};
979 foreach my $index ( $self->get_indices ) {
980 if ( $otherIndex->equals($index, $case_insensitive) ) {
990 =head1 LOOKUP METHODS
992 The following are a set of shortcut methods for getting commonly used lists of
993 fields and constraints. They all return lists or array refs of Field or
1000 The primary key fields.
1004 All foreign key fields.
1006 =item nonpkey_fields
1008 All the fields except the primary key.
1016 All fields with unique constraints.
1018 =item unique_constraints
1020 All this tables unique constraints.
1022 =item fkey_constraints
1024 All this tables foreign key constraints. (See primary_key method to get the
1025 primary key constraint)
1033 my @fields = grep { $_->is_primary_key } $me->get_fields;
1034 return wantarray ? @fields : \@fields;
1040 push @fields, $_->fields foreach $me->fkey_constraints;
1041 return wantarray ? @fields : \@fields;
1044 sub nonpkey_fields {
1046 my @fields = grep { !$_->is_primary_key } $me->get_fields;
1047 return wantarray ? @fields : \@fields;
1053 grep { !$_->is_foreign_key and !$_->is_primary_key } $me->get_fields;
1054 return wantarray ? @fields : \@fields;
1060 push @fields, $_->fields foreach $me->unique_constraints;
1061 return wantarray ? @fields : \@fields;
1064 sub unique_constraints {
1066 my @cons = grep { $_->type eq UNIQUE } $me->get_constraints;
1067 return wantarray ? @cons : \@cons;
1070 sub fkey_constraints {
1072 my @cons = grep { $_->type eq FOREIGN_KEY } $me->get_constraints;
1073 return wantarray ? @cons : \@cons;
1078 undef $self->{'schema'}; # destroy cyclical reference
1079 undef $_ for @{ $self->{'constraints'} };
1080 undef $_ for @{ $self->{'indices'} };
1081 undef $_ for values %{ $self->{'fields'} };
1090 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
1091 Allen Day E<lt>allenday@ucla.eduE<gt>.