Commit | Line | Data |
3c5de62a |
1 | package SQL::Translator::Schema::Constraint; |
2 | |
3c5de62a |
3 | =pod |
4 | |
5 | =head1 NAME |
6 | |
7 | SQL::Translator::Schema::Constraint - SQL::Translator constraint object |
8 | |
9 | =head1 SYNOPSIS |
10 | |
11 | use SQL::Translator::Schema::Constraint; |
12 | my $constraint = SQL::Translator::Schema::Constraint->new( |
13 | name => 'foo', |
14 | fields => [ id ], |
43b9dc7a |
15 | type => PRIMARY_KEY, |
3c5de62a |
16 | ); |
17 | |
18 | =head1 DESCRIPTION |
19 | |
20 | C<SQL::Translator::Schema::Constraint> is the constraint object. |
21 | |
22 | =head1 METHODS |
23 | |
24 | =cut |
25 | |
26 | use strict; |
f27f9229 |
27 | use warnings; |
43b9dc7a |
28 | use SQL::Translator::Schema::Constants; |
752608d5 |
29 | use SQL::Translator::Utils 'parse_list_arg'; |
3c5de62a |
30 | |
b6a880d1 |
31 | use base 'SQL::Translator::Schema::Object'; |
32 | |
0c04c5a2 |
33 | our ( $TABLE_COUNT, $VIEW_COUNT ); |
da06ac74 |
34 | |
0c04c5a2 |
35 | our $VERSION = '1.59'; |
3c5de62a |
36 | |
695c2da2 |
37 | my %VALID_CONSTRAINT_TYPE = ( |
43b9dc7a |
38 | PRIMARY_KEY, 1, |
39 | UNIQUE, 1, |
40 | CHECK_C, 1, |
41 | FOREIGN_KEY, 1, |
695c2da2 |
42 | NOT_NULL, 1, |
43 | ); |
3c5de62a |
44 | |
9371be50 |
45 | __PACKAGE__->_attributes( qw/ |
ea93df61 |
46 | table name type fields reference_fields reference_table |
9371be50 |
47 | match_type on_delete on_update expression deferrable |
48 | /); |
49 | |
50 | # Override to remove empty arrays from args. |
51 | # t/14postgres-parser breaks without this. |
52 | sub init { |
ea93df61 |
53 | |
3c5de62a |
54 | =pod |
55 | |
56 | =head2 new |
57 | |
58 | Object constructor. |
59 | |
60 | my $schema = SQL::Translator::Schema::Constraint->new( |
dedb8f3b |
61 | table => $table, # table to which it belongs |
3c5de62a |
62 | type => 'foreign_key', # type of table constraint |
dedb8f3b |
63 | name => 'fk_phone_id', # name of the constraint |
64 | fields => 'phone_id', # field in the referring table |
65157eda |
65 | reference_fields => 'phone_id', # referenced field |
66 | reference_table => 'phone', # referenced table |
3c5de62a |
67 | match_type => 'full', # how to match |
2d034ab4 |
68 | on_delete => 'cascade', # what to do on deletes |
69 | on_update => '', # what to do on updates |
3c5de62a |
70 | ); |
71 | |
72 | =cut |
73 | |
9371be50 |
74 | my $self = shift; |
75 | foreach ( values %{$_[0]} ) { $_ = undef if ref($_) eq "ARRAY" && ! @$_; } |
76 | $self->SUPER::init(@_); |
3c5de62a |
77 | } |
78 | |
43b9dc7a |
79 | sub deferrable { |
80 | |
81 | =pod |
82 | |
83 | =head2 deferrable |
84 | |
2d034ab4 |
85 | Get or set whether the constraint is deferrable. If not defined, |
43b9dc7a |
86 | then returns "1." The argument is evaluated by Perl for True or |
87 | False, so the following are eqivalent: |
88 | |
89 | $deferrable = $field->deferrable(0); |
90 | $deferrable = $field->deferrable(''); |
91 | $deferrable = $field->deferrable('0'); |
92 | |
93 | =cut |
94 | |
95 | my ( $self, $arg ) = @_; |
96 | |
97 | if ( defined $arg ) { |
98 | $self->{'deferrable'} = $arg ? 1 : 0; |
99 | } |
100 | |
101 | return defined $self->{'deferrable'} ? $self->{'deferrable'} : 1; |
102 | } |
103 | |
43b9dc7a |
104 | sub expression { |
105 | |
106 | =pod |
107 | |
108 | =head2 expression |
109 | |
110 | Gets and set the expression used in a CHECK constraint. |
111 | |
112 | my $expression = $constraint->expression('...'); |
113 | |
114 | =cut |
115 | |
116 | my $self = shift; |
ea93df61 |
117 | |
43b9dc7a |
118 | if ( my $arg = shift ) { |
119 | # check arg here? |
120 | $self->{'expression'} = $arg; |
121 | } |
122 | |
123 | return $self->{'expression'} || ''; |
124 | } |
125 | |
43b9dc7a |
126 | sub is_valid { |
127 | |
128 | =pod |
129 | |
130 | =head2 is_valid |
131 | |
132 | Determine whether the constraint is valid or not. |
133 | |
134 | my $ok = $constraint->is_valid; |
135 | |
136 | =cut |
137 | |
138 | my $self = shift; |
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'); |
143 | |
144 | for my $f ( @fields ) { |
145 | next if $table->get_field( $f ); |
146 | return $self->error( |
147 | "Constraint references non-existent field '$f' ", |
148 | "in table '$table_name'" |
149 | ); |
150 | } |
151 | |
152 | my $schema = $table->schema or return $self->error( |
153 | 'Table ', $table->name, ' has no schema object' |
154 | ); |
155 | |
156 | if ( $type eq FOREIGN_KEY ) { |
157 | return $self->error('Only one field allowed for foreign key') |
158 | if scalar @fields > 1; |
159 | |
ea93df61 |
160 | my $ref_table_name = $self->reference_table or |
43b9dc7a |
161 | return $self->error('No reference table'); |
162 | |
163 | my $ref_table = $schema->get_table( $ref_table_name ) or |
164 | return $self->error("No table named '$ref_table_name' in schema"); |
165 | |
166 | my @ref_fields = $self->reference_fields or return; |
167 | |
168 | return $self->error('Only one field allowed for foreign key reference') |
169 | if scalar @ref_fields > 1; |
170 | |
171 | for my $ref_field ( @ref_fields ) { |
172 | next if $ref_table->get_field( $ref_field ); |
173 | return $self->error( |
ea93df61 |
174 | "Constraint from field(s) ", |
43b9dc7a |
175 | join(', ', map {qq['$table_name.$_']} @fields), |
176 | " to non-existent field '$ref_table_name.$ref_field'" |
177 | ); |
178 | } |
179 | } |
180 | elsif ( $type eq CHECK_C ) { |
ea93df61 |
181 | return $self->error('No expression for CHECK') unless |
43b9dc7a |
182 | $self->expression; |
183 | } |
184 | |
185 | return 1; |
186 | } |
187 | |
3c5de62a |
188 | sub fields { |
189 | |
190 | =pod |
191 | |
192 | =head2 fields |
193 | |
43b9dc7a |
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. |
197 | |
ac095e5e |
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>). |
201 | |
202 | Returns undef or an empty list if the constraint has no fields set. |
203 | |
43b9dc7a |
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 ] ); |
3c5de62a |
209 | |
43b9dc7a |
210 | my @fields = $constraint->fields; |
3c5de62a |
211 | |
212 | =cut |
213 | |
214 | my $self = shift; |
752608d5 |
215 | my $fields = parse_list_arg( @_ ); |
3c5de62a |
216 | |
217 | if ( @$fields ) { |
43b9dc7a |
218 | my ( %unique, @unique ); |
219 | for my $f ( @$fields ) { |
220 | next if $unique{ $f }; |
221 | $unique{ $f } = 1; |
222 | push @unique, $f; |
223 | } |
224 | |
225 | $self->{'fields'} = \@unique; |
3c5de62a |
226 | } |
227 | |
53ded04a |
228 | if ( @{ $self->{'fields'} || [] } ) { |
ac095e5e |
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. |
231 | my @ret = map { |
232 | $self->table->get_field($_) || $_ } @{ $self->{'fields'} }; |
233 | return wantarray ? @ret : \@ret; |
53ded04a |
234 | } |
235 | else { |
236 | return wantarray ? () : undef; |
237 | } |
3c5de62a |
238 | } |
239 | |
ac095e5e |
240 | sub field_names { |
241 | |
242 | =head2 field_names |
243 | |
244 | Read-only method to return a list or array ref of the field names. Returns undef |
10f70490 |
245 | or an empty list if the constraint has no fields set. Useful if you want to |
ac095e5e |
246 | avoid the overload magic of the Field objects returned by the fields method. |
247 | |
248 | my @names = $constraint->field_names; |
249 | |
250 | =cut |
251 | |
252 | my $self = shift; |
4598b71c |
253 | return wantarray ? @{ $self->{'fields'} || [] } : ($self->{'fields'} || ''); |
ac095e5e |
254 | } |
255 | |
752608d5 |
256 | sub match_type { |
257 | |
258 | =pod |
259 | |
260 | =head2 match_type |
261 | |
262 | Get or set the constraint's match_type. Only valid values are "full" |
840447a5 |
263 | "partial" and "simple" |
752608d5 |
264 | |
265 | my $match_type = $constraint->match_type('FULL'); |
266 | |
267 | =cut |
268 | |
c3b0b535 |
269 | my ( $self, $arg ) = @_; |
ea93df61 |
270 | |
c3b0b535 |
271 | if ( $arg ) { |
272 | $arg = lc $arg; |
752608d5 |
273 | return $self->error("Invalid match type: $arg") |
840447a5 |
274 | unless $arg eq 'full' || $arg eq 'partial' || $arg eq 'simple'; |
752608d5 |
275 | $self->{'match_type'} = $arg; |
276 | } |
277 | |
278 | return $self->{'match_type'} || ''; |
279 | } |
280 | |
3c5de62a |
281 | sub name { |
282 | |
283 | =pod |
284 | |
285 | =head2 name |
286 | |
287 | Get or set the constraint's name. |
288 | |
289 | my $name = $constraint->name('foo'); |
290 | |
291 | =cut |
292 | |
293 | my $self = shift; |
695c2da2 |
294 | my $arg = shift || ''; |
295 | $self->{'name'} = $arg if $arg; |
3c5de62a |
296 | return $self->{'name'} || ''; |
297 | } |
298 | |
dedb8f3b |
299 | sub options { |
300 | |
301 | =pod |
302 | |
303 | =head2 options |
304 | |
ea93df61 |
305 | Gets or adds to the constraints's options (e.g., "INITIALLY IMMEDIATE"). |
dedb8f3b |
306 | Returns an array or array reference. |
307 | |
308 | $constraint->options('NORELY'); |
309 | my @options = $constraint->options; |
310 | |
311 | =cut |
312 | |
313 | my $self = shift; |
314 | my $options = parse_list_arg( @_ ); |
315 | |
316 | push @{ $self->{'options'} }, @$options; |
317 | |
318 | if ( ref $self->{'options'} ) { |
319 | return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'}; |
320 | } |
321 | else { |
322 | return wantarray ? () : []; |
323 | } |
324 | } |
325 | |
43b9dc7a |
326 | sub on_delete { |
327 | |
328 | =pod |
329 | |
330 | =head2 on_delete |
331 | |
332 | Get or set the constraint's "on delete" action. |
333 | |
334 | my $action = $constraint->on_delete('cascade'); |
335 | |
336 | =cut |
337 | |
338 | my $self = shift; |
ea93df61 |
339 | |
43b9dc7a |
340 | if ( my $arg = shift ) { |
341 | # validate $arg? |
342 | $self->{'on_delete'} = $arg; |
343 | } |
344 | |
345 | return $self->{'on_delete'} || ''; |
346 | } |
347 | |
43b9dc7a |
348 | sub on_update { |
349 | |
350 | =pod |
351 | |
352 | =head2 on_update |
353 | |
354 | Get or set the constraint's "on update" action. |
355 | |
356 | my $action = $constraint->on_update('no action'); |
357 | |
358 | =cut |
359 | |
360 | my $self = shift; |
ea93df61 |
361 | |
43b9dc7a |
362 | if ( my $arg = shift ) { |
363 | # validate $arg? |
364 | $self->{'on_update'} = $arg; |
365 | } |
366 | |
367 | return $self->{'on_update'} || ''; |
368 | } |
369 | |
43b9dc7a |
370 | sub reference_fields { |
371 | |
372 | =pod |
373 | |
374 | =head2 reference_fields |
375 | |
376 | Gets and set the fields in the referred table. Accepts a string, list or |
377 | arrayref; returns an array or array reference. |
378 | |
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 ] ); |
384 | |
385 | my @reference_fields = $constraint->reference_fields; |
386 | |
387 | =cut |
388 | |
389 | my $self = shift; |
752608d5 |
390 | my $fields = parse_list_arg( @_ ); |
43b9dc7a |
391 | |
392 | if ( @$fields ) { |
393 | $self->{'reference_fields'} = $fields; |
394 | } |
395 | |
2d034ab4 |
396 | # Nothing set so try and derive it from the other constraint data |
43b9dc7a |
397 | unless ( ref $self->{'reference_fields'} ) { |
2d034ab4 |
398 | my $table = $self->table or return $self->error('No table'); |
399 | my $schema = $table->schema or return $self->error('No schema'); |
ea93df61 |
400 | if ( my $ref_table_name = $self->reference_table ) { |
2d034ab4 |
401 | my $ref_table = $schema->get_table( $ref_table_name ) or |
402 | return $self->error("Can't find table '$ref_table_name'"); |
403 | |
ea93df61 |
404 | if ( my $constraint = $ref_table->primary_key ) { |
2d034ab4 |
405 | $self->{'reference_fields'} = [ $constraint->fields ]; |
406 | } |
407 | else { |
408 | $self->error( |
409 | 'No reference fields defined and cannot find primary key in ', |
410 | "reference table '$ref_table_name'" |
411 | ); |
412 | } |
43b9dc7a |
413 | } |
2d034ab4 |
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. |
43b9dc7a |
416 | } |
417 | |
418 | if ( ref $self->{'reference_fields'} ) { |
ea93df61 |
419 | return wantarray |
420 | ? @{ $self->{'reference_fields'} } |
43b9dc7a |
421 | : $self->{'reference_fields'}; |
422 | } |
423 | else { |
424 | return wantarray ? () : []; |
425 | } |
426 | } |
427 | |
43b9dc7a |
428 | sub reference_table { |
429 | |
430 | =pod |
431 | |
432 | =head2 reference_table |
433 | |
434 | Get or set the table referred to by the constraint. |
435 | |
436 | my $reference_table = $constraint->reference_table('foo'); |
437 | |
438 | =cut |
439 | |
440 | my $self = shift; |
441 | $self->{'reference_table'} = shift if @_; |
442 | return $self->{'reference_table'} || ''; |
443 | } |
444 | |
43b9dc7a |
445 | sub table { |
3c5de62a |
446 | |
447 | =pod |
448 | |
43b9dc7a |
449 | =head2 table |
3c5de62a |
450 | |
2d034ab4 |
451 | Get or set the constraint's table object. |
3c5de62a |
452 | |
43b9dc7a |
453 | my $table = $field->table; |
3c5de62a |
454 | |
455 | =cut |
456 | |
457 | my $self = shift; |
43b9dc7a |
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; |
462 | } |
463 | |
464 | return $self->{'table'}; |
465 | } |
466 | |
dedb8f3b |
467 | sub type { |
43b9dc7a |
468 | |
469 | =pod |
470 | |
dedb8f3b |
471 | =head2 type |
43b9dc7a |
472 | |
dedb8f3b |
473 | Get or set the constraint's type. |
43b9dc7a |
474 | |
dedb8f3b |
475 | my $type = $constraint->type( PRIMARY_KEY ); |
43b9dc7a |
476 | |
477 | =cut |
478 | |
c3b0b535 |
479 | my ( $self, $type ) = @_; |
43b9dc7a |
480 | |
c3b0b535 |
481 | if ( $type ) { |
482 | $type = uc $type; |
dedb8f3b |
483 | $type =~ s/_/ /g; |
ea93df61 |
484 | return $self->error("Invalid constraint type: $type") |
695c2da2 |
485 | unless $VALID_CONSTRAINT_TYPE{ $type }; |
dedb8f3b |
486 | $self->{'type'} = $type; |
43b9dc7a |
487 | } |
3c5de62a |
488 | |
dedb8f3b |
489 | return $self->{'type'} || ''; |
490 | } |
abf315bb |
491 | |
abf315bb |
492 | sub equals { |
493 | |
494 | =pod |
495 | |
496 | =head2 equals |
497 | |
498 | Determines if this constraint is the same as another |
499 | |
500 | my $isIdentical = $constraint1->equals( $constraint2 ); |
501 | |
502 | =cut |
503 | |
504 | my $self = shift; |
505 | my $other = shift; |
506 | my $case_insensitive = shift; |
d990d84b |
507 | my $ignore_constraint_names = shift; |
ea93df61 |
508 | |
abf315bb |
509 | return 0 unless $self->SUPER::equals($other); |
b8d24485 |
510 | return 0 unless $self->type eq $other->type; |
d990d84b |
511 | unless ($ignore_constraint_names) { |
512 | return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name; |
513 | } |
abf315bb |
514 | return 0 unless $self->deferrable eq $other->deferrable; |
4598b71c |
515 | #return 0 unless $self->is_valid eq $other->is_valid; |
abf315bb |
516 | return 0 unless $case_insensitive ? uc($self->table->name) eq uc($other->table->name) |
ea93df61 |
517 | : $self->table->name eq $other->table->name; |
abf315bb |
518 | return 0 unless $self->expression eq $other->expression; |
ea93df61 |
519 | |
6a0f3000 |
520 | # Check fields, regardless of order |
ea93df61 |
521 | my %otherFields = (); # create a hash of the other fields |
6a0f3000 |
522 | foreach my $otherField ($other->fields) { |
ea93df61 |
523 | $otherField = uc($otherField) if $case_insensitive; |
524 | $otherFields{$otherField} = 1; |
6a0f3000 |
525 | } |
526 | foreach my $selfField ($self->fields) { # check for self fields in hash |
ea93df61 |
527 | $selfField = uc($selfField) if $case_insensitive; |
528 | return 0 unless $otherFields{$selfField}; |
529 | delete $otherFields{$selfField}; |
6a0f3000 |
530 | } |
531 | # Check all other fields were accounted for |
532 | return 0 unless keys %otherFields == 0; |
533 | |
534 | # Check reference fields, regardless of order |
ea93df61 |
535 | my %otherRefFields = (); # create a hash of the other reference fields |
6a0f3000 |
536 | foreach my $otherRefField ($other->reference_fields) { |
ea93df61 |
537 | $otherRefField = uc($otherRefField) if $case_insensitive; |
538 | $otherRefFields{$otherRefField} = 1; |
6a0f3000 |
539 | } |
540 | foreach my $selfRefField ($self->reference_fields) { # check for self reference fields in hash |
ea93df61 |
541 | $selfRefField = uc($selfRefField) if $case_insensitive; |
542 | return 0 unless $otherRefFields{$selfRefField}; |
543 | delete $otherRefFields{$selfRefField}; |
6a0f3000 |
544 | } |
545 | # Check all other reference fields were accounted for |
546 | return 0 unless keys %otherRefFields == 0; |
547 | |
b8d24485 |
548 | return 0 unless $case_insensitive ? uc($self->reference_table) eq uc($other->reference_table) : $self->reference_table eq $other->reference_table; |
abf315bb |
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; |
4598b71c |
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); |
abf315bb |
554 | return 1; |
555 | } |
556 | |
752608d5 |
557 | sub DESTROY { |
558 | my $self = shift; |
559 | undef $self->{'table'}; # destroy cyclical reference |
560 | } |
561 | |
3c5de62a |
562 | 1; |
563 | |
3c5de62a |
564 | =pod |
565 | |
566 | =head1 AUTHOR |
567 | |
c3b0b535 |
568 | Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>. |
3c5de62a |
569 | |
570 | =cut |