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.
23 use SQL::Translator::Utils 'parse_list_arg';
24 use SQL::Translator::Schema::Constants;
25 use SQL::Translator::Schema::Constraint;
26 use SQL::Translator::Schema::Field;
27 use SQL::Translator::Schema::Index;
30 use base 'SQL::Translator::Schema::Object';
32 use vars qw( $VERSION );
36 # Stringify to our name, being careful not to pass any args through so we don't
37 # accidentally set it to undef. We also have to tweak bool so the object is
38 # still true when it doesn't have a name (which shouldn't happen!).
40 '""' => sub { shift->name },
41 'bool' => sub { $_[0]->name || $_[0] },
45 __PACKAGE__->_attributes( qw/schema name comments options order/ );
53 my $table = SQL::Translator::Schema::Table->new(
62 my $self = $class->SUPER::new (@_)
65 $self->{_order} = { map { $_ => 0 } qw/
78 Add a constraint to the table. Returns the newly created
79 C<SQL::Translator::Schema::Constraint> object.
81 my $c1 = $table->add_constraint(
84 fields => [ 'foo_id' ],
87 my $c2 = SQL::Translator::Schema::Constraint->new( name => 'uniq' );
88 $c2 = $table->add_constraint( $constraint );
93 my $constraint_class = 'SQL::Translator::Schema::Constraint';
96 if ( UNIVERSAL::isa( $_[0], $constraint_class ) ) {
98 $constraint->table( $self );
102 $args{'table'} = $self;
103 $constraint = $constraint_class->new( \%args ) or
104 return $self->error( $constraint_class->error );
108 # If we're trying to add a PK when one is already defined,
109 # then just add the fields to the existing definition.
112 my $pk = $self->primary_key;
113 if ( $pk && $constraint->type eq PRIMARY_KEY ) {
114 $self->primary_key( $constraint->fields );
115 $pk->name($constraint->name) if $constraint->name;
116 my %extra = $constraint->extra;
117 $pk->extra(%extra) if keys %extra;
121 elsif ( $constraint->type eq PRIMARY_KEY ) {
122 for my $fname ( $constraint->fields ) {
123 if ( my $f = $self->get_field( $fname ) ) {
124 $f->is_primary_key( 1 );
129 # See if another constraint of the same type
130 # covers the same fields. -- This doesn't work! ky
132 # elsif ( $constraint->type ne CHECK_C ) {
133 # my @field_names = $constraint->fields;
135 # grep { $_->type eq $constraint->type }
136 # $self->get_constraints
138 # my %fields = map { $_, 1 } $c->fields;
139 # for my $field_name ( @field_names ) {
140 # if ( $fields{ $field_name } ) {
151 push @{ $self->{'constraints'} }, $constraint;
157 sub drop_constraint {
161 =head2 drop_constraint
163 Remove a constraint from the table. Returns the constraint object if the index
164 was found and removed, an error otherwise. The single parameter can be either
165 an index name or an C<SQL::Translator::Schema::Constraint> object.
167 $table->drop_constraint('myconstraint');
172 my $constraint_class = 'SQL::Translator::Schema::Constraint';
175 if ( UNIVERSAL::isa( $_[0], $constraint_class ) ) {
176 $constraint_name = shift->name;
179 $constraint_name = shift;
182 if ( ! grep { $_->name eq $constraint_name } @ { $self->{'constraints'} } ) {
183 return $self->error(qq[Can't drop constraint: "$constraint_name" doesn't exist]);
186 my @cs = @{ $self->{'constraints'} };
187 my ($constraint_id) = grep { $cs[$_]->name eq $constraint_name } (0..$#cs);
188 my $constraint = splice(@{$self->{'constraints'}}, $constraint_id, 1);
199 Add an index to the table. Returns the newly created
200 C<SQL::Translator::Schema::Index> object.
202 my $i1 = $table->add_index(
204 fields => [ 'name' ],
208 my $i2 = SQL::Translator::Schema::Index->new( name => 'id' );
209 $i2 = $table->add_index( $index );
214 my $index_class = 'SQL::Translator::Schema::Index';
217 if ( UNIVERSAL::isa( $_[0], $index_class ) ) {
219 $index->table( $self );
223 $args{'table'} = $self;
224 $index = $index_class->new( \%args ) or return
225 $self->error( $index_class->error );
227 foreach my $ex_index ($self->get_indices) {
228 return if ($ex_index->equals($index));
230 push @{ $self->{'indices'} }, $index;
240 Remove an index from the table. Returns the index object if the index was
241 found and removed, an error otherwise. The single parameter can be either
242 an index name of an C<SQL::Translator::Schema::Index> object.
244 $table->drop_index('myindex');
249 my $index_class = 'SQL::Translator::Schema::Index';
252 if ( UNIVERSAL::isa( $_[0], $index_class ) ) {
253 $index_name = shift->name;
259 if ( ! grep { $_->name eq $index_name } @{ $self->{'indices'} }) {
260 return $self->error(qq[Can't drop index: "$index_name" doesn't exist]);
263 my @is = @{ $self->{'indices'} };
264 my ($index_id) = grep { $is[$_]->name eq $index_name } (0..$#is);
265 my $index = splice(@{$self->{'indices'}}, $index_id, 1);
276 Add an field to the table. Returns the newly created
277 C<SQL::Translator::Schema::Field> object. The "name" parameter is
278 required. If you try to create a field with the same name as an
279 existing field, you will get an error and the field will not be created.
281 my $f1 = $table->add_field(
283 data_type => 'integer',
287 my $f2 = SQL::Translator::Schema::Field->new(
291 $f2 = $table->add_field( $field2 ) or die $table->error;
296 my $field_class = 'SQL::Translator::Schema::Field';
299 if ( UNIVERSAL::isa( $_[0], $field_class ) ) {
301 $field->table( $self );
305 $args{'table'} = $self;
306 $field = $field_class->new( \%args ) or return
307 $self->error( $field_class->error );
310 $field->order( ++$self->{_order}{field} );
311 # We know we have a name as the Field->new above errors if none given.
312 my $field_name = $field->name;
314 if ( exists $self->{'fields'}{ $field_name } ) {
315 return $self->error(qq[Can't create field: "$field_name" exists]);
318 $self->{'fields'}{ $field_name } = $field;
330 Remove a field from the table. Returns the field object if the field was
331 found and removed, an error otherwise. The single parameter can be either
332 a field name or an C<SQL::Translator::Schema::Field> object.
334 $table->drop_field('myfield');
339 my $field_class = 'SQL::Translator::Schema::Field';
342 if ( UNIVERSAL::isa( $_[0], $field_class ) ) {
343 $field_name = shift->name;
349 my $cascade = $args{'cascade'};
351 if ( ! exists $self->{'fields'}{ $field_name } ) {
352 return $self->error(qq[Can't drop field: "$field_name" doesn't exists]);
355 my $field = delete $self->{'fields'}{ $field_name };
358 # Remove this field from all indices using it
359 foreach my $i ($self->get_indices()) {
360 my @fs = $i->fields();
361 @fs = grep { $_ ne $field->name } @fs;
365 # Remove this field from all constraints using it
366 foreach my $c ($self->get_constraints()) {
367 my @cs = $c->fields();
368 @cs = grep { $_ ne $field->name } @cs;
382 Get or set the comments on a table. May be called several times to
383 set and it will accumulate the comments. Called in an array context,
384 returns each comment individually; called in a scalar context, returns
385 all the comments joined on newlines.
387 $table->comments('foo');
388 $table->comments('bar');
389 print join( ', ', $table->comments ); # prints "foo, bar"
394 my @comments = ref $_[0] ? @{ $_[0] } : @_;
396 for my $arg ( @comments ) {
397 $arg = $arg->[0] if ref $arg;
398 push @{ $self->{'comments'} }, $arg if defined $arg && $arg;
401 if ( @{ $self->{'comments'} || [] } ) {
403 ? @{ $self->{'comments'} }
404 : join( "\n", @{ $self->{'comments'} } )
408 return wantarray ? () : undef;
412 sub get_constraints {
416 =head2 get_constraints
418 Returns all the constraint objects as an array or array reference.
420 my @constraints = $table->get_constraints;
426 if ( ref $self->{'constraints'} ) {
428 ? @{ $self->{'constraints'} } : $self->{'constraints'};
431 $self->error('No constraints');
432 return wantarray ? () : undef;
442 Returns all the index objects as an array or array reference.
444 my @indices = $table->get_indices;
450 if ( ref $self->{'indices'} ) {
452 ? @{ $self->{'indices'} }
453 : $self->{'indices'};
456 $self->error('No indices');
457 return wantarray ? () : undef;
467 Returns a field by the name provided.
469 my $field = $table->get_field('foo');
474 my $field_name = shift or return $self->error('No field name');
475 my $case_insensitive = shift;
476 if ( $case_insensitive ) {
477 $field_name = uc($field_name);
478 foreach my $field ( keys %{$self->{fields}} ) {
479 return $self->{fields}{$field} if $field_name eq uc($field);
481 return $self->error(qq[Field "$field_name" does not exist]);
483 return $self->error( qq[Field "$field_name" does not exist] ) unless
484 exists $self->{'fields'}{ $field_name };
485 return $self->{'fields'}{ $field_name };
494 Returns all the field objects as an array or array reference.
496 my @fields = $table->get_fields;
503 sort { $a->[0] <=> $b->[0] }
504 map { [ $_->order, $_ ] }
505 values %{ $self->{'fields'} || {} };
508 return wantarray ? @fields : \@fields;
511 $self->error('No fields');
512 return wantarray ? () : undef;
522 Determine whether the view is valid or not.
524 my $ok = $view->is_valid;
529 return $self->error('No name') unless $self->name;
530 return $self->error('No fields') unless $self->get_fields;
533 $self->get_fields, $self->get_indices, $self->get_constraints
535 return $object->error unless $object->is_valid;
541 sub is_trivial_link {
545 =head2 is_trivial_link
547 True if table has no data (non-key) fields and only uses single key joins.
552 return 0 if $self->is_data;
553 return $self->{'is_trivial_link'} if defined $self->{'is_trivial_link'};
555 $self->{'is_trivial_link'} = 1;
559 foreach my $field ( $self->get_fields ) {
560 next unless $field->is_foreign_key;
561 $fk{$field->foreign_key_reference->reference_table}++;
564 foreach my $referenced (keys %fk){
565 if($fk{$referenced} > 1){
566 $self->{'is_trivial_link'} = 0;
571 return $self->{'is_trivial_link'};
581 Returns true if the table has some non-key fields.
586 return $self->{'is_data'} if defined $self->{'is_data'};
588 $self->{'is_data'} = 0;
590 foreach my $field ( $self->get_fields ) {
591 if ( !$field->is_primary_key and !$field->is_foreign_key ) {
592 $self->{'is_data'} = 1;
593 return $self->{'is_data'};
597 return $self->{'is_data'};
606 Determine whether the table can link two arg tables via many-to-many.
608 my $ok = $table->can_link($table1,$table2);
612 my ( $self, $table1, $table2 ) = @_;
614 return $self->{'can_link'}{ $table1->name }{ $table2->name }
615 if defined $self->{'can_link'}{ $table1->name }{ $table2->name };
617 if ( $self->is_data == 1 ) {
618 $self->{'can_link'}{ $table1->name }{ $table2->name } = [0];
619 $self->{'can_link'}{ $table2->name }{ $table1->name } = [0];
620 return $self->{'can_link'}{ $table1->name }{ $table2->name };
625 foreach my $field ( $self->get_fields ) {
626 if ( $field->is_foreign_key ) {
627 push @{ $fk{ $field->foreign_key_reference->reference_table } },
628 $field->foreign_key_reference;
632 if ( !defined( $fk{ $table1->name } ) or !defined( $fk{ $table2->name } ) )
634 $self->{'can_link'}{ $table1->name }{ $table2->name } = [0];
635 $self->{'can_link'}{ $table2->name }{ $table1->name } = [0];
636 return $self->{'can_link'}{ $table1->name }{ $table2->name };
639 # trivial traversal, only one way to link the two tables
640 if ( scalar( @{ $fk{ $table1->name } } == 1 )
641 and scalar( @{ $fk{ $table2->name } } == 1 ) )
643 $self->{'can_link'}{ $table1->name }{ $table2->name } =
644 [ 'one2one', $fk{ $table1->name }, $fk{ $table2->name } ];
645 $self->{'can_link'}{ $table1->name }{ $table2->name } =
646 [ 'one2one', $fk{ $table2->name }, $fk{ $table1->name } ];
648 # non-trivial traversal. one way to link table2,
649 # many ways to link table1
651 elsif ( scalar( @{ $fk{ $table1->name } } > 1 )
652 and scalar( @{ $fk{ $table2->name } } == 1 ) )
654 $self->{'can_link'}{ $table1->name }{ $table2->name } =
655 [ 'many2one', $fk{ $table1->name }, $fk{ $table2->name } ];
656 $self->{'can_link'}{ $table2->name }{ $table1->name } =
657 [ 'one2many', $fk{ $table2->name }, $fk{ $table1->name } ];
659 # non-trivial traversal. one way to link table1,
660 # many ways to link table2
662 elsif ( scalar( @{ $fk{ $table1->name } } == 1 )
663 and scalar( @{ $fk{ $table2->name } } > 1 ) )
665 $self->{'can_link'}{ $table1->name }{ $table2->name } =
666 [ 'one2many', $fk{ $table1->name }, $fk{ $table2->name } ];
667 $self->{'can_link'}{ $table2->name }{ $table1->name } =
668 [ 'many2one', $fk{ $table2->name }, $fk{ $table1->name } ];
670 # non-trivial traversal. many ways to link table1 and table2
672 elsif ( scalar( @{ $fk{ $table1->name } } > 1 )
673 and scalar( @{ $fk{ $table2->name } } > 1 ) )
675 $self->{'can_link'}{ $table1->name }{ $table2->name } =
676 [ 'many2many', $fk{ $table1->name }, $fk{ $table2->name } ];
677 $self->{'can_link'}{ $table2->name }{ $table1->name } =
678 [ 'many2many', $fk{ $table2->name }, $fk{ $table1->name } ];
680 # one of the tables didn't export a key
681 # to this table, no linking possible
684 $self->{'can_link'}{ $table1->name }{ $table2->name } = [0];
685 $self->{'can_link'}{ $table2->name }{ $table1->name } = [0];
688 return $self->{'can_link'}{ $table1->name }{ $table2->name };
697 Get or set the table's name.
699 Errors ("No table name") if you try to set a blank name.
701 If provided an argument, checks the schema object for a table of
702 that name and disallows the change if one exists (setting the error to
703 "Can't use table name "%s": table exists").
705 my $table_name = $table->name('foo');
712 my $arg = shift || return $self->error( "No table name" );
713 if ( my $schema = $self->schema ) {
714 return $self->error( qq[Can't use table name "$arg": table exists] )
715 if $schema->get_table( $arg );
717 $self->{'name'} = $arg;
720 return $self->{'name'} || '';
729 Get or set the table's schema object.
731 my $schema = $table->schema;
736 if ( my $arg = shift ) {
737 return $self->error('Not a schema object') unless
738 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' );
739 $self->{'schema'} = $arg;
742 return $self->{'schema'};
751 Gets or sets the table's primary key(s). Takes one or more field
752 names (as a string, list or array[ref]) as an argument. If the field
753 names are present, it will create a new PK if none exists, or it will
754 add to the fields of an existing PK (and will unique the field names).
755 Returns the C<SQL::Translator::Schema::Constraint> object representing
760 $table->primary_key('id');
761 $table->primary_key(['name']);
762 $table->primary_key('id','name']);
763 $table->primary_key(['id','name']);
764 $table->primary_key('id,name');
765 $table->primary_key(qw[ id name ]);
767 my $pk = $table->primary_key;
772 my $fields = parse_list_arg( @_ );
776 for my $f ( @$fields ) {
777 return $self->error(qq[Invalid field "$f"]) unless
778 $self->get_field($f);
782 for my $c ( $self->get_constraints ) {
783 if ( $c->type eq PRIMARY_KEY ) {
785 $c->fields( @{ $c->fields }, @$fields );
791 $constraint = $self->add_constraint(
802 for my $c ( $self->get_constraints ) {
803 return $c if $c->type eq PRIMARY_KEY;
816 Get or set the table's options (e.g., table types for MySQL). Returns
817 an array or array reference.
819 my @options = $table->options;
824 my $options = parse_list_arg( @_ );
826 push @{ $self->{'options'} }, @$options;
828 if ( ref $self->{'options'} ) {
829 return wantarray ? @{ $self->{'options'} || [] } : ($self->{'options'} || '');
832 return wantarray ? () : [];
842 Get or set the table's order.
844 my $order = $table->order(3);
848 my ( $self, $arg ) = @_;
850 if ( defined $arg && $arg =~ /^\d+$/ ) {
851 $self->{'order'} = $arg;
854 return $self->{'order'} || 0;
861 Read-only method to return a list or array ref of the field names. Returns undef
862 or an empty list if the table has no fields set. Useful if you want to
863 avoid the overload magic of the Field objects returned by the get_fields method.
865 my @names = $constraint->field_names;
872 sort { $a->order <=> $b->order }
873 values %{ $self->{'fields'} || {} };
876 return wantarray ? @fields : \@fields;
879 $self->error('No fields');
880 return wantarray ? () : undef;
890 Determines if this table is the same as another
892 my $isIdentical = $table1->equals( $table2 );
898 my $case_insensitive = shift;
900 return 0 unless $self->SUPER::equals($other);
901 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
902 return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options);
903 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
906 # Go through our fields
908 foreach my $field ( $self->get_fields ) {
909 my $otherField = $other->get_field($field->name, $case_insensitive);
910 return 0 unless $field->equals($otherField, $case_insensitive);
911 $checkedFields{$field->name} = 1;
913 # Go through the other table's fields
914 foreach my $otherField ( $other->get_fields ) {
915 next if $checkedFields{$otherField->name};
920 # Go through our constraints
921 my %checkedConstraints;
923 foreach my $constraint ( $self->get_constraints ) {
924 foreach my $otherConstraint ( $other->get_constraints ) {
925 if ( $constraint->equals($otherConstraint, $case_insensitive) ) {
926 $checkedConstraints{$otherConstraint} = 1;
932 # Go through the other table's constraints
934 foreach my $otherConstraint ( $other->get_constraints ) {
935 next if $checkedFields{$otherConstraint};
936 foreach my $constraint ( $self->get_constraints ) {
937 if ( $otherConstraint->equals($constraint, $case_insensitive) ) {
945 # Go through our indices
948 foreach my $index ( $self->get_indices ) {
949 foreach my $otherIndex ( $other->get_indices ) {
950 if ( $index->equals($otherIndex, $case_insensitive) ) {
951 $checkedIndices{$otherIndex} = 1;
957 # Go through the other table's indices
959 foreach my $otherIndex ( $other->get_indices ) {
960 next if $checkedIndices{$otherIndex};
961 foreach my $index ( $self->get_indices ) {
962 if ( $otherIndex->equals($index, $case_insensitive) ) {
972 =head1 LOOKUP METHODS
974 The following are a set of shortcut methods for getting commonly used lists of
975 fields and constraints. They all return lists or array refs of Field or
982 The primary key fields.
986 All foreign key fields.
990 All the fields except the primary key.
998 All fields with unique constraints.
1000 =item unique_constraints
1002 All this tables unique constraints.
1004 =item fkey_constraints
1006 All this tables foreign key constraints. (See primary_key method to get the
1007 primary key constraint)
1015 my @fields = grep { $_->is_primary_key } $me->get_fields;
1016 return wantarray ? @fields : \@fields;
1022 push @fields, $_->fields foreach $me->fkey_constraints;
1023 return wantarray ? @fields : \@fields;
1026 sub nonpkey_fields {
1028 my @fields = grep { !$_->is_primary_key } $me->get_fields;
1029 return wantarray ? @fields : \@fields;
1035 grep { !$_->is_foreign_key and !$_->is_primary_key } $me->get_fields;
1036 return wantarray ? @fields : \@fields;
1042 push @fields, $_->fields foreach $me->unique_constraints;
1043 return wantarray ? @fields : \@fields;
1046 sub unique_constraints {
1048 my @cons = grep { $_->type eq UNIQUE } $me->get_constraints;
1049 return wantarray ? @cons : \@cons;
1052 sub fkey_constraints {
1054 my @cons = grep { $_->type eq FOREIGN_KEY } $me->get_constraints;
1055 return wantarray ? @cons : \@cons;
1060 undef $self->{'schema'}; # destroy cyclical reference
1061 undef $_ for @{ $self->{'constraints'} };
1062 undef $_ for @{ $self->{'indices'} };
1063 undef $_ for values %{ $self->{'fields'} };
1072 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
1073 Allen Day E<lt>allenday@ucla.eduE<gt>.