1 package SQL::Translator::Schema::Table;
7 SQL::Translator::Schema::Table - SQL::Translator table object
11 use SQL::Translator::Schema::Table;
12 my $table = SQL::Translator::Schema::Table->new( name => 'foo' );
16 C<SQL::Translator::Schema::Table> is the table object.
24 use SQL::Translator::Utils 'parse_list_arg';
25 use SQL::Translator::Schema::Constants;
26 use SQL::Translator::Schema::Constraint;
27 use SQL::Translator::Schema::Field;
28 use SQL::Translator::Schema::Index;
30 use Carp::Clan '^SQL::Translator';
33 use base 'SQL::Translator::Schema::Object';
35 our $VERSION = '1.59';
37 # Stringify to our name, being careful not to pass any args through so we don't
38 # accidentally set it to undef. We also have to tweak bool so the object is
39 # still true when it doesn't have a name (which shouldn't happen!).
41 '""' => sub { shift->name },
42 'bool' => sub { $_[0]->name || $_[0] },
46 __PACKAGE__->_attributes( qw/schema name comments options order/ );
54 my $table = SQL::Translator::Schema::Table->new(
67 Add a constraint to the table. Returns the newly created
68 C<SQL::Translator::Schema::Constraint> object.
70 my $c1 = $table->add_constraint(
73 fields => [ 'foo_id' ],
76 my $c2 = SQL::Translator::Schema::Constraint->new( name => 'uniq' );
77 $c2 = $table->add_constraint( $constraint );
82 my $constraint_class = 'SQL::Translator::Schema::Constraint';
85 if ( UNIVERSAL::isa( $_[0], $constraint_class ) ) {
87 $constraint->table( $self );
91 $args{'table'} = $self;
92 $constraint = $constraint_class->new( \%args ) or
93 return $self->error( $constraint_class->error );
97 # If we're trying to add a PK when one is already defined,
98 # then just add the fields to the existing definition.
101 my $pk = $self->primary_key;
102 if ( $pk && $constraint->type eq PRIMARY_KEY ) {
103 $self->primary_key( $constraint->fields );
104 $pk->name($constraint->name) if $constraint->name;
105 my %extra = $constraint->extra;
106 $pk->extra(%extra) if keys %extra;
110 elsif ( $constraint->type eq PRIMARY_KEY ) {
111 for my $fname ( $constraint->fields ) {
112 if ( my $f = $self->get_field( $fname ) ) {
113 $f->is_primary_key( 1 );
118 # See if another constraint of the same type
119 # covers the same fields. -- This doesn't work! ky
121 # elsif ( $constraint->type ne CHECK_C ) {
122 # my @field_names = $constraint->fields;
124 # grep { $_->type eq $constraint->type }
125 # $self->get_constraints
127 # my %fields = map { $_, 1 } $c->fields;
128 # for my $field_name ( @field_names ) {
129 # if ( $fields{ $field_name } ) {
140 push @{ $self->{'constraints'} }, $constraint;
146 sub drop_constraint {
150 =head2 drop_constraint
152 Remove a constraint from the table. Returns the constraint object if the index
153 was found and removed, an error otherwise. The single parameter can be either
154 an index name or an C<SQL::Translator::Schema::Constraint> object.
156 $table->drop_constraint('myconstraint');
161 my $constraint_class = 'SQL::Translator::Schema::Constraint';
164 if ( UNIVERSAL::isa( $_[0], $constraint_class ) ) {
165 $constraint_name = shift->name;
168 $constraint_name = shift;
171 if ( ! grep { $_->name eq $constraint_name } @ { $self->{'constraints'} } ) {
172 return $self->error(qq[Can't drop constraint: "$constraint_name" doesn't exist]);
175 my @cs = @{ $self->{'constraints'} };
176 my ($constraint_id) = grep { $cs[$_]->name eq $constraint_name } (0..$#cs);
177 my $constraint = splice(@{$self->{'constraints'}}, $constraint_id, 1);
188 Add an index to the table. Returns the newly created
189 C<SQL::Translator::Schema::Index> object.
191 my $i1 = $table->add_index(
193 fields => [ 'name' ],
197 my $i2 = SQL::Translator::Schema::Index->new( name => 'id' );
198 $i2 = $table->add_index( $index );
203 my $index_class = 'SQL::Translator::Schema::Index';
206 if ( UNIVERSAL::isa( $_[0], $index_class ) ) {
208 $index->table( $self );
212 $args{'table'} = $self;
213 $index = $index_class->new( \%args ) or return
214 $self->error( $index_class->error );
216 foreach my $ex_index ($self->get_indices) {
217 return if ($ex_index->equals($index));
219 push @{ $self->{'indices'} }, $index;
229 Remove an index from the table. Returns the index object if the index was
230 found and removed, an error otherwise. The single parameter can be either
231 an index name of an C<SQL::Translator::Schema::Index> object.
233 $table->drop_index('myindex');
238 my $index_class = 'SQL::Translator::Schema::Index';
241 if ( UNIVERSAL::isa( $_[0], $index_class ) ) {
242 $index_name = shift->name;
248 if ( ! grep { $_->name eq $index_name } @{ $self->{'indices'} }) {
249 return $self->error(qq[Can't drop index: "$index_name" doesn't exist]);
252 my @is = @{ $self->{'indices'} };
253 my ($index_id) = grep { $is[$_]->name eq $index_name } (0..$#is);
254 my $index = splice(@{$self->{'indices'}}, $index_id, 1);
265 Add an field to the table. Returns the newly created
266 C<SQL::Translator::Schema::Field> object. The "name" parameter is
267 required. If you try to create a field with the same name as an
268 existing field, you will get an error and the field will not be created.
270 my $f1 = $table->add_field(
272 data_type => 'integer',
276 my $f2 = SQL::Translator::Schema::Field->new(
280 $f2 = $table->add_field( $field2 ) or die $table->error;
285 my $field_class = 'SQL::Translator::Schema::Field';
288 if ( UNIVERSAL::isa( $_[0], $field_class ) ) {
290 $field->table( $self );
294 $args{'table'} = $self;
295 $field = $field_class->new( \%args ) or return
296 $self->error( $field_class->error );
299 my $existing_order = { map { $_->order => $_->name } $self->get_fields };
301 # supplied order, possible unordered assembly
302 if ( $field->order ) {
303 if($existing_order->{$field->order}) {
305 "Requested order '%d' for column '%s' conflicts with already existing column '%s'",
308 $existing_order->{$field->order},
313 my $last_field_no = max(keys %$existing_order) || 0;
314 if ( $last_field_no != scalar keys %$existing_order ) {
316 "Table '%s' field order incomplete - unable to auto-determine order for newly added field",
321 $field->order( $last_field_no + 1 );
324 # We know we have a name as the Field->new above errors if none given.
325 my $field_name = $field->name;
327 if ( $self->get_field($field_name) ) {
328 return $self->error(qq[Can't create field: "$field_name" exists]);
331 $self->{'fields'}{ $field_name } = $field;
343 Remove a field from the table. Returns the field object if the field was
344 found and removed, an error otherwise. The single parameter can be either
345 a field name or an C<SQL::Translator::Schema::Field> object.
347 $table->drop_field('myfield');
352 my $field_class = 'SQL::Translator::Schema::Field';
355 if ( UNIVERSAL::isa( $_[0], $field_class ) ) {
356 $field_name = shift->name;
362 my $cascade = $args{'cascade'};
364 if ( ! exists $self->{'fields'}{ $field_name } ) {
365 return $self->error(qq[Can't drop field: "$field_name" doesn't exists]);
368 my $field = delete $self->{'fields'}{ $field_name };
371 # Remove this field from all indices using it
372 foreach my $i ($self->get_indices()) {
373 my @fs = $i->fields();
374 @fs = grep { $_ ne $field->name } @fs;
378 # Remove this field from all constraints using it
379 foreach my $c ($self->get_constraints()) {
380 my @cs = $c->fields();
381 @cs = grep { $_ ne $field->name } @cs;
395 Get or set the comments on a table. May be called several times to
396 set and it will accumulate the comments. Called in an array context,
397 returns each comment individually; called in a scalar context, returns
398 all the comments joined on newlines.
400 $table->comments('foo');
401 $table->comments('bar');
402 print join( ', ', $table->comments ); # prints "foo, bar"
407 my @comments = ref $_[0] ? @{ $_[0] } : @_;
409 for my $arg ( @comments ) {
410 $arg = $arg->[0] if ref $arg;
411 push @{ $self->{'comments'} }, $arg if defined $arg && $arg;
414 if ( @{ $self->{'comments'} || [] } ) {
416 ? @{ $self->{'comments'} }
417 : join( "\n", @{ $self->{'comments'} } )
421 return wantarray ? () : undef;
425 sub get_constraints {
429 =head2 get_constraints
431 Returns all the constraint objects as an array or array reference.
433 my @constraints = $table->get_constraints;
439 if ( ref $self->{'constraints'} ) {
441 ? @{ $self->{'constraints'} } : $self->{'constraints'};
444 $self->error('No constraints');
445 return wantarray ? () : undef;
455 Returns all the index objects as an array or array reference.
457 my @indices = $table->get_indices;
463 if ( ref $self->{'indices'} ) {
465 ? @{ $self->{'indices'} }
466 : $self->{'indices'};
469 $self->error('No indices');
470 return wantarray ? () : undef;
480 Returns a field by the name provided.
482 my $field = $table->get_field('foo');
487 my $field_name = shift or return $self->error('No field name');
488 my $case_insensitive = shift;
489 if ( $case_insensitive ) {
490 $field_name = uc($field_name);
491 foreach my $field ( keys %{$self->{fields}} ) {
492 return $self->{fields}{$field} if $field_name eq uc($field);
494 return $self->error(qq[Field "$field_name" does not exist]);
496 return $self->error( qq[Field "$field_name" does not exist] ) unless
497 exists $self->{'fields'}{ $field_name };
498 return $self->{'fields'}{ $field_name };
507 Returns all the field objects as an array or array reference.
509 my @fields = $table->get_fields;
516 sort { $a->[0] <=> $b->[0] }
517 map { [ $_->order, $_ ] }
518 values %{ $self->{'fields'} || {} };
521 return wantarray ? @fields : \@fields;
524 $self->error('No fields');
525 return wantarray ? () : undef;
535 Determine whether the view is valid or not.
537 my $ok = $view->is_valid;
542 return $self->error('No name') unless $self->name;
543 return $self->error('No fields') unless $self->get_fields;
546 $self->get_fields, $self->get_indices, $self->get_constraints
548 return $object->error unless $object->is_valid;
554 sub is_trivial_link {
558 =head2 is_trivial_link
560 True if table has no data (non-key) fields and only uses single key joins.
565 return 0 if $self->is_data;
566 return $self->{'is_trivial_link'} if defined $self->{'is_trivial_link'};
568 $self->{'is_trivial_link'} = 1;
572 foreach my $field ( $self->get_fields ) {
573 next unless $field->is_foreign_key;
574 $fk{$field->foreign_key_reference->reference_table}++;
577 foreach my $referenced (keys %fk){
578 if($fk{$referenced} > 1){
579 $self->{'is_trivial_link'} = 0;
584 return $self->{'is_trivial_link'};
594 Returns true if the table has some non-key fields.
599 return $self->{'is_data'} if defined $self->{'is_data'};
601 $self->{'is_data'} = 0;
603 foreach my $field ( $self->get_fields ) {
604 if ( !$field->is_primary_key and !$field->is_foreign_key ) {
605 $self->{'is_data'} = 1;
606 return $self->{'is_data'};
610 return $self->{'is_data'};
619 Determine whether the table can link two arg tables via many-to-many.
621 my $ok = $table->can_link($table1,$table2);
625 my ( $self, $table1, $table2 ) = @_;
627 return $self->{'can_link'}{ $table1->name }{ $table2->name }
628 if defined $self->{'can_link'}{ $table1->name }{ $table2->name };
630 if ( $self->is_data == 1 ) {
631 $self->{'can_link'}{ $table1->name }{ $table2->name } = [0];
632 $self->{'can_link'}{ $table2->name }{ $table1->name } = [0];
633 return $self->{'can_link'}{ $table1->name }{ $table2->name };
638 foreach my $field ( $self->get_fields ) {
639 if ( $field->is_foreign_key ) {
640 push @{ $fk{ $field->foreign_key_reference->reference_table } },
641 $field->foreign_key_reference;
645 if ( !defined( $fk{ $table1->name } ) or !defined( $fk{ $table2->name } ) )
647 $self->{'can_link'}{ $table1->name }{ $table2->name } = [0];
648 $self->{'can_link'}{ $table2->name }{ $table1->name } = [0];
649 return $self->{'can_link'}{ $table1->name }{ $table2->name };
652 # trivial traversal, only one way to link the two tables
653 if ( scalar( @{ $fk{ $table1->name } } == 1 )
654 and scalar( @{ $fk{ $table2->name } } == 1 ) )
656 $self->{'can_link'}{ $table1->name }{ $table2->name } =
657 [ 'one2one', $fk{ $table1->name }, $fk{ $table2->name } ];
658 $self->{'can_link'}{ $table1->name }{ $table2->name } =
659 [ 'one2one', $fk{ $table2->name }, $fk{ $table1->name } ];
661 # non-trivial traversal. one way to link table2,
662 # many ways to link table1
664 elsif ( scalar( @{ $fk{ $table1->name } } > 1 )
665 and scalar( @{ $fk{ $table2->name } } == 1 ) )
667 $self->{'can_link'}{ $table1->name }{ $table2->name } =
668 [ 'many2one', $fk{ $table1->name }, $fk{ $table2->name } ];
669 $self->{'can_link'}{ $table2->name }{ $table1->name } =
670 [ 'one2many', $fk{ $table2->name }, $fk{ $table1->name } ];
672 # non-trivial traversal. one way to link table1,
673 # many ways to link table2
675 elsif ( scalar( @{ $fk{ $table1->name } } == 1 )
676 and scalar( @{ $fk{ $table2->name } } > 1 ) )
678 $self->{'can_link'}{ $table1->name }{ $table2->name } =
679 [ 'one2many', $fk{ $table1->name }, $fk{ $table2->name } ];
680 $self->{'can_link'}{ $table2->name }{ $table1->name } =
681 [ 'many2one', $fk{ $table2->name }, $fk{ $table1->name } ];
683 # non-trivial traversal. many ways to link table1 and table2
685 elsif ( scalar( @{ $fk{ $table1->name } } > 1 )
686 and scalar( @{ $fk{ $table2->name } } > 1 ) )
688 $self->{'can_link'}{ $table1->name }{ $table2->name } =
689 [ 'many2many', $fk{ $table1->name }, $fk{ $table2->name } ];
690 $self->{'can_link'}{ $table2->name }{ $table1->name } =
691 [ 'many2many', $fk{ $table2->name }, $fk{ $table1->name } ];
693 # one of the tables didn't export a key
694 # to this table, no linking possible
697 $self->{'can_link'}{ $table1->name }{ $table2->name } = [0];
698 $self->{'can_link'}{ $table2->name }{ $table1->name } = [0];
701 return $self->{'can_link'}{ $table1->name }{ $table2->name };
710 Get or set the table's name.
712 Errors ("No table name") if you try to set a blank name.
714 If provided an argument, checks the schema object for a table of
715 that name and disallows the change if one exists (setting the error to
716 "Can't use table name "%s": table exists").
718 my $table_name = $table->name('foo');
725 my $arg = shift || return $self->error( "No table name" );
726 if ( my $schema = $self->schema ) {
727 return $self->error( qq[Can't use table name "$arg": table exists] )
728 if $schema->get_table( $arg );
730 $self->{'name'} = $arg;
733 return $self->{'name'} || '';
742 Get or set the table's schema object.
744 my $schema = $table->schema;
749 if ( my $arg = shift ) {
750 return $self->error('Not a schema object') unless
751 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' );
752 $self->{'schema'} = $arg;
755 return $self->{'schema'};
764 Gets or sets the table's primary key(s). Takes one or more field
765 names (as a string, list or array[ref]) as an argument. If the field
766 names are present, it will create a new PK if none exists, or it will
767 add to the fields of an existing PK (and will unique the field names).
768 Returns the C<SQL::Translator::Schema::Constraint> object representing
773 $table->primary_key('id');
774 $table->primary_key(['name']);
775 $table->primary_key('id','name']);
776 $table->primary_key(['id','name']);
777 $table->primary_key('id,name');
778 $table->primary_key(qw[ id name ]);
780 my $pk = $table->primary_key;
785 my $fields = parse_list_arg( @_ );
789 for my $f ( @$fields ) {
790 return $self->error(qq[Invalid field "$f"]) unless
791 $self->get_field($f);
795 for my $c ( $self->get_constraints ) {
796 if ( $c->type eq PRIMARY_KEY ) {
798 $c->fields( @{ $c->fields }, @$fields );
804 $constraint = $self->add_constraint(
815 for my $c ( $self->get_constraints ) {
816 return $c if $c->type eq PRIMARY_KEY;
829 Get or set the table's options (e.g., table types for MySQL). Returns
830 an array or array reference.
832 my @options = $table->options;
837 my $options = parse_list_arg( @_ );
839 push @{ $self->{'options'} }, @$options;
841 if ( ref $self->{'options'} ) {
842 return wantarray ? @{ $self->{'options'} || [] } : ($self->{'options'} || '');
845 return wantarray ? () : [];
855 Get or set the table's order.
857 my $order = $table->order(3);
861 my ( $self, $arg ) = @_;
863 if ( defined $arg && $arg =~ /^\d+$/ ) {
864 $self->{'order'} = $arg;
867 return $self->{'order'} || 0;
874 Read-only method to return a list or array ref of the field names. Returns undef
875 or an empty list if the table has no fields set. Useful if you want to
876 avoid the overload magic of the Field objects returned by the get_fields method.
878 my @names = $constraint->field_names;
885 sort { $a->order <=> $b->order }
886 values %{ $self->{'fields'} || {} };
889 return wantarray ? @fields : \@fields;
892 $self->error('No fields');
893 return wantarray ? () : undef;
903 Determines if this table is the same as another
905 my $isIdentical = $table1->equals( $table2 );
911 my $case_insensitive = shift;
913 return 0 unless $self->SUPER::equals($other);
914 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
915 return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options);
916 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
919 # Go through our fields
921 foreach my $field ( $self->get_fields ) {
922 my $otherField = $other->get_field($field->name, $case_insensitive);
923 return 0 unless $field->equals($otherField, $case_insensitive);
924 $checkedFields{$field->name} = 1;
926 # Go through the other table's fields
927 foreach my $otherField ( $other->get_fields ) {
928 next if $checkedFields{$otherField->name};
933 # Go through our constraints
934 my %checkedConstraints;
936 foreach my $constraint ( $self->get_constraints ) {
937 foreach my $otherConstraint ( $other->get_constraints ) {
938 if ( $constraint->equals($otherConstraint, $case_insensitive) ) {
939 $checkedConstraints{$otherConstraint} = 1;
945 # Go through the other table's constraints
947 foreach my $otherConstraint ( $other->get_constraints ) {
948 next if $checkedFields{$otherConstraint};
949 foreach my $constraint ( $self->get_constraints ) {
950 if ( $otherConstraint->equals($constraint, $case_insensitive) ) {
958 # Go through our indices
961 foreach my $index ( $self->get_indices ) {
962 foreach my $otherIndex ( $other->get_indices ) {
963 if ( $index->equals($otherIndex, $case_insensitive) ) {
964 $checkedIndices{$otherIndex} = 1;
970 # Go through the other table's indices
972 foreach my $otherIndex ( $other->get_indices ) {
973 next if $checkedIndices{$otherIndex};
974 foreach my $index ( $self->get_indices ) {
975 if ( $otherIndex->equals($index, $case_insensitive) ) {
985 =head1 LOOKUP METHODS
987 The following are a set of shortcut methods for getting commonly used lists of
988 fields and constraints. They all return lists or array refs of Field or
995 The primary key fields.
999 All foreign key fields.
1001 =item nonpkey_fields
1003 All the fields except the primary key.
1011 All fields with unique constraints.
1013 =item unique_constraints
1015 All this tables unique constraints.
1017 =item fkey_constraints
1019 All this tables foreign key constraints. (See primary_key method to get the
1020 primary key constraint)
1028 my @fields = grep { $_->is_primary_key } $me->get_fields;
1029 return wantarray ? @fields : \@fields;
1035 push @fields, $_->fields foreach $me->fkey_constraints;
1036 return wantarray ? @fields : \@fields;
1039 sub nonpkey_fields {
1041 my @fields = grep { !$_->is_primary_key } $me->get_fields;
1042 return wantarray ? @fields : \@fields;
1048 grep { !$_->is_foreign_key and !$_->is_primary_key } $me->get_fields;
1049 return wantarray ? @fields : \@fields;
1055 push @fields, $_->fields foreach $me->unique_constraints;
1056 return wantarray ? @fields : \@fields;
1059 sub unique_constraints {
1061 my @cons = grep { $_->type eq UNIQUE } $me->get_constraints;
1062 return wantarray ? @cons : \@cons;
1065 sub fkey_constraints {
1067 my @cons = grep { $_->type eq FOREIGN_KEY } $me->get_constraints;
1068 return wantarray ? @cons : \@cons;
1073 undef $self->{'schema'}; # destroy cyclical reference
1074 undef $_ for @{ $self->{'constraints'} };
1075 undef $_ for @{ $self->{'indices'} };
1076 undef $_ for values %{ $self->{'fields'} };
1085 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
1086 Allen Day E<lt>allenday@ucla.eduE<gt>.