1 package SQL::Translator::Schema::Constraint;
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::Constraint - SQL::Translator constraint object
29 use SQL::Translator::Schema::Constraint;
30 my $constraint = SQL::Translator::Schema::Constraint->new(
38 C<SQL::Translator::Schema::Constraint> is the constraint object.
45 use SQL::Translator::Schema::Constants;
46 use SQL::Translator::Utils 'parse_list_arg';
48 use base 'SQL::Translator::Schema::Object';
50 use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
54 my %VALID_CONSTRAINT_TYPE = (
62 # ----------------------------------------------------------------------
64 __PACKAGE__->_attributes( qw/
65 table name type fields reference_fields reference_table
66 match_type on_delete on_update expression deferrable
69 # Override to remove empty arrays from args.
70 # t/14postgres-parser breaks without this.
79 my $schema = SQL::Translator::Schema::Constraint->new(
80 table => $table, # table to which it belongs
81 type => 'foreign_key', # type of table constraint
82 name => 'fk_phone_id', # name of the constraint
83 fields => 'phone_id', # field in the referring table
84 reference_fields => 'phone_id', # referenced field
85 reference_table => 'phone', # referenced table
86 match_type => 'full', # how to match
87 on_delete => 'cascade', # what to do on deletes
88 on_update => '', # what to do on updates
94 foreach ( values %{$_[0]} ) { $_ = undef if ref($_) eq "ARRAY" && ! @$_; }
95 $self->SUPER::init(@_);
98 # ----------------------------------------------------------------------
105 Get or set whether the constraint is deferrable. If not defined,
106 then returns "1." The argument is evaluated by Perl for True or
107 False, so the following are eqivalent:
109 $deferrable = $field->deferrable(0);
110 $deferrable = $field->deferrable('');
111 $deferrable = $field->deferrable('0');
115 my ( $self, $arg ) = @_;
117 if ( defined $arg ) {
118 $self->{'deferrable'} = $arg ? 1 : 0;
121 return defined $self->{'deferrable'} ? $self->{'deferrable'} : 1;
124 # ----------------------------------------------------------------------
131 Gets and set the expression used in a CHECK constraint.
133 my $expression = $constraint->expression('...');
139 if ( my $arg = shift ) {
141 $self->{'expression'} = $arg;
144 return $self->{'expression'} || '';
147 # ----------------------------------------------------------------------
154 Determine whether the constraint is valid or not.
156 my $ok = $constraint->is_valid;
161 my $type = $self->type or return $self->error('No type');
162 my $table = $self->table or return $self->error('No table');
163 my @fields = $self->fields or return $self->error('No fields');
164 my $table_name = $table->name or return $self->error('No table name');
166 for my $f ( @fields ) {
167 next if $table->get_field( $f );
169 "Constraint references non-existent field '$f' ",
170 "in table '$table_name'"
174 my $schema = $table->schema or return $self->error(
175 'Table ', $table->name, ' has no schema object'
178 if ( $type eq FOREIGN_KEY ) {
179 return $self->error('Only one field allowed for foreign key')
180 if scalar @fields > 1;
182 my $ref_table_name = $self->reference_table or
183 return $self->error('No reference table');
185 my $ref_table = $schema->get_table( $ref_table_name ) or
186 return $self->error("No table named '$ref_table_name' in schema");
188 my @ref_fields = $self->reference_fields or return;
190 return $self->error('Only one field allowed for foreign key reference')
191 if scalar @ref_fields > 1;
193 for my $ref_field ( @ref_fields ) {
194 next if $ref_table->get_field( $ref_field );
196 "Constraint from field(s) ",
197 join(', ', map {qq['$table_name.$_']} @fields),
198 " to non-existent field '$ref_table_name.$ref_field'"
202 elsif ( $type eq CHECK_C ) {
203 return $self->error('No expression for CHECK') unless
210 # ----------------------------------------------------------------------
217 Gets and set the fields the constraint is on. Accepts a string, list or
218 arrayref; returns an array or array reference. Will unique the field
219 names and keep them in order by the first occurrence of a field name.
221 The fields are returned as Field objects if they exist or as plain
222 names if not. (If you just want the names and want to avoid the Field's overload
223 magic use L<field_names>).
225 Returns undef or an empty list if the constraint has no fields set.
227 $constraint->fields('id');
228 $constraint->fields('id', 'name');
229 $constraint->fields( 'id, name' );
230 $constraint->fields( [ 'id', 'name' ] );
231 $constraint->fields( qw[ id name ] );
233 my @fields = $constraint->fields;
238 my $fields = parse_list_arg( @_ );
241 my ( %unique, @unique );
242 for my $f ( @$fields ) {
243 next if $unique{ $f };
248 $self->{'fields'} = \@unique;
251 if ( @{ $self->{'fields'} || [] } ) {
252 # We have to return fields that don't exist on the table as names in
253 # case those fields havn't been created yet.
255 $self->table->get_field($_) || $_ } @{ $self->{'fields'} };
256 return wantarray ? @ret : \@ret;
259 return wantarray ? () : undef;
263 # ----------------------------------------------------------------------
268 Read-only method to return a list or array ref of the field names. Returns undef
269 or an empty list if the constraint has no fields set. Usefull if you want to
270 avoid the overload magic of the Field objects returned by the fields method.
272 my @names = $constraint->field_names;
277 return wantarray ? @{ $self->{'fields'} || [] } : ($self->{'fields'} || '');
280 # ----------------------------------------------------------------------
287 Get or set the constraint's match_type. Only valid values are "full"
290 my $match_type = $constraint->match_type('FULL');
296 if ( my $arg = lc shift ) {
297 return $self->error("Invalid match type: $arg")
298 unless $arg eq 'full' || $arg eq 'partial';
299 $self->{'match_type'} = $arg;
302 return $self->{'match_type'} || '';
305 # ----------------------------------------------------------------------
312 Get or set the constraint's name.
314 my $name = $constraint->name('foo');
319 my $arg = shift || '';
320 $self->{'name'} = $arg if $arg;
321 return $self->{'name'} || '';
324 # ----------------------------------------------------------------------
331 Gets or adds to the constraints's options (e.g., "INITIALLY IMMEDIATE").
332 Returns an array or array reference.
334 $constraint->options('NORELY');
335 my @options = $constraint->options;
340 my $options = parse_list_arg( @_ );
342 push @{ $self->{'options'} }, @$options;
344 if ( ref $self->{'options'} ) {
345 return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'};
348 return wantarray ? () : [];
353 # ----------------------------------------------------------------------
360 Get or set the constraint's "on delete" action.
362 my $action = $constraint->on_delete('cascade');
368 if ( my $arg = shift ) {
370 $self->{'on_delete'} = $arg;
373 return $self->{'on_delete'} || '';
376 # ----------------------------------------------------------------------
383 Get or set the constraint's "on update" action.
385 my $action = $constraint->on_update('no action');
391 if ( my $arg = shift ) {
393 $self->{'on_update'} = $arg;
396 return $self->{'on_update'} || '';
399 # ----------------------------------------------------------------------
400 sub reference_fields {
404 =head2 reference_fields
406 Gets and set the fields in the referred table. Accepts a string, list or
407 arrayref; returns an array or array reference.
409 $constraint->reference_fields('id');
410 $constraint->reference_fields('id', 'name');
411 $constraint->reference_fields( 'id, name' );
412 $constraint->reference_fields( [ 'id', 'name' ] );
413 $constraint->reference_fields( qw[ id name ] );
415 my @reference_fields = $constraint->reference_fields;
420 my $fields = parse_list_arg( @_ );
423 $self->{'reference_fields'} = $fields;
426 # Nothing set so try and derive it from the other constraint data
427 unless ( ref $self->{'reference_fields'} ) {
428 my $table = $self->table or return $self->error('No table');
429 my $schema = $table->schema or return $self->error('No schema');
430 if ( my $ref_table_name = $self->reference_table ) {
431 my $ref_table = $schema->get_table( $ref_table_name ) or
432 return $self->error("Can't find table '$ref_table_name'");
434 if ( my $constraint = $ref_table->primary_key ) {
435 $self->{'reference_fields'} = [ $constraint->fields ];
439 'No reference fields defined and cannot find primary key in ',
440 "reference table '$ref_table_name'"
444 # No ref table so we are not that sort of constraint, hence no ref
445 # fields. So we let the return below return an empty list.
448 if ( ref $self->{'reference_fields'} ) {
450 ? @{ $self->{'reference_fields'} }
451 : $self->{'reference_fields'};
454 return wantarray ? () : [];
458 # ----------------------------------------------------------------------
459 sub reference_table {
463 =head2 reference_table
465 Get or set the table referred to by the constraint.
467 my $reference_table = $constraint->reference_table('foo');
472 $self->{'reference_table'} = shift if @_;
473 return $self->{'reference_table'} || '';
476 # ----------------------------------------------------------------------
483 Get or set the constraint's table object.
485 my $table = $field->table;
490 if ( my $arg = shift ) {
491 return $self->error('Not a table object') unless
492 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
493 $self->{'table'} = $arg;
496 return $self->{'table'};
499 # ----------------------------------------------------------------------
506 Get or set the constraint's type.
508 my $type = $constraint->type( PRIMARY_KEY );
514 if ( my $type = uc shift ) {
516 return $self->error("Invalid constraint type: $type")
517 unless $VALID_CONSTRAINT_TYPE{ $type };
518 $self->{'type'} = $type;
521 return $self->{'type'} || '';
524 # ----------------------------------------------------------------------
531 Determines if this constraint is the same as another
533 my $isIdentical = $constraint1->equals( $constraint2 );
539 my $case_insensitive = shift;
540 my $ignore_constraint_names = shift;
542 return 0 unless $self->SUPER::equals($other);
543 return 0 unless $self->type eq $other->type;
544 unless ($ignore_constraint_names) {
545 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
547 return 0 unless $self->deferrable eq $other->deferrable;
548 #return 0 unless $self->is_valid eq $other->is_valid;
549 return 0 unless $case_insensitive ? uc($self->table->name) eq uc($other->table->name)
550 : $self->table->name eq $other->table->name;
551 return 0 unless $self->expression eq $other->expression;
553 # Check fields, regardless of order
554 my %otherFields = (); # create a hash of the other fields
555 foreach my $otherField ($other->fields) {
556 $otherField = uc($otherField) if $case_insensitive;
557 $otherFields{$otherField} = 1;
559 foreach my $selfField ($self->fields) { # check for self fields in hash
560 $selfField = uc($selfField) if $case_insensitive;
561 return 0 unless $otherFields{$selfField};
562 delete $otherFields{$selfField};
564 # Check all other fields were accounted for
565 return 0 unless keys %otherFields == 0;
567 # Check reference fields, regardless of order
568 my %otherRefFields = (); # create a hash of the other reference fields
569 foreach my $otherRefField ($other->reference_fields) {
570 $otherRefField = uc($otherRefField) if $case_insensitive;
571 $otherRefFields{$otherRefField} = 1;
573 foreach my $selfRefField ($self->reference_fields) { # check for self reference fields in hash
574 $selfRefField = uc($selfRefField) if $case_insensitive;
575 return 0 unless $otherRefFields{$selfRefField};
576 delete $otherRefFields{$selfRefField};
578 # Check all other reference fields were accounted for
579 return 0 unless keys %otherRefFields == 0;
581 return 0 unless $case_insensitive ? uc($self->reference_table) eq uc($other->reference_table) : $self->reference_table eq $other->reference_table;
582 return 0 unless $self->match_type eq $other->match_type;
583 return 0 unless $self->on_delete eq $other->on_delete;
584 return 0 unless $self->on_update eq $other->on_update;
585 return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options);
586 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
590 # ----------------------------------------------------------------------
593 undef $self->{'table'}; # destroy cyclical reference
598 # ----------------------------------------------------------------------
604 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.