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