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;
31 use base 'SQL::Translator::Schema::Object';
33 our $VERSION = '1.59';
35 # Stringify to our name, being careful not to pass any args through so we don't
36 # accidentally set it to undef. We also have to tweak bool so the object is
37 # still true when it doesn't have a name (which shouldn't happen!).
39 '""' => sub { shift->name },
40 'bool' => sub { $_[0]->name || $_[0] },
44 __PACKAGE__->_attributes( qw/schema name comments options order/ );
52 my $table = SQL::Translator::Schema::Table->new(
61 my $self = $class->SUPER::new (@_)
64 $self->{_order} = { map { $_ => 0 } qw/
77 Add a constraint to the table. Returns the newly created
78 C<SQL::Translator::Schema::Constraint> object.
80 my $c1 = $table->add_constraint(
83 fields => [ 'foo_id' ],
86 my $c2 = SQL::Translator::Schema::Constraint->new( name => 'uniq' );
87 $c2 = $table->add_constraint( $constraint );
92 my $constraint_class = 'SQL::Translator::Schema::Constraint';
95 if ( UNIVERSAL::isa( $_[0], $constraint_class ) ) {
97 $constraint->table( $self );
101 $args{'table'} = $self;
102 $constraint = $constraint_class->new( \%args ) or
103 return $self->error( $constraint_class->error );
107 # If we're trying to add a PK when one is already defined,
108 # then just add the fields to the existing definition.
111 my $pk = $self->primary_key;
112 if ( $pk && $constraint->type eq PRIMARY_KEY ) {
113 $self->primary_key( $constraint->fields );
114 $pk->name($constraint->name) if $constraint->name;
115 my %extra = $constraint->extra;
116 $pk->extra(%extra) if keys %extra;
120 elsif ( $constraint->type eq PRIMARY_KEY ) {
121 for my $fname ( $constraint->fields ) {
122 if ( my $f = $self->get_field( $fname ) ) {
123 $f->is_primary_key( 1 );
128 # See if another constraint of the same type
129 # covers the same fields. -- This doesn't work! ky
131 # elsif ( $constraint->type ne CHECK_C ) {
132 # my @field_names = $constraint->fields;
134 # grep { $_->type eq $constraint->type }
135 # $self->get_constraints
137 # my %fields = map { $_, 1 } $c->fields;
138 # for my $field_name ( @field_names ) {
139 # if ( $fields{ $field_name } ) {
150 push @{ $self->{'constraints'} }, $constraint;
156 sub drop_constraint {
160 =head2 drop_constraint
162 Remove a constraint from the table. Returns the constraint object if the index
163 was found and removed, an error otherwise. The single parameter can be either
164 an index name or an C<SQL::Translator::Schema::Constraint> object.
166 $table->drop_constraint('myconstraint');
171 my $constraint_class = 'SQL::Translator::Schema::Constraint';
174 if ( UNIVERSAL::isa( $_[0], $constraint_class ) ) {
175 $constraint_name = shift->name;
178 $constraint_name = shift;
181 if ( ! grep { $_->name eq $constraint_name } @ { $self->{'constraints'} } ) {
182 return $self->error(qq[Can't drop constraint: "$constraint_name" doesn't exist]);
185 my @cs = @{ $self->{'constraints'} };
186 my ($constraint_id) = grep { $cs[$_]->name eq $constraint_name } (0..$#cs);
187 my $constraint = splice(@{$self->{'constraints'}}, $constraint_id, 1);
198 Add an index to the table. Returns the newly created
199 C<SQL::Translator::Schema::Index> object.
201 my $i1 = $table->add_index(
203 fields => [ 'name' ],
207 my $i2 = SQL::Translator::Schema::Index->new( name => 'id' );
208 $i2 = $table->add_index( $index );
213 my $index_class = 'SQL::Translator::Schema::Index';
216 if ( UNIVERSAL::isa( $_[0], $index_class ) ) {
218 $index->table( $self );
222 $args{'table'} = $self;
223 $index = $index_class->new( \%args ) or return
224 $self->error( $index_class->error );
226 foreach my $ex_index ($self->get_indices) {
227 return if ($ex_index->equals($index));
229 push @{ $self->{'indices'} }, $index;
239 Remove an index from the table. Returns the index object if the index was
240 found and removed, an error otherwise. The single parameter can be either
241 an index name of an C<SQL::Translator::Schema::Index> object.
243 $table->drop_index('myindex');
248 my $index_class = 'SQL::Translator::Schema::Index';
251 if ( UNIVERSAL::isa( $_[0], $index_class ) ) {
252 $index_name = shift->name;
258 if ( ! grep { $_->name eq $index_name } @{ $self->{'indices'} }) {
259 return $self->error(qq[Can't drop index: "$index_name" doesn't exist]);
262 my @is = @{ $self->{'indices'} };
263 my ($index_id) = grep { $is[$_]->name eq $index_name } (0..$#is);
264 my $index = splice(@{$self->{'indices'}}, $index_id, 1);
275 Add an field to the table. Returns the newly created
276 C<SQL::Translator::Schema::Field> object. The "name" parameter is
277 required. If you try to create a field with the same name as an
278 existing field, you will get an error and the field will not be created.
280 my $f1 = $table->add_field(
282 data_type => 'integer',
286 my $f2 = SQL::Translator::Schema::Field->new(
290 $f2 = $table->add_field( $field2 ) or die $table->error;
295 my $field_class = 'SQL::Translator::Schema::Field';
298 if ( UNIVERSAL::isa( $_[0], $field_class ) ) {
300 $field->table( $self );
304 $args{'table'} = $self;
305 $field = $field_class->new( \%args ) or return
306 $self->error( $field_class->error );
309 $field->order( ++$self->{_order}{field} );
310 # We know we have a name as the Field->new above errors if none given.
311 my $field_name = $field->name;
313 if ( exists $self->{'fields'}{ $field_name } ) {
314 return $self->error(qq[Can't create field: "$field_name" exists]);
317 $self->{'fields'}{ $field_name } = $field;
329 Remove a field from the table. Returns the field object if the field was
330 found and removed, an error otherwise. The single parameter can be either
331 a field name or an C<SQL::Translator::Schema::Field> object.
333 $table->drop_field('myfield');
338 my $field_class = 'SQL::Translator::Schema::Field';
341 if ( UNIVERSAL::isa( $_[0], $field_class ) ) {
342 $field_name = shift->name;
348 my $cascade = $args{'cascade'};
350 if ( ! exists $self->{'fields'}{ $field_name } ) {
351 return $self->error(qq[Can't drop field: "$field_name" doesn't exists]);
354 my $field = delete $self->{'fields'}{ $field_name };
357 # Remove this field from all indices using it
358 foreach my $i ($self->get_indices()) {
359 my @fs = $i->fields();
360 @fs = grep { $_ ne $field->name } @fs;
364 # Remove this field from all constraints using it
365 foreach my $c ($self->get_constraints()) {
366 my @cs = $c->fields();
367 @cs = grep { $_ ne $field->name } @cs;
381 Get or set the comments on a table. May be called several times to
382 set and it will accumulate the comments. Called in an array context,
383 returns each comment individually; called in a scalar context, returns
384 all the comments joined on newlines.
386 $table->comments('foo');
387 $table->comments('bar');
388 print join( ', ', $table->comments ); # prints "foo, bar"
393 my @comments = ref $_[0] ? @{ $_[0] } : @_;
395 for my $arg ( @comments ) {
396 $arg = $arg->[0] if ref $arg;
397 push @{ $self->{'comments'} }, $arg if defined $arg && $arg;
400 if ( @{ $self->{'comments'} || [] } ) {
402 ? @{ $self->{'comments'} }
403 : join( "\n", @{ $self->{'comments'} } )
407 return wantarray ? () : undef;
411 sub get_constraints {
415 =head2 get_constraints
417 Returns all the constraint objects as an array or array reference.
419 my @constraints = $table->get_constraints;
425 if ( ref $self->{'constraints'} ) {
427 ? @{ $self->{'constraints'} } : $self->{'constraints'};
430 $self->error('No constraints');
431 return wantarray ? () : undef;
441 Returns all the index objects as an array or array reference.
443 my @indices = $table->get_indices;
449 if ( ref $self->{'indices'} ) {
451 ? @{ $self->{'indices'} }
452 : $self->{'indices'};
455 $self->error('No indices');
456 return wantarray ? () : undef;
466 Returns a field by the name provided.
468 my $field = $table->get_field('foo');
473 my $field_name = shift or return $self->error('No field name');
474 my $case_insensitive = shift;
475 if ( $case_insensitive ) {
476 $field_name = uc($field_name);
477 foreach my $field ( keys %{$self->{fields}} ) {
478 return $self->{fields}{$field} if $field_name eq uc($field);
480 return $self->error(qq[Field "$field_name" does not exist]);
482 return $self->error( qq[Field "$field_name" does not exist] ) unless
483 exists $self->{'fields'}{ $field_name };
484 return $self->{'fields'}{ $field_name };
493 Returns all the field objects as an array or array reference.
495 my @fields = $table->get_fields;
502 sort { $a->[0] <=> $b->[0] }
503 map { [ $_->order, $_ ] }
504 values %{ $self->{'fields'} || {} };
507 return wantarray ? @fields : \@fields;
510 $self->error('No fields');
511 return wantarray ? () : undef;
521 Determine whether the view is valid or not.
523 my $ok = $view->is_valid;
528 return $self->error('No name') unless $self->name;
529 return $self->error('No fields') unless $self->get_fields;
532 $self->get_fields, $self->get_indices, $self->get_constraints
534 return $object->error unless $object->is_valid;
540 sub is_trivial_link {
544 =head2 is_trivial_link
546 True if table has no data (non-key) fields and only uses single key joins.
551 return 0 if $self->is_data;
552 return $self->{'is_trivial_link'} if defined $self->{'is_trivial_link'};
554 $self->{'is_trivial_link'} = 1;
558 foreach my $field ( $self->get_fields ) {
559 next unless $field->is_foreign_key;
560 $fk{$field->foreign_key_reference->reference_table}++;
563 foreach my $referenced (keys %fk){
564 if($fk{$referenced} > 1){
565 $self->{'is_trivial_link'} = 0;
570 return $self->{'is_trivial_link'};
580 Returns true if the table has some non-key fields.
585 return $self->{'is_data'} if defined $self->{'is_data'};
587 $self->{'is_data'} = 0;
589 foreach my $field ( $self->get_fields ) {
590 if ( !$field->is_primary_key and !$field->is_foreign_key ) {
591 $self->{'is_data'} = 1;
592 return $self->{'is_data'};
596 return $self->{'is_data'};
605 Determine whether the table can link two arg tables via many-to-many.
607 my $ok = $table->can_link($table1,$table2);
611 my ( $self, $table1, $table2 ) = @_;
613 return $self->{'can_link'}{ $table1->name }{ $table2->name }
614 if defined $self->{'can_link'}{ $table1->name }{ $table2->name };
616 if ( $self->is_data == 1 ) {
617 $self->{'can_link'}{ $table1->name }{ $table2->name } = [0];
618 $self->{'can_link'}{ $table2->name }{ $table1->name } = [0];
619 return $self->{'can_link'}{ $table1->name }{ $table2->name };
624 foreach my $field ( $self->get_fields ) {
625 if ( $field->is_foreign_key ) {
626 push @{ $fk{ $field->foreign_key_reference->reference_table } },
627 $field->foreign_key_reference;
631 if ( !defined( $fk{ $table1->name } ) or !defined( $fk{ $table2->name } ) )
633 $self->{'can_link'}{ $table1->name }{ $table2->name } = [0];
634 $self->{'can_link'}{ $table2->name }{ $table1->name } = [0];
635 return $self->{'can_link'}{ $table1->name }{ $table2->name };
638 # trivial traversal, only one way to link the two tables
639 if ( scalar( @{ $fk{ $table1->name } } == 1 )
640 and scalar( @{ $fk{ $table2->name } } == 1 ) )
642 $self->{'can_link'}{ $table1->name }{ $table2->name } =
643 [ 'one2one', $fk{ $table1->name }, $fk{ $table2->name } ];
644 $self->{'can_link'}{ $table1->name }{ $table2->name } =
645 [ 'one2one', $fk{ $table2->name }, $fk{ $table1->name } ];
647 # non-trivial traversal. one way to link table2,
648 # many ways to link table1
650 elsif ( scalar( @{ $fk{ $table1->name } } > 1 )
651 and scalar( @{ $fk{ $table2->name } } == 1 ) )
653 $self->{'can_link'}{ $table1->name }{ $table2->name } =
654 [ 'many2one', $fk{ $table1->name }, $fk{ $table2->name } ];
655 $self->{'can_link'}{ $table2->name }{ $table1->name } =
656 [ 'one2many', $fk{ $table2->name }, $fk{ $table1->name } ];
658 # non-trivial traversal. one way to link table1,
659 # many ways to link table2
661 elsif ( scalar( @{ $fk{ $table1->name } } == 1 )
662 and scalar( @{ $fk{ $table2->name } } > 1 ) )
664 $self->{'can_link'}{ $table1->name }{ $table2->name } =
665 [ 'one2many', $fk{ $table1->name }, $fk{ $table2->name } ];
666 $self->{'can_link'}{ $table2->name }{ $table1->name } =
667 [ 'many2one', $fk{ $table2->name }, $fk{ $table1->name } ];
669 # non-trivial traversal. many ways to link table1 and table2
671 elsif ( scalar( @{ $fk{ $table1->name } } > 1 )
672 and scalar( @{ $fk{ $table2->name } } > 1 ) )
674 $self->{'can_link'}{ $table1->name }{ $table2->name } =
675 [ 'many2many', $fk{ $table1->name }, $fk{ $table2->name } ];
676 $self->{'can_link'}{ $table2->name }{ $table1->name } =
677 [ 'many2many', $fk{ $table2->name }, $fk{ $table1->name } ];
679 # one of the tables didn't export a key
680 # to this table, no linking possible
683 $self->{'can_link'}{ $table1->name }{ $table2->name } = [0];
684 $self->{'can_link'}{ $table2->name }{ $table1->name } = [0];
687 return $self->{'can_link'}{ $table1->name }{ $table2->name };
696 Get or set the table's name.
698 Errors ("No table name") if you try to set a blank name.
700 If provided an argument, checks the schema object for a table of
701 that name and disallows the change if one exists (setting the error to
702 "Can't use table name "%s": table exists").
704 my $table_name = $table->name('foo');
711 my $arg = shift || return $self->error( "No table name" );
712 if ( my $schema = $self->schema ) {
713 return $self->error( qq[Can't use table name "$arg": table exists] )
714 if $schema->get_table( $arg );
716 $self->{'name'} = $arg;
719 return $self->{'name'} || '';
728 Get or set the table's schema object.
730 my $schema = $table->schema;
735 if ( my $arg = shift ) {
736 return $self->error('Not a schema object') unless
737 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' );
738 $self->{'schema'} = $arg;
741 return $self->{'schema'};
750 Gets or sets the table's primary key(s). Takes one or more field
751 names (as a string, list or array[ref]) as an argument. If the field
752 names are present, it will create a new PK if none exists, or it will
753 add to the fields of an existing PK (and will unique the field names).
754 Returns the C<SQL::Translator::Schema::Constraint> object representing
759 $table->primary_key('id');
760 $table->primary_key(['name']);
761 $table->primary_key('id','name']);
762 $table->primary_key(['id','name']);
763 $table->primary_key('id,name');
764 $table->primary_key(qw[ id name ]);
766 my $pk = $table->primary_key;
771 my $fields = parse_list_arg( @_ );
775 for my $f ( @$fields ) {
776 return $self->error(qq[Invalid field "$f"]) unless
777 $self->get_field($f);
781 for my $c ( $self->get_constraints ) {
782 if ( $c->type eq PRIMARY_KEY ) {
784 $c->fields( @{ $c->fields }, @$fields );
790 $constraint = $self->add_constraint(
801 for my $c ( $self->get_constraints ) {
802 return $c if $c->type eq PRIMARY_KEY;
815 Get or set the table's options (e.g., table types for MySQL). Returns
816 an array or array reference.
818 my @options = $table->options;
823 my $options = parse_list_arg( @_ );
825 push @{ $self->{'options'} }, @$options;
827 if ( ref $self->{'options'} ) {
828 return wantarray ? @{ $self->{'options'} || [] } : ($self->{'options'} || '');
831 return wantarray ? () : [];
841 Get or set the table's order.
843 my $order = $table->order(3);
847 my ( $self, $arg ) = @_;
849 if ( defined $arg && $arg =~ /^\d+$/ ) {
850 $self->{'order'} = $arg;
853 return $self->{'order'} || 0;
860 Read-only method to return a list or array ref of the field names. Returns undef
861 or an empty list if the table has no fields set. Useful if you want to
862 avoid the overload magic of the Field objects returned by the get_fields method.
864 my @names = $constraint->field_names;
871 sort { $a->order <=> $b->order }
872 values %{ $self->{'fields'} || {} };
875 return wantarray ? @fields : \@fields;
878 $self->error('No fields');
879 return wantarray ? () : undef;
889 Determines if this table is the same as another
891 my $isIdentical = $table1->equals( $table2 );
897 my $case_insensitive = shift;
899 return 0 unless $self->SUPER::equals($other);
900 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
901 return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options);
902 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
905 # Go through our fields
907 foreach my $field ( $self->get_fields ) {
908 my $otherField = $other->get_field($field->name, $case_insensitive);
909 return 0 unless $field->equals($otherField, $case_insensitive);
910 $checkedFields{$field->name} = 1;
912 # Go through the other table's fields
913 foreach my $otherField ( $other->get_fields ) {
914 next if $checkedFields{$otherField->name};
919 # Go through our constraints
920 my %checkedConstraints;
922 foreach my $constraint ( $self->get_constraints ) {
923 foreach my $otherConstraint ( $other->get_constraints ) {
924 if ( $constraint->equals($otherConstraint, $case_insensitive) ) {
925 $checkedConstraints{$otherConstraint} = 1;
931 # Go through the other table's constraints
933 foreach my $otherConstraint ( $other->get_constraints ) {
934 next if $checkedFields{$otherConstraint};
935 foreach my $constraint ( $self->get_constraints ) {
936 if ( $otherConstraint->equals($constraint, $case_insensitive) ) {
944 # Go through our indices
947 foreach my $index ( $self->get_indices ) {
948 foreach my $otherIndex ( $other->get_indices ) {
949 if ( $index->equals($otherIndex, $case_insensitive) ) {
950 $checkedIndices{$otherIndex} = 1;
956 # Go through the other table's indices
958 foreach my $otherIndex ( $other->get_indices ) {
959 next if $checkedIndices{$otherIndex};
960 foreach my $index ( $self->get_indices ) {
961 if ( $otherIndex->equals($index, $case_insensitive) ) {
971 =head1 LOOKUP METHODS
973 The following are a set of shortcut methods for getting commonly used lists of
974 fields and constraints. They all return lists or array refs of Field or
981 The primary key fields.
985 All foreign key fields.
989 All the fields except the primary key.
997 All fields with unique constraints.
999 =item unique_constraints
1001 All this tables unique constraints.
1003 =item fkey_constraints
1005 All this tables foreign key constraints. (See primary_key method to get the
1006 primary key constraint)
1014 my @fields = grep { $_->is_primary_key } $me->get_fields;
1015 return wantarray ? @fields : \@fields;
1021 push @fields, $_->fields foreach $me->fkey_constraints;
1022 return wantarray ? @fields : \@fields;
1025 sub nonpkey_fields {
1027 my @fields = grep { !$_->is_primary_key } $me->get_fields;
1028 return wantarray ? @fields : \@fields;
1034 grep { !$_->is_foreign_key and !$_->is_primary_key } $me->get_fields;
1035 return wantarray ? @fields : \@fields;
1041 push @fields, $_->fields foreach $me->unique_constraints;
1042 return wantarray ? @fields : \@fields;
1045 sub unique_constraints {
1047 my @cons = grep { $_->type eq UNIQUE } $me->get_constraints;
1048 return wantarray ? @cons : \@cons;
1051 sub fkey_constraints {
1053 my @cons = grep { $_->type eq FOREIGN_KEY } $me->get_constraints;
1054 return wantarray ? @cons : \@cons;
1059 undef $self->{'schema'}; # destroy cyclical reference
1060 undef $_ for @{ $self->{'constraints'} };
1061 undef $_ for @{ $self->{'indices'} };
1062 undef $_ for values %{ $self->{'fields'} };
1071 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
1072 Allen Day E<lt>allenday@ucla.eduE<gt>.