1 package SQL::Translator::Schema::Constraint;
3 # ----------------------------------------------------------------------
4 # $Id: Constraint.pm,v 1.4 2003-06-06 00:08:14 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);
56 use constant VALID_TYPE => {
63 # ----------------------------------------------------------------------
72 my $schema = SQL::Translator::Schema::Constraint->new(
73 table => $table, # table to which it belongs
74 type => 'foreign_key', # type of table constraint
75 name => 'fk_phone_id', # name of the constraint
76 fields => 'phone_id', # field in the referring table
77 reference_fields => 'phone_id', # referenced table
78 reference_table => 'phone', # referenced fields
79 match_type => 'full', # how to match
80 on_delete_do => 'cascade', # what to do on deletes
81 on_update_do => '', # what to do on updates
86 my ( $self, $config ) = @_;
88 table name type fields reference_fields reference_table
89 match_type on_delete on_update
92 for my $arg ( @fields ) {
93 next unless $config->{ $arg };
94 $self->$arg( $config->{ $arg } ) or return;
100 # ----------------------------------------------------------------------
107 Get or set the whether the constraint is deferrable. If not defined,
108 then returns "1." The argument is evaluated by Perl for True or
109 False, so the following are eqivalent:
111 $deferrable = $field->deferrable(0);
112 $deferrable = $field->deferrable('');
113 $deferrable = $field->deferrable('0');
117 my ( $self, $arg ) = @_;
119 if ( defined $arg ) {
120 $self->{'deferrable'} = $arg ? 1 : 0;
123 return defined $self->{'deferrable'} ? $self->{'deferrable'} : 1;
126 # ----------------------------------------------------------------------
133 Gets and set the expression used in a CHECK constraint.
135 my $expression = $constraint->expression('...');
141 if ( my $arg = shift ) {
143 $self->{'expression'} = $arg;
146 return $self->{'expression'} || '';
149 # ----------------------------------------------------------------------
156 Determine whether the constraint is valid or not.
158 my $ok = $constraint->is_valid;
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');
168 for my $f ( @fields ) {
169 next if $table->get_field( $f );
171 "Constraint references non-existent field '$f' ",
172 "in table '$table_name'"
176 my $schema = $table->schema or return $self->error(
177 'Table ', $table->name, ' has no schema object'
180 if ( $type eq FOREIGN_KEY ) {
181 return $self->error('Only one field allowed for foreign key')
182 if scalar @fields > 1;
184 my $ref_table_name = $self->reference_table or
185 return $self->error('No reference table');
187 my $ref_table = $schema->get_table( $ref_table_name ) or
188 return $self->error("No table named '$ref_table_name' in schema");
190 my @ref_fields = $self->reference_fields or return;
192 return $self->error('Only one field allowed for foreign key reference')
193 if scalar @ref_fields > 1;
195 for my $ref_field ( @ref_fields ) {
196 next if $ref_table->get_field( $ref_field );
198 "Constraint from field(s) ",
199 join(', ', map {qq['$table_name.$_']} @fields),
200 " to non-existent field '$ref_table_name.$ref_field'"
204 elsif ( $type eq CHECK_C ) {
205 return $self->error('No expression for CHECK') unless
212 # ----------------------------------------------------------------------
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.
223 $constraint->fields('id');
224 $constraint->fields('id', 'name');
225 $constraint->fields( 'id, name' );
226 $constraint->fields( [ 'id', 'name' ] );
227 $constraint->fields( qw[ id name ] );
229 my @fields = $constraint->fields;
234 my $fields = parse_list_arg( @_ );
237 my ( %unique, @unique );
238 for my $f ( @$fields ) {
239 next if $unique{ $f };
244 $self->{'fields'} = \@unique;
247 return wantarray ? @{ $self->{'fields'} || [] } : $self->{'fields'};
250 # ----------------------------------------------------------------------
257 Get or set the constraint's match_type. Only valid values are "full"
260 my $match_type = $constraint->match_type('FULL');
266 if ( my $arg = lc shift ) {
267 return $self->error("Invalid match type: $arg")
268 unless $arg eq 'full' || $arg eq 'partial';
269 $self->{'match_type'} = $arg;
272 return $self->{'match_type'} || '';
275 # ----------------------------------------------------------------------
282 Get or set the constraint's name.
284 my $name = $constraint->name('foo');
289 $self->{'name'} = shift if @_;
290 return $self->{'name'} || '';
293 # ----------------------------------------------------------------------
300 Gets or adds to the constraints's options (e.g., "INITIALLY IMMEDIATE").
301 Returns an array or array reference.
303 $constraint->options('NORELY');
304 my @options = $constraint->options;
309 my $options = parse_list_arg( @_ );
311 push @{ $self->{'options'} }, @$options;
313 if ( ref $self->{'options'} ) {
314 return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'};
317 return wantarray ? () : [];
322 # ----------------------------------------------------------------------
329 Get or set the constraint's "on delete" action.
331 my $action = $constraint->on_delete('cascade');
337 if ( my $arg = shift ) {
339 $self->{'on_delete'} = $arg;
342 return $self->{'on_delete'} || '';
345 # ----------------------------------------------------------------------
352 Get or set the constraint's "on update" action.
354 my $action = $constraint->on_update('no action');
360 if ( my $arg = shift ) {
362 $self->{'on_update'} = $arg;
365 return $self->{'on_update'} || '';
368 # ----------------------------------------------------------------------
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 unless ( ref $self->{'reference_fields'} ) {
396 my $table = $self->table or return $self->error('No table');
397 my $schema = $table->schema or return $self->error('No schema');
398 my $ref_table_name = $self->reference_table or
399 return $self->error('No 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'"
414 if ( ref $self->{'reference_fields'} ) {
416 ? @{ $self->{'reference_fields'} || [] }
417 : $self->{'reference_fields'};
420 return wantarray ? () : [];
424 # ----------------------------------------------------------------------
425 sub reference_table {
429 =head2 reference_table
431 Get or set the table referred to by the constraint.
433 my $reference_table = $constraint->reference_table('foo');
438 $self->{'reference_table'} = shift if @_;
439 return $self->{'reference_table'} || '';
442 # ----------------------------------------------------------------------
449 Get or set the field's table object.
451 my $table = $field->table;
456 if ( my $arg = shift ) {
457 return $self->error('Not a table object') unless
458 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
459 $self->{'table'} = $arg;
462 return $self->{'table'};
465 # ----------------------------------------------------------------------
472 Get or set the constraint's type.
474 my $type = $constraint->type( PRIMARY_KEY );
480 if ( my $type = uc shift ) {
482 return $self->error("Invalid constraint type: $type")
483 unless VALID_TYPE->{ $type };
484 $self->{'type'} = $type;
487 return $self->{'type'} || '';
489 # ----------------------------------------------------------------------
492 undef $self->{'table'}; # destroy cyclical reference
497 # ----------------------------------------------------------------------
503 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>