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"
288 "partial" and "simple"
290 my $match_type = $constraint->match_type('FULL');
294 my ( $self, $arg ) = @_;
298 return $self->error("Invalid match type: $arg")
299 unless $arg eq 'full' || $arg eq 'partial' || $arg eq 'simple';
300 $self->{'match_type'} = $arg;
303 return $self->{'match_type'} || '';
306 # ----------------------------------------------------------------------
313 Get or set the constraint's name.
315 my $name = $constraint->name('foo');
320 my $arg = shift || '';
321 $self->{'name'} = $arg if $arg;
322 return $self->{'name'} || '';
325 # ----------------------------------------------------------------------
332 Gets or adds to the constraints's options (e.g., "INITIALLY IMMEDIATE").
333 Returns an array or array reference.
335 $constraint->options('NORELY');
336 my @options = $constraint->options;
341 my $options = parse_list_arg( @_ );
343 push @{ $self->{'options'} }, @$options;
345 if ( ref $self->{'options'} ) {
346 return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'};
349 return wantarray ? () : [];
354 # ----------------------------------------------------------------------
361 Get or set the constraint's "on delete" action.
363 my $action = $constraint->on_delete('cascade');
369 if ( my $arg = shift ) {
371 $self->{'on_delete'} = $arg;
374 return $self->{'on_delete'} || '';
377 # ----------------------------------------------------------------------
384 Get or set the constraint's "on update" action.
386 my $action = $constraint->on_update('no action');
392 if ( my $arg = shift ) {
394 $self->{'on_update'} = $arg;
397 return $self->{'on_update'} || '';
400 # ----------------------------------------------------------------------
401 sub reference_fields {
405 =head2 reference_fields
407 Gets and set the fields in the referred table. Accepts a string, list or
408 arrayref; returns an array or array reference.
410 $constraint->reference_fields('id');
411 $constraint->reference_fields('id', 'name');
412 $constraint->reference_fields( 'id, name' );
413 $constraint->reference_fields( [ 'id', 'name' ] );
414 $constraint->reference_fields( qw[ id name ] );
416 my @reference_fields = $constraint->reference_fields;
421 my $fields = parse_list_arg( @_ );
424 $self->{'reference_fields'} = $fields;
427 # Nothing set so try and derive it from the other constraint data
428 unless ( ref $self->{'reference_fields'} ) {
429 my $table = $self->table or return $self->error('No table');
430 my $schema = $table->schema or return $self->error('No schema');
431 if ( my $ref_table_name = $self->reference_table ) {
432 my $ref_table = $schema->get_table( $ref_table_name ) or
433 return $self->error("Can't find table '$ref_table_name'");
435 if ( my $constraint = $ref_table->primary_key ) {
436 $self->{'reference_fields'} = [ $constraint->fields ];
440 'No reference fields defined and cannot find primary key in ',
441 "reference table '$ref_table_name'"
445 # No ref table so we are not that sort of constraint, hence no ref
446 # fields. So we let the return below return an empty list.
449 if ( ref $self->{'reference_fields'} ) {
451 ? @{ $self->{'reference_fields'} }
452 : $self->{'reference_fields'};
455 return wantarray ? () : [];
459 # ----------------------------------------------------------------------
460 sub reference_table {
464 =head2 reference_table
466 Get or set the table referred to by the constraint.
468 my $reference_table = $constraint->reference_table('foo');
473 $self->{'reference_table'} = shift if @_;
474 return $self->{'reference_table'} || '';
477 # ----------------------------------------------------------------------
484 Get or set the constraint's table object.
486 my $table = $field->table;
491 if ( my $arg = shift ) {
492 return $self->error('Not a table object') unless
493 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
494 $self->{'table'} = $arg;
497 return $self->{'table'};
500 # ----------------------------------------------------------------------
507 Get or set the constraint's type.
509 my $type = $constraint->type( PRIMARY_KEY );
513 my ( $self, $type ) = @_;
518 return $self->error("Invalid constraint type: $type")
519 unless $VALID_CONSTRAINT_TYPE{ $type };
520 $self->{'type'} = $type;
523 return $self->{'type'} || '';
526 # ----------------------------------------------------------------------
533 Determines if this constraint is the same as another
535 my $isIdentical = $constraint1->equals( $constraint2 );
541 my $case_insensitive = shift;
542 my $ignore_constraint_names = shift;
544 return 0 unless $self->SUPER::equals($other);
545 return 0 unless $self->type eq $other->type;
546 unless ($ignore_constraint_names) {
547 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
549 return 0 unless $self->deferrable eq $other->deferrable;
550 #return 0 unless $self->is_valid eq $other->is_valid;
551 return 0 unless $case_insensitive ? uc($self->table->name) eq uc($other->table->name)
552 : $self->table->name eq $other->table->name;
553 return 0 unless $self->expression eq $other->expression;
555 # Check fields, regardless of order
556 my %otherFields = (); # create a hash of the other fields
557 foreach my $otherField ($other->fields) {
558 $otherField = uc($otherField) if $case_insensitive;
559 $otherFields{$otherField} = 1;
561 foreach my $selfField ($self->fields) { # check for self fields in hash
562 $selfField = uc($selfField) if $case_insensitive;
563 return 0 unless $otherFields{$selfField};
564 delete $otherFields{$selfField};
566 # Check all other fields were accounted for
567 return 0 unless keys %otherFields == 0;
569 # Check reference fields, regardless of order
570 my %otherRefFields = (); # create a hash of the other reference fields
571 foreach my $otherRefField ($other->reference_fields) {
572 $otherRefField = uc($otherRefField) if $case_insensitive;
573 $otherRefFields{$otherRefField} = 1;
575 foreach my $selfRefField ($self->reference_fields) { # check for self reference fields in hash
576 $selfRefField = uc($selfRefField) if $case_insensitive;
577 return 0 unless $otherRefFields{$selfRefField};
578 delete $otherRefFields{$selfRefField};
580 # Check all other reference fields were accounted for
581 return 0 unless keys %otherRefFields == 0;
583 return 0 unless $case_insensitive ? uc($self->reference_table) eq uc($other->reference_table) : $self->reference_table eq $other->reference_table;
584 return 0 unless $self->match_type eq $other->match_type;
585 return 0 unless $self->on_delete eq $other->on_delete;
586 return 0 unless $self->on_update eq $other->on_update;
587 return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options);
588 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
592 # ----------------------------------------------------------------------
595 undef $self->{'table'}; # destroy cyclical reference
600 # ----------------------------------------------------------------------
606 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.