1 package SQL::Translator::Schema::Constraint;
7 SQL::Translator::Schema::Constraint - SQL::Translator constraint object
11 use SQL::Translator::Schema::Constraint;
12 my $constraint = SQL::Translator::Schema::Constraint->new(
20 C<SQL::Translator::Schema::Constraint> is the constraint object.
28 use SQL::Translator::Schema::Constants;
29 use SQL::Translator::Utils 'parse_list_arg';
31 use base 'SQL::Translator::Schema::Object';
33 our ( $TABLE_COUNT, $VIEW_COUNT );
35 our $VERSION = '1.59';
37 my %VALID_CONSTRAINT_TYPE = (
45 __PACKAGE__->_attributes( qw/
46 table name type fields reference_fields reference_table
47 match_type on_delete on_update expression deferrable
50 # Override to remove empty arrays from args.
51 # t/14postgres-parser breaks without this.
60 my $schema = SQL::Translator::Schema::Constraint->new(
61 table => $table, # table to which it belongs
62 type => 'foreign_key', # type of table constraint
63 name => 'fk_phone_id', # name of the constraint
64 fields => 'phone_id', # field in the referring table
65 reference_fields => 'phone_id', # referenced field
66 reference_table => 'phone', # referenced table
67 match_type => 'full', # how to match
68 on_delete => 'cascade', # what to do on deletes
69 on_update => '', # what to do on updates
75 foreach ( values %{$_[0]} ) { $_ = undef if ref($_) eq "ARRAY" && ! @$_; }
76 $self->SUPER::init(@_);
85 Get or set whether the constraint is deferrable. If not defined,
86 then returns "1." The argument is evaluated by Perl for True or
87 False, so the following are eqivalent:
89 $deferrable = $field->deferrable(0);
90 $deferrable = $field->deferrable('');
91 $deferrable = $field->deferrable('0');
95 my ( $self, $arg ) = @_;
98 $self->{'deferrable'} = $arg ? 1 : 0;
101 return defined $self->{'deferrable'} ? $self->{'deferrable'} : 1;
110 Gets and set the expression used in a CHECK constraint.
112 my $expression = $constraint->expression('...');
118 if ( my $arg = shift ) {
120 $self->{'expression'} = $arg;
123 return $self->{'expression'} || '';
132 Determine whether the constraint is valid or not.
134 my $ok = $constraint->is_valid;
139 my $type = $self->type or return $self->error('No type');
140 my $table = $self->table or return $self->error('No table');
141 my @fields = $self->fields or return $self->error('No fields');
142 my $table_name = $table->name or return $self->error('No table name');
144 for my $f ( @fields ) {
145 next if $table->get_field( $f );
147 "Constraint references non-existent field '$f' ",
148 "in table '$table_name'"
152 my $schema = $table->schema or return $self->error(
153 'Table ', $table->name, ' has no schema object'
156 if ( $type eq FOREIGN_KEY ) {
157 return $self->error('Only one field allowed for foreign key')
158 if scalar @fields > 1;
160 my $ref_table_name = $self->reference_table or
161 return $self->error('No reference table');
163 my $ref_table = $schema->get_table( $ref_table_name ) or
164 return $self->error("No table named '$ref_table_name' in schema");
166 my @ref_fields = $self->reference_fields or return;
168 return $self->error('Only one field allowed for foreign key reference')
169 if scalar @ref_fields > 1;
171 for my $ref_field ( @ref_fields ) {
172 next if $ref_table->get_field( $ref_field );
174 "Constraint from field(s) ",
175 join(', ', map {qq['$table_name.$_']} @fields),
176 " to non-existent field '$ref_table_name.$ref_field'"
180 elsif ( $type eq CHECK_C ) {
181 return $self->error('No expression for CHECK') unless
194 Gets and set the fields the constraint is on. Accepts a string, list or
195 arrayref; returns an array or array reference. Will unique the field
196 names and keep them in order by the first occurrence of a field name.
198 The fields are returned as Field objects if they exist or as plain
199 names if not. (If you just want the names and want to avoid the Field's overload
200 magic use L<field_names>).
202 Returns undef or an empty list if the constraint has no fields set.
204 $constraint->fields('id');
205 $constraint->fields('id', 'name');
206 $constraint->fields( 'id, name' );
207 $constraint->fields( [ 'id', 'name' ] );
208 $constraint->fields( qw[ id name ] );
210 my @fields = $constraint->fields;
215 my $fields = parse_list_arg( @_ );
218 my ( %unique, @unique );
219 for my $f ( @$fields ) {
220 next if $unique{ $f };
225 $self->{'fields'} = \@unique;
228 if ( @{ $self->{'fields'} || [] } ) {
229 # We have to return fields that don't exist on the table as names in
230 # case those fields havn't been created yet.
232 $self->table->get_field($_) || $_ } @{ $self->{'fields'} };
233 return wantarray ? @ret : \@ret;
236 return wantarray ? () : undef;
244 Read-only method to return a list or array ref of the field names. Returns undef
245 or an empty list if the constraint has no fields set. Useful if you want to
246 avoid the overload magic of the Field objects returned by the fields method.
248 my @names = $constraint->field_names;
253 return wantarray ? @{ $self->{'fields'} || [] } : ($self->{'fields'} || '');
262 Get or set the constraint's match_type. Only valid values are "full"
263 "partial" and "simple"
265 my $match_type = $constraint->match_type('FULL');
269 my ( $self, $arg ) = @_;
273 return $self->error("Invalid match type: $arg")
274 unless $arg eq 'full' || $arg eq 'partial' || $arg eq 'simple';
275 $self->{'match_type'} = $arg;
278 return $self->{'match_type'} || '';
287 Get or set the constraint's name.
289 my $name = $constraint->name('foo');
294 my $arg = shift || '';
295 $self->{'name'} = $arg if $arg;
296 return $self->{'name'} || '';
305 Gets or adds to the constraints's options (e.g., "INITIALLY IMMEDIATE").
306 Returns an array or array reference.
308 $constraint->options('NORELY');
309 my @options = $constraint->options;
314 my $options = parse_list_arg( @_ );
316 push @{ $self->{'options'} }, @$options;
318 if ( ref $self->{'options'} ) {
319 return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'};
322 return wantarray ? () : [];
332 Get or set the constraint's "on delete" action.
334 my $action = $constraint->on_delete('cascade');
340 if ( my $arg = shift ) {
342 $self->{'on_delete'} = $arg;
345 return $self->{'on_delete'} || '';
354 Get or set the constraint's "on update" action.
356 my $action = $constraint->on_update('no action');
362 if ( my $arg = shift ) {
364 $self->{'on_update'} = $arg;
367 return $self->{'on_update'} || '';
370 sub reference_fields {
374 =head2 reference_fields
376 Gets and set the fields in the referred table. Accepts a string, list or
377 arrayref; returns an array or array reference.
379 $constraint->reference_fields('id');
380 $constraint->reference_fields('id', 'name');
381 $constraint->reference_fields( 'id, name' );
382 $constraint->reference_fields( [ 'id', 'name' ] );
383 $constraint->reference_fields( qw[ id name ] );
385 my @reference_fields = $constraint->reference_fields;
390 my $fields = parse_list_arg( @_ );
393 $self->{'reference_fields'} = $fields;
396 # Nothing set so try and derive it from the other constraint data
397 unless ( ref $self->{'reference_fields'} ) {
398 my $table = $self->table or return $self->error('No table');
399 my $schema = $table->schema or return $self->error('No schema');
400 if ( my $ref_table_name = $self->reference_table ) {
401 my $ref_table = $schema->get_table( $ref_table_name ) or
402 return $self->error("Can't find table '$ref_table_name'");
404 if ( my $constraint = $ref_table->primary_key ) {
405 $self->{'reference_fields'} = [ $constraint->fields ];
409 'No reference fields defined and cannot find primary key in ',
410 "reference table '$ref_table_name'"
414 # No ref table so we are not that sort of constraint, hence no ref
415 # fields. So we let the return below return an empty list.
418 if ( ref $self->{'reference_fields'} ) {
420 ? @{ $self->{'reference_fields'} }
421 : $self->{'reference_fields'};
424 return wantarray ? () : [];
428 sub reference_table {
432 =head2 reference_table
434 Get or set the table referred to by the constraint.
436 my $reference_table = $constraint->reference_table('foo');
441 $self->{'reference_table'} = shift if @_;
442 return $self->{'reference_table'} || '';
451 Get or set the constraint's table object.
453 my $table = $field->table;
458 if ( my $arg = shift ) {
459 return $self->error('Not a table object') unless
460 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
461 $self->{'table'} = $arg;
464 return $self->{'table'};
473 Get or set the constraint's type.
475 my $type = $constraint->type( PRIMARY_KEY );
479 my ( $self, $type ) = @_;
484 return $self->error("Invalid constraint type: $type")
485 unless $VALID_CONSTRAINT_TYPE{ $type };
486 $self->{'type'} = $type;
489 return $self->{'type'} || '';
498 Determines if this constraint is the same as another
500 my $isIdentical = $constraint1->equals( $constraint2 );
506 my $case_insensitive = shift;
507 my $ignore_constraint_names = shift;
509 return 0 unless $self->SUPER::equals($other);
510 return 0 unless $self->type eq $other->type;
511 unless ($ignore_constraint_names) {
512 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
514 return 0 unless $self->deferrable eq $other->deferrable;
515 #return 0 unless $self->is_valid eq $other->is_valid;
516 return 0 unless $case_insensitive ? uc($self->table->name) eq uc($other->table->name)
517 : $self->table->name eq $other->table->name;
518 return 0 unless $self->expression eq $other->expression;
520 # Check fields, regardless of order
521 my %otherFields = (); # create a hash of the other fields
522 foreach my $otherField ($other->fields) {
523 $otherField = uc($otherField) if $case_insensitive;
524 $otherFields{$otherField} = 1;
526 foreach my $selfField ($self->fields) { # check for self fields in hash
527 $selfField = uc($selfField) if $case_insensitive;
528 return 0 unless $otherFields{$selfField};
529 delete $otherFields{$selfField};
531 # Check all other fields were accounted for
532 return 0 unless keys %otherFields == 0;
534 # Check reference fields, regardless of order
535 my %otherRefFields = (); # create a hash of the other reference fields
536 foreach my $otherRefField ($other->reference_fields) {
537 $otherRefField = uc($otherRefField) if $case_insensitive;
538 $otherRefFields{$otherRefField} = 1;
540 foreach my $selfRefField ($self->reference_fields) { # check for self reference fields in hash
541 $selfRefField = uc($selfRefField) if $case_insensitive;
542 return 0 unless $otherRefFields{$selfRefField};
543 delete $otherRefFields{$selfRefField};
545 # Check all other reference fields were accounted for
546 return 0 unless keys %otherRefFields == 0;
548 return 0 unless $case_insensitive ? uc($self->reference_table) eq uc($other->reference_table) : $self->reference_table eq $other->reference_table;
549 return 0 unless $self->match_type eq $other->match_type;
550 return 0 unless $self->on_delete eq $other->on_delete;
551 return 0 unless $self->on_update eq $other->on_update;
552 return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options);
553 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
559 undef $self->{'table'}; # destroy cyclical reference
568 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.