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 qw(ex2err throw);
29 use SQL::Translator::Role::ListAttr;
30 use SQL::Translator::Types qw(schema_obj);
32 extends 'SQL::Translator::Schema::Object';
34 our $VERSION = '1.59';
36 my %VALID_CONSTRAINT_TYPE = (
48 my $schema = SQL::Translator::Schema::Constraint->new(
49 table => $table, # table to which it belongs
50 type => 'foreign_key', # type of table constraint
51 name => 'fk_phone_id', # name of the constraint
52 fields => 'phone_id', # field in the referring table
53 reference_fields => 'phone_id', # referenced field
54 reference_table => 'phone', # referenced table
55 match_type => 'full', # how to match
56 on_delete => 'cascade', # what to do on deletes
57 on_update => '', # what to do on updates
62 # Override to remove empty arrays from args.
63 # t/14postgres-parser breaks without this.
64 around BUILDARGS => sub {
67 my $args = $self->$orig(@_);
69 foreach my $arg (keys %{$args}) {
70 delete $args->{$arg} if ref($args->{$arg}) eq "ARRAY" && !@{$args->{$arg}};
72 if (exists $args->{fields}) {
73 $args->{field_names} = delete $args->{fields};
80 Get or set whether the constraint is deferrable. If not defined,
81 then returns "1." The argument is evaluated by Perl for True or
82 False, so the following are eqivalent:
84 $deferrable = $field->deferrable(0);
85 $deferrable = $field->deferrable('');
86 $deferrable = $field->deferrable('0');
90 has deferrable => ( is => 'rw', coerce => sub { $_[0] ? 1 : 0 }, default => sub { 1 } );
94 Gets and set the expression used in a CHECK constraint.
96 my $expression = $constraint->expression('...');
100 has expression => ( is => 'rw', default => sub { '' } );
102 around expression => sub {
103 my ($orig, $self, $arg) = @_;
104 $self->$orig($arg || ());
113 Determine whether the constraint is valid or not.
115 my $ok = $constraint->is_valid;
120 my $type = $self->type or return $self->error('No type');
121 my $table = $self->table or return $self->error('No table');
122 my @fields = $self->fields or return $self->error('No fields');
123 my $table_name = $table->name or return $self->error('No table name');
125 for my $f ( @fields ) {
126 next if $table->get_field( $f );
128 "Constraint references non-existent field '$f' ",
129 "in table '$table_name'"
133 my $schema = $table->schema or return $self->error(
134 'Table ', $table->name, ' has no schema object'
137 if ( $type eq FOREIGN_KEY ) {
138 return $self->error('Only one field allowed for foreign key')
139 if scalar @fields > 1;
141 my $ref_table_name = $self->reference_table or
142 return $self->error('No reference table');
144 my $ref_table = $schema->get_table( $ref_table_name ) or
145 return $self->error("No table named '$ref_table_name' in schema");
147 my @ref_fields = $self->reference_fields or return;
149 return $self->error('Only one field allowed for foreign key reference')
150 if scalar @ref_fields > 1;
152 for my $ref_field ( @ref_fields ) {
153 next if $ref_table->get_field( $ref_field );
155 "Constraint from field(s) ".
156 join(', ', map {qq['$table_name.$_']} @fields).
157 " to non-existent field '$ref_table_name.$ref_field'"
161 elsif ( $type eq CHECK_C ) {
162 return $self->error('No expression for CHECK') unless
171 Gets and set the fields the constraint is on. Accepts a string, list or
172 arrayref; returns an array or array reference. Will unique the field
173 names and keep them in order by the first occurrence of a field name.
175 The fields are returned as Field objects if they exist or as plain
176 names if not. (If you just want the names and want to avoid the Field's overload
177 magic use L<field_names>).
179 Returns undef or an empty list if the constraint has no fields set.
181 $constraint->fields('id');
182 $constraint->fields('id', 'name');
183 $constraint->fields( 'id, name' );
184 $constraint->fields( [ 'id', 'name' ] );
185 $constraint->fields( qw[ id name ] );
187 my @fields = $constraint->fields;
193 my $table = $self->table;
194 my @tables = map { $table->get_field($_) || $_ } @{$self->field_names(@_) || []};
195 return wantarray ? @tables
202 Read-only method to return a list or array ref of the field names. Returns undef
203 or an empty list if the constraint has no fields set. Useful if you want to
204 avoid the overload magic of the Field objects returned by the fields method.
206 my @names = $constraint->field_names;
210 with ListAttr field_names => ( uniq => 1, undef_if_empty => 1 );
214 Get or set the constraint's match_type. Only valid values are "full"
215 "partial" and "simple"
217 my $match_type = $constraint->match_type('FULL');
223 default => sub { '' },
224 coerce => sub { lc $_[0] },
227 throw("Invalid match type: $arg")
228 if $arg && !($arg eq 'full' || $arg eq 'partial' || $arg eq 'simple');
232 around match_type => \&ex2err;
236 Get or set the constraint's name.
238 my $name = $constraint->name('foo');
242 has name => ( is => 'rw', default => sub { '' } );
245 my ($orig, $self, $arg) = @_;
246 $self->$orig($arg || ());
251 Gets or adds to the constraints's options (e.g., "INITIALLY IMMEDIATE").
252 Returns an array or array reference.
254 $constraint->options('NORELY');
255 my @options = $constraint->options;
259 with ListAttr options => ();
263 Get or set the constraint's "on delete" action.
265 my $action = $constraint->on_delete('cascade');
269 has on_delete => ( is => 'rw', default => sub { '' } );
271 around on_delete => sub {
272 my ($orig, $self, $arg) = @_;
273 $self->$orig($arg || ());
278 Get or set the constraint's "on update" action.
280 my $action = $constraint->on_update('no action');
284 has on_update => ( is => 'rw', default => sub { '' } );
286 around on_update => sub {
287 my ($orig, $self, $arg) = @_;
288 $self->$orig($arg || ());
291 =head2 reference_fields
293 Gets and set the fields in the referred table. Accepts a string, list or
294 arrayref; returns an array or array reference.
296 $constraint->reference_fields('id');
297 $constraint->reference_fields('id', 'name');
298 $constraint->reference_fields( 'id, name' );
299 $constraint->reference_fields( [ 'id', 'name' ] );
300 $constraint->reference_fields( qw[ id name ] );
302 my @reference_fields = $constraint->reference_fields;
306 with ListAttr reference_fields => (
312 sub _build_reference_fields {
315 my $table = $self->table or throw('No table');
316 my $schema = $table->schema or throw('No schema');
317 if ( my $ref_table_name = $self->reference_table ) {
318 my $ref_table = $schema->get_table( $ref_table_name ) or
319 throw("Can't find table '$ref_table_name'");
321 if ( my $constraint = $ref_table->primary_key ) {
322 return [ $constraint->fields ];
326 'No reference fields defined and cannot find primary key in ',
327 "reference table '$ref_table_name'"
333 =head2 reference_table
335 Get or set the table referred to by the constraint.
337 my $reference_table = $constraint->reference_table('foo');
341 has reference_table => ( is => 'rw', default => sub { '' } );
345 Get or set the constraint's table object.
347 my $table = $field->table;
351 has table => ( is => 'rw', isa => schema_obj('Table'), weak_ref => 1 );
353 around table => \&ex2err;
357 Get or set the constraint's type.
359 my $type = $constraint->type( PRIMARY_KEY );
365 default => sub { '' },
367 throw("Invalid constraint type: $_[0]")
368 if $_[0] && !$VALID_CONSTRAINT_TYPE{ $_[0] };
370 coerce => sub { (my $t = $_[0]) =~ s/_/ /g; uc $t },
373 around type => \&ex2err;
377 Determines if this constraint is the same as another
379 my $isIdentical = $constraint1->equals( $constraint2 );
383 around equals => sub {
387 my $case_insensitive = shift;
388 my $ignore_constraint_names = shift;
390 return 0 unless $self->$orig($other);
391 return 0 unless $self->type eq $other->type;
392 unless ($ignore_constraint_names) {
393 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
395 return 0 unless $self->deferrable eq $other->deferrable;
396 #return 0 unless $self->is_valid eq $other->is_valid;
397 return 0 unless $case_insensitive ? uc($self->table->name) eq uc($other->table->name)
398 : $self->table->name eq $other->table->name;
399 return 0 unless $self->expression eq $other->expression;
401 # Check fields, regardless of order
402 my %otherFields = (); # create a hash of the other fields
403 foreach my $otherField ($other->fields) {
404 $otherField = uc($otherField) if $case_insensitive;
405 $otherFields{$otherField} = 1;
407 foreach my $selfField ($self->fields) { # check for self fields in hash
408 $selfField = uc($selfField) if $case_insensitive;
409 return 0 unless $otherFields{$selfField};
410 delete $otherFields{$selfField};
412 # Check all other fields were accounted for
413 return 0 unless keys %otherFields == 0;
415 # Check reference fields, regardless of order
416 my %otherRefFields = (); # create a hash of the other reference fields
417 foreach my $otherRefField ($other->reference_fields) {
418 $otherRefField = uc($otherRefField) if $case_insensitive;
419 $otherRefFields{$otherRefField} = 1;
421 foreach my $selfRefField ($self->reference_fields) { # check for self reference fields in hash
422 $selfRefField = uc($selfRefField) if $case_insensitive;
423 return 0 unless $otherRefFields{$selfRefField};
424 delete $otherRefFields{$selfRefField};
426 # Check all other reference fields were accounted for
427 return 0 unless keys %otherRefFields == 0;
429 return 0 unless $case_insensitive ? uc($self->reference_table) eq uc($other->reference_table) : $self->reference_table eq $other->reference_table;
430 return 0 unless $self->match_type eq $other->match_type;
431 return 0 unless $self->on_delete eq $other->on_delete;
432 return 0 unless $self->on_update eq $other->on_update;
433 return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options);
434 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
438 # Must come after all 'has' declarations
439 around new => \&ex2err;
447 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.