1 package SQL::Translator::Schema::Constraint;
3 # ----------------------------------------------------------------------
4 # $Id: Constraint.pm,v 1.7 2003-06-27 16:47:40 kycl4rk Exp $
5 # ----------------------------------------------------------------------
6 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>
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.
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.
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
21 # -------------------------------------------------------------------
27 SQL::Translator::Schema::Constraint - SQL::Translator constraint object
31 use SQL::Translator::Schema::Constraint;
32 my $constraint = SQL::Translator::Schema::Constraint->new(
40 C<SQL::Translator::Schema::Constraint> is the constraint object.
48 use SQL::Translator::Schema::Constants;
49 use SQL::Translator::Utils 'parse_list_arg';
51 use base 'Class::Base';
52 use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
54 $VERSION = sprintf "%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/;
56 my %VALID_CONSTRAINT_TYPE = (
64 # ----------------------------------------------------------------------
73 my $schema = SQL::Translator::Schema::Constraint->new(
74 table => $table, # table to which it belongs
75 type => 'foreign_key', # type of table constraint
76 name => 'fk_phone_id', # name of the constraint
77 fields => 'phone_id', # field in the referring table
78 reference_fields => 'phone_id', # referenced table
79 reference_table => 'phone', # referenced fields
80 match_type => 'full', # how to match
81 on_delete_do => 'cascade', # what to do on deletes
82 on_update_do => '', # what to do on updates
87 my ( $self, $config ) = @_;
89 table name type fields reference_fields reference_table
90 match_type on_delete on_update
93 for my $arg ( @fields ) {
94 next unless $config->{ $arg };
95 defined $self->$arg( $config->{ $arg } ) or return;
101 # ----------------------------------------------------------------------
108 Get or set the whether the constraint is deferrable. If not defined,
109 then returns "1." The argument is evaluated by Perl for True or
110 False, so the following are eqivalent:
112 $deferrable = $field->deferrable(0);
113 $deferrable = $field->deferrable('');
114 $deferrable = $field->deferrable('0');
118 my ( $self, $arg ) = @_;
120 if ( defined $arg ) {
121 $self->{'deferrable'} = $arg ? 1 : 0;
124 return defined $self->{'deferrable'} ? $self->{'deferrable'} : 1;
127 # ----------------------------------------------------------------------
134 Gets and set the expression used in a CHECK constraint.
136 my $expression = $constraint->expression('...');
142 if ( my $arg = shift ) {
144 $self->{'expression'} = $arg;
147 return $self->{'expression'} || '';
150 # ----------------------------------------------------------------------
157 Determine whether the constraint is valid or not.
159 my $ok = $constraint->is_valid;
164 my $type = $self->type or return $self->error('No type');
165 my $table = $self->table or return $self->error('No table');
166 my @fields = $self->fields or return $self->error('No fields');
167 my $table_name = $table->name or return $self->error('No table name');
169 for my $f ( @fields ) {
170 next if $table->get_field( $f );
172 "Constraint references non-existent field '$f' ",
173 "in table '$table_name'"
177 my $schema = $table->schema or return $self->error(
178 'Table ', $table->name, ' has no schema object'
181 if ( $type eq FOREIGN_KEY ) {
182 return $self->error('Only one field allowed for foreign key')
183 if scalar @fields > 1;
185 my $ref_table_name = $self->reference_table or
186 return $self->error('No reference table');
188 my $ref_table = $schema->get_table( $ref_table_name ) or
189 return $self->error("No table named '$ref_table_name' in schema");
191 my @ref_fields = $self->reference_fields or return;
193 return $self->error('Only one field allowed for foreign key reference')
194 if scalar @ref_fields > 1;
196 for my $ref_field ( @ref_fields ) {
197 next if $ref_table->get_field( $ref_field );
199 "Constraint from field(s) ",
200 join(', ', map {qq['$table_name.$_']} @fields),
201 " to non-existent field '$ref_table_name.$ref_field'"
205 elsif ( $type eq CHECK_C ) {
206 return $self->error('No expression for CHECK') unless
213 # ----------------------------------------------------------------------
220 Gets and set the fields the constraint is on. Accepts a string, list or
221 arrayref; returns an array or array reference. Will unique the field
222 names and keep them in order by the first occurrence of a field name.
224 $constraint->fields('id');
225 $constraint->fields('id', 'name');
226 $constraint->fields( 'id, name' );
227 $constraint->fields( [ 'id', 'name' ] );
228 $constraint->fields( qw[ id name ] );
230 my @fields = $constraint->fields;
235 my $fields = parse_list_arg( @_ );
238 my ( %unique, @unique );
239 for my $f ( @$fields ) {
240 next if $unique{ $f };
245 $self->{'fields'} = \@unique;
248 return wantarray ? @{ $self->{'fields'} || [] } : $self->{'fields'};
251 # ----------------------------------------------------------------------
258 Get or set the constraint's match_type. Only valid values are "full"
261 my $match_type = $constraint->match_type('FULL');
267 if ( my $arg = lc shift ) {
268 return $self->error("Invalid match type: $arg")
269 unless $arg eq 'full' || $arg eq 'partial';
270 $self->{'match_type'} = $arg;
273 return $self->{'match_type'} || '';
276 # ----------------------------------------------------------------------
283 Get or set the constraint's name.
285 my $name = $constraint->name('foo');
290 my $arg = shift || '';
291 $self->{'name'} = $arg if $arg;
292 return $self->{'name'} || '';
295 # ----------------------------------------------------------------------
302 Gets or adds to the constraints's options (e.g., "INITIALLY IMMEDIATE").
303 Returns an array or array reference.
305 $constraint->options('NORELY');
306 my @options = $constraint->options;
311 my $options = parse_list_arg( @_ );
313 push @{ $self->{'options'} }, @$options;
315 if ( ref $self->{'options'} ) {
316 return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'};
319 return wantarray ? () : [];
324 # ----------------------------------------------------------------------
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'} || '';
347 # ----------------------------------------------------------------------
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 # ----------------------------------------------------------------------
371 sub reference_fields {
375 =head2 reference_fields
377 Gets and set the fields in the referred table. Accepts a string, list or
378 arrayref; returns an array or array reference.
380 $constraint->reference_fields('id');
381 $constraint->reference_fields('id', 'name');
382 $constraint->reference_fields( 'id, name' );
383 $constraint->reference_fields( [ 'id', 'name' ] );
384 $constraint->reference_fields( qw[ id name ] );
386 my @reference_fields = $constraint->reference_fields;
391 my $fields = parse_list_arg( @_ );
394 $self->{'reference_fields'} = $fields;
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 my $ref_table_name = $self->reference_table or
401 return $self->error('No table');
402 my $ref_table = $schema->get_table( $ref_table_name ) or
403 return $self->error("Can't find table '$ref_table_name'");
405 if ( my $constraint = $ref_table->primary_key ) {
406 $self->{'reference_fields'} = [ $constraint->fields ];
410 'No reference fields defined and cannot find primary key in ',
411 "reference table '$ref_table_name'"
416 if ( ref $self->{'reference_fields'} ) {
418 ? @{ $self->{'reference_fields'} || [] }
419 : $self->{'reference_fields'};
422 return wantarray ? () : [];
426 # ----------------------------------------------------------------------
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'} || '';
444 # ----------------------------------------------------------------------
451 Get or set the field'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'};
467 # ----------------------------------------------------------------------
474 Get or set the constraint's type.
476 my $type = $constraint->type( PRIMARY_KEY );
482 if ( my $type = uc shift ) {
484 return $self->error("Invalid constraint type: $type")
485 unless $VALID_CONSTRAINT_TYPE{ $type };
486 $self->{'type'} = $type;
489 return $self->{'type'} || '';
491 # ----------------------------------------------------------------------
494 undef $self->{'table'}; # destroy cyclical reference
499 # ----------------------------------------------------------------------
505 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>