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.
27 use SQL::Translator::Schema::Constants;
28 use SQL::Translator::Utils 'parse_list_arg';
30 use base 'SQL::Translator::Schema::Object';
32 use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
36 my %VALID_CONSTRAINT_TYPE = (
44 __PACKAGE__->_attributes( qw/
45 table name type fields reference_fields reference_table
46 match_type on_delete on_update expression deferrable
49 # Override to remove empty arrays from args.
50 # t/14postgres-parser breaks without this.
59 my $schema = SQL::Translator::Schema::Constraint->new(
60 table => $table, # table to which it belongs
61 type => 'foreign_key', # type of table constraint
62 name => 'fk_phone_id', # name of the constraint
63 fields => 'phone_id', # field in the referring table
64 reference_fields => 'phone_id', # referenced field
65 reference_table => 'phone', # referenced table
66 match_type => 'full', # how to match
67 on_delete => 'cascade', # what to do on deletes
68 on_update => '', # what to do on updates
74 foreach ( values %{$_[0]} ) { $_ = undef if ref($_) eq "ARRAY" && ! @$_; }
75 $self->SUPER::init(@_);
84 Get or set whether the constraint is deferrable. If not defined,
85 then returns "1." The argument is evaluated by Perl for True or
86 False, so the following are eqivalent:
88 $deferrable = $field->deferrable(0);
89 $deferrable = $field->deferrable('');
90 $deferrable = $field->deferrable('0');
94 my ( $self, $arg ) = @_;
97 $self->{'deferrable'} = $arg ? 1 : 0;
100 return defined $self->{'deferrable'} ? $self->{'deferrable'} : 1;
109 Gets and set the expression used in a CHECK constraint.
111 my $expression = $constraint->expression('...');
117 if ( my $arg = shift ) {
119 $self->{'expression'} = $arg;
122 return $self->{'expression'} || '';
131 Determine whether the constraint is valid or not.
133 my $ok = $constraint->is_valid;
138 my $type = $self->type or return $self->error('No type');
139 my $table = $self->table or return $self->error('No table');
140 my @fields = $self->fields or return $self->error('No fields');
141 my $table_name = $table->name or return $self->error('No table name');
143 for my $f ( @fields ) {
144 next if $table->get_field( $f );
146 "Constraint references non-existent field '$f' ",
147 "in table '$table_name'"
151 my $schema = $table->schema or return $self->error(
152 'Table ', $table->name, ' has no schema object'
155 if ( $type eq FOREIGN_KEY ) {
156 return $self->error('Only one field allowed for foreign key')
157 if scalar @fields > 1;
159 my $ref_table_name = $self->reference_table or
160 return $self->error('No reference table');
162 my $ref_table = $schema->get_table( $ref_table_name ) or
163 return $self->error("No table named '$ref_table_name' in schema");
165 my @ref_fields = $self->reference_fields or return;
167 return $self->error('Only one field allowed for foreign key reference')
168 if scalar @ref_fields > 1;
170 for my $ref_field ( @ref_fields ) {
171 next if $ref_table->get_field( $ref_field );
173 "Constraint from field(s) ",
174 join(', ', map {qq['$table_name.$_']} @fields),
175 " to non-existent field '$ref_table_name.$ref_field'"
179 elsif ( $type eq CHECK_C ) {
180 return $self->error('No expression for CHECK') unless
193 Gets and set the fields the constraint is on. Accepts a string, list or
194 arrayref; returns an array or array reference. Will unique the field
195 names and keep them in order by the first occurrence of a field name.
197 The fields are returned as Field objects if they exist or as plain
198 names if not. (If you just want the names and want to avoid the Field's overload
199 magic use L<field_names>).
201 Returns undef or an empty list if the constraint has no fields set.
203 $constraint->fields('id');
204 $constraint->fields('id', 'name');
205 $constraint->fields( 'id, name' );
206 $constraint->fields( [ 'id', 'name' ] );
207 $constraint->fields( qw[ id name ] );
209 my @fields = $constraint->fields;
214 my $fields = parse_list_arg( @_ );
217 my ( %unique, @unique );
218 for my $f ( @$fields ) {
219 next if $unique{ $f };
224 $self->{'fields'} = \@unique;
227 if ( @{ $self->{'fields'} || [] } ) {
228 # We have to return fields that don't exist on the table as names in
229 # case those fields havn't been created yet.
231 $self->table->get_field($_) || $_ } @{ $self->{'fields'} };
232 return wantarray ? @ret : \@ret;
235 return wantarray ? () : undef;
243 Read-only method to return a list or array ref of the field names. Returns undef
244 or an empty list if the constraint has no fields set. Useful if you want to
245 avoid the overload magic of the Field objects returned by the fields method.
247 my @names = $constraint->field_names;
252 return wantarray ? @{ $self->{'fields'} || [] } : ($self->{'fields'} || '');
261 Get or set the constraint's match_type. Only valid values are "full"
262 "partial" and "simple"
264 my $match_type = $constraint->match_type('FULL');
268 my ( $self, $arg ) = @_;
272 return $self->error("Invalid match type: $arg")
273 unless $arg eq 'full' || $arg eq 'partial' || $arg eq 'simple';
274 $self->{'match_type'} = $arg;
277 return $self->{'match_type'} || '';
286 Get or set the constraint's name.
288 my $name = $constraint->name('foo');
293 my $arg = shift || '';
294 $self->{'name'} = $arg if $arg;
295 return $self->{'name'} || '';
304 Gets or adds to the constraints's options (e.g., "INITIALLY IMMEDIATE").
305 Returns an array or array reference.
307 $constraint->options('NORELY');
308 my @options = $constraint->options;
313 my $options = parse_list_arg( @_ );
315 push @{ $self->{'options'} }, @$options;
317 if ( ref $self->{'options'} ) {
318 return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'};
321 return wantarray ? () : [];
331 Get or set the constraint's "on delete" action.
333 my $action = $constraint->on_delete('cascade');
339 if ( my $arg = shift ) {
341 $self->{'on_delete'} = $arg;
344 return $self->{'on_delete'} || '';
353 Get or set the constraint's "on update" action.
355 my $action = $constraint->on_update('no action');
361 if ( my $arg = shift ) {
363 $self->{'on_update'} = $arg;
366 return $self->{'on_update'} || '';
369 sub reference_fields {
373 =head2 reference_fields
375 Gets and set the fields in the referred table. Accepts a string, list or
376 arrayref; returns an array or array reference.
378 $constraint->reference_fields('id');
379 $constraint->reference_fields('id', 'name');
380 $constraint->reference_fields( 'id, name' );
381 $constraint->reference_fields( [ 'id', 'name' ] );
382 $constraint->reference_fields( qw[ id name ] );
384 my @reference_fields = $constraint->reference_fields;
389 my $fields = parse_list_arg( @_ );
392 $self->{'reference_fields'} = $fields;
395 # Nothing set so try and derive it from the other constraint data
396 unless ( ref $self->{'reference_fields'} ) {
397 my $table = $self->table or return $self->error('No table');
398 my $schema = $table->schema or return $self->error('No schema');
399 if ( my $ref_table_name = $self->reference_table ) {
400 my $ref_table = $schema->get_table( $ref_table_name ) or
401 return $self->error("Can't find table '$ref_table_name'");
403 if ( my $constraint = $ref_table->primary_key ) {
404 $self->{'reference_fields'} = [ $constraint->fields ];
408 'No reference fields defined and cannot find primary key in ',
409 "reference table '$ref_table_name'"
413 # No ref table so we are not that sort of constraint, hence no ref
414 # fields. So we let the return below return an empty list.
417 if ( ref $self->{'reference_fields'} ) {
419 ? @{ $self->{'reference_fields'} }
420 : $self->{'reference_fields'};
423 return wantarray ? () : [];
427 sub reference_table {
431 =head2 reference_table
433 Get or set the table referred to by the constraint.
435 my $reference_table = $constraint->reference_table('foo');
440 $self->{'reference_table'} = shift if @_;
441 return $self->{'reference_table'} || '';
450 Get or set the constraint's table object.
452 my $table = $field->table;
457 if ( my $arg = shift ) {
458 return $self->error('Not a table object') unless
459 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
460 $self->{'table'} = $arg;
463 return $self->{'table'};
472 Get or set the constraint's type.
474 my $type = $constraint->type( PRIMARY_KEY );
478 my ( $self, $type ) = @_;
483 return $self->error("Invalid constraint type: $type")
484 unless $VALID_CONSTRAINT_TYPE{ $type };
485 $self->{'type'} = $type;
488 return $self->{'type'} || '';
497 Determines if this constraint is the same as another
499 my $isIdentical = $constraint1->equals( $constraint2 );
505 my $case_insensitive = shift;
506 my $ignore_constraint_names = shift;
508 return 0 unless $self->SUPER::equals($other);
509 return 0 unless $self->type eq $other->type;
510 unless ($ignore_constraint_names) {
511 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
513 return 0 unless $self->deferrable eq $other->deferrable;
514 #return 0 unless $self->is_valid eq $other->is_valid;
515 return 0 unless $case_insensitive ? uc($self->table->name) eq uc($other->table->name)
516 : $self->table->name eq $other->table->name;
517 return 0 unless $self->expression eq $other->expression;
519 # Check fields, regardless of order
520 my %otherFields = (); # create a hash of the other fields
521 foreach my $otherField ($other->fields) {
522 $otherField = uc($otherField) if $case_insensitive;
523 $otherFields{$otherField} = 1;
525 foreach my $selfField ($self->fields) { # check for self fields in hash
526 $selfField = uc($selfField) if $case_insensitive;
527 return 0 unless $otherFields{$selfField};
528 delete $otherFields{$selfField};
530 # Check all other fields were accounted for
531 return 0 unless keys %otherFields == 0;
533 # Check reference fields, regardless of order
534 my %otherRefFields = (); # create a hash of the other reference fields
535 foreach my $otherRefField ($other->reference_fields) {
536 $otherRefField = uc($otherRefField) if $case_insensitive;
537 $otherRefFields{$otherRefField} = 1;
539 foreach my $selfRefField ($self->reference_fields) { # check for self reference fields in hash
540 $selfRefField = uc($selfRefField) if $case_insensitive;
541 return 0 unless $otherRefFields{$selfRefField};
542 delete $otherRefFields{$selfRefField};
544 # Check all other reference fields were accounted for
545 return 0 unless keys %otherRefFields == 0;
547 return 0 unless $case_insensitive ? uc($self->reference_table) eq uc($other->reference_table) : $self->reference_table eq $other->reference_table;
548 return 0 unless $self->match_type eq $other->match_type;
549 return 0 unless $self->on_delete eq $other->on_delete;
550 return 0 unless $self->on_update eq $other->on_update;
551 return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options);
552 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
558 undef $self->{'table'}; # destroy cyclical reference
567 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.