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 __PACKAGE__->_attributes( qw/
63 table name type fields reference_fields reference_table
64 match_type on_delete on_update expression deferrable
67 # Override to remove empty arrays from args.
68 # t/14postgres-parser breaks without this.
77 my $schema = SQL::Translator::Schema::Constraint->new(
78 table => $table, # table to which it belongs
79 type => 'foreign_key', # type of table constraint
80 name => 'fk_phone_id', # name of the constraint
81 fields => 'phone_id', # field in the referring table
82 reference_fields => 'phone_id', # referenced field
83 reference_table => 'phone', # referenced table
84 match_type => 'full', # how to match
85 on_delete => 'cascade', # what to do on deletes
86 on_update => '', # what to do on updates
92 foreach ( values %{$_[0]} ) { $_ = undef if ref($_) eq "ARRAY" && ! @$_; }
93 $self->SUPER::init(@_);
102 Get or set whether the constraint is deferrable. If not defined,
103 then returns "1." The argument is evaluated by Perl for True or
104 False, so the following are eqivalent:
106 $deferrable = $field->deferrable(0);
107 $deferrable = $field->deferrable('');
108 $deferrable = $field->deferrable('0');
112 my ( $self, $arg ) = @_;
114 if ( defined $arg ) {
115 $self->{'deferrable'} = $arg ? 1 : 0;
118 return defined $self->{'deferrable'} ? $self->{'deferrable'} : 1;
127 Gets and set the expression used in a CHECK constraint.
129 my $expression = $constraint->expression('...');
135 if ( my $arg = shift ) {
137 $self->{'expression'} = $arg;
140 return $self->{'expression'} || '';
149 Determine whether the constraint is valid or not.
151 my $ok = $constraint->is_valid;
156 my $type = $self->type or return $self->error('No type');
157 my $table = $self->table or return $self->error('No table');
158 my @fields = $self->fields or return $self->error('No fields');
159 my $table_name = $table->name or return $self->error('No table name');
161 for my $f ( @fields ) {
162 next if $table->get_field( $f );
164 "Constraint references non-existent field '$f' ",
165 "in table '$table_name'"
169 my $schema = $table->schema or return $self->error(
170 'Table ', $table->name, ' has no schema object'
173 if ( $type eq FOREIGN_KEY ) {
174 return $self->error('Only one field allowed for foreign key')
175 if scalar @fields > 1;
177 my $ref_table_name = $self->reference_table or
178 return $self->error('No reference table');
180 my $ref_table = $schema->get_table( $ref_table_name ) or
181 return $self->error("No table named '$ref_table_name' in schema");
183 my @ref_fields = $self->reference_fields or return;
185 return $self->error('Only one field allowed for foreign key reference')
186 if scalar @ref_fields > 1;
188 for my $ref_field ( @ref_fields ) {
189 next if $ref_table->get_field( $ref_field );
191 "Constraint from field(s) ",
192 join(', ', map {qq['$table_name.$_']} @fields),
193 " to non-existent field '$ref_table_name.$ref_field'"
197 elsif ( $type eq CHECK_C ) {
198 return $self->error('No expression for CHECK') unless
211 Gets and set the fields the constraint is on. Accepts a string, list or
212 arrayref; returns an array or array reference. Will unique the field
213 names and keep them in order by the first occurrence of a field name.
215 The fields are returned as Field objects if they exist or as plain
216 names if not. (If you just want the names and want to avoid the Field's overload
217 magic use L<field_names>).
219 Returns undef or an empty list if the constraint has no fields set.
221 $constraint->fields('id');
222 $constraint->fields('id', 'name');
223 $constraint->fields( 'id, name' );
224 $constraint->fields( [ 'id', 'name' ] );
225 $constraint->fields( qw[ id name ] );
227 my @fields = $constraint->fields;
232 my $fields = parse_list_arg( @_ );
235 my ( %unique, @unique );
236 for my $f ( @$fields ) {
237 next if $unique{ $f };
242 $self->{'fields'} = \@unique;
245 if ( @{ $self->{'fields'} || [] } ) {
246 # We have to return fields that don't exist on the table as names in
247 # case those fields havn't been created yet.
249 $self->table->get_field($_) || $_ } @{ $self->{'fields'} };
250 return wantarray ? @ret : \@ret;
253 return wantarray ? () : undef;
261 Read-only method to return a list or array ref of the field names. Returns undef
262 or an empty list if the constraint has no fields set. Useful if you want to
263 avoid the overload magic of the Field objects returned by the fields method.
265 my @names = $constraint->field_names;
270 return wantarray ? @{ $self->{'fields'} || [] } : ($self->{'fields'} || '');
279 Get or set the constraint's match_type. Only valid values are "full"
280 "partial" and "simple"
282 my $match_type = $constraint->match_type('FULL');
286 my ( $self, $arg ) = @_;
290 return $self->error("Invalid match type: $arg")
291 unless $arg eq 'full' || $arg eq 'partial' || $arg eq 'simple';
292 $self->{'match_type'} = $arg;
295 return $self->{'match_type'} || '';
304 Get or set the constraint's name.
306 my $name = $constraint->name('foo');
311 my $arg = shift || '';
312 $self->{'name'} = $arg if $arg;
313 return $self->{'name'} || '';
322 Gets or adds to the constraints's options (e.g., "INITIALLY IMMEDIATE").
323 Returns an array or array reference.
325 $constraint->options('NORELY');
326 my @options = $constraint->options;
331 my $options = parse_list_arg( @_ );
333 push @{ $self->{'options'} }, @$options;
335 if ( ref $self->{'options'} ) {
336 return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'};
339 return wantarray ? () : [];
349 Get or set the constraint's "on delete" action.
351 my $action = $constraint->on_delete('cascade');
357 if ( my $arg = shift ) {
359 $self->{'on_delete'} = $arg;
362 return $self->{'on_delete'} || '';
371 Get or set the constraint's "on update" action.
373 my $action = $constraint->on_update('no action');
379 if ( my $arg = shift ) {
381 $self->{'on_update'} = $arg;
384 return $self->{'on_update'} || '';
387 sub reference_fields {
391 =head2 reference_fields
393 Gets and set the fields in the referred table. Accepts a string, list or
394 arrayref; returns an array or array reference.
396 $constraint->reference_fields('id');
397 $constraint->reference_fields('id', 'name');
398 $constraint->reference_fields( 'id, name' );
399 $constraint->reference_fields( [ 'id', 'name' ] );
400 $constraint->reference_fields( qw[ id name ] );
402 my @reference_fields = $constraint->reference_fields;
407 my $fields = parse_list_arg( @_ );
410 $self->{'reference_fields'} = $fields;
413 # Nothing set so try and derive it from the other constraint data
414 unless ( ref $self->{'reference_fields'} ) {
415 my $table = $self->table or return $self->error('No table');
416 my $schema = $table->schema or return $self->error('No schema');
417 if ( my $ref_table_name = $self->reference_table ) {
418 my $ref_table = $schema->get_table( $ref_table_name ) or
419 return $self->error("Can't find table '$ref_table_name'");
421 if ( my $constraint = $ref_table->primary_key ) {
422 $self->{'reference_fields'} = [ $constraint->fields ];
426 'No reference fields defined and cannot find primary key in ',
427 "reference table '$ref_table_name'"
431 # No ref table so we are not that sort of constraint, hence no ref
432 # fields. So we let the return below return an empty list.
435 if ( ref $self->{'reference_fields'} ) {
437 ? @{ $self->{'reference_fields'} }
438 : $self->{'reference_fields'};
441 return wantarray ? () : [];
445 sub reference_table {
449 =head2 reference_table
451 Get or set the table referred to by the constraint.
453 my $reference_table = $constraint->reference_table('foo');
458 $self->{'reference_table'} = shift if @_;
459 return $self->{'reference_table'} || '';
468 Get or set the constraint's table object.
470 my $table = $field->table;
475 if ( my $arg = shift ) {
476 return $self->error('Not a table object') unless
477 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
478 $self->{'table'} = $arg;
481 return $self->{'table'};
490 Get or set the constraint's type.
492 my $type = $constraint->type( PRIMARY_KEY );
496 my ( $self, $type ) = @_;
501 return $self->error("Invalid constraint type: $type")
502 unless $VALID_CONSTRAINT_TYPE{ $type };
503 $self->{'type'} = $type;
506 return $self->{'type'} || '';
515 Determines if this constraint is the same as another
517 my $isIdentical = $constraint1->equals( $constraint2 );
523 my $case_insensitive = shift;
524 my $ignore_constraint_names = shift;
526 return 0 unless $self->SUPER::equals($other);
527 return 0 unless $self->type eq $other->type;
528 unless ($ignore_constraint_names) {
529 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
531 return 0 unless $self->deferrable eq $other->deferrable;
532 #return 0 unless $self->is_valid eq $other->is_valid;
533 return 0 unless $case_insensitive ? uc($self->table->name) eq uc($other->table->name)
534 : $self->table->name eq $other->table->name;
535 return 0 unless $self->expression eq $other->expression;
537 # Check fields, regardless of order
538 my %otherFields = (); # create a hash of the other fields
539 foreach my $otherField ($other->fields) {
540 $otherField = uc($otherField) if $case_insensitive;
541 $otherFields{$otherField} = 1;
543 foreach my $selfField ($self->fields) { # check for self fields in hash
544 $selfField = uc($selfField) if $case_insensitive;
545 return 0 unless $otherFields{$selfField};
546 delete $otherFields{$selfField};
548 # Check all other fields were accounted for
549 return 0 unless keys %otherFields == 0;
551 # Check reference fields, regardless of order
552 my %otherRefFields = (); # create a hash of the other reference fields
553 foreach my $otherRefField ($other->reference_fields) {
554 $otherRefField = uc($otherRefField) if $case_insensitive;
555 $otherRefFields{$otherRefField} = 1;
557 foreach my $selfRefField ($self->reference_fields) { # check for self reference fields in hash
558 $selfRefField = uc($selfRefField) if $case_insensitive;
559 return 0 unless $otherRefFields{$selfRefField};
560 delete $otherRefFields{$selfRefField};
562 # Check all other reference fields were accounted for
563 return 0 unless keys %otherRefFields == 0;
565 return 0 unless $case_insensitive ? uc($self->reference_table) eq uc($other->reference_table) : $self->reference_table eq $other->reference_table;
566 return 0 unless $self->match_type eq $other->match_type;
567 return 0 unless $self->on_delete eq $other->on_delete;
568 return 0 unless $self->on_update eq $other->on_update;
569 return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options);
570 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
576 undef $self->{'table'}; # destroy cyclical reference
585 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.