1 package SQL::Translator::Schema::Constraint;
3 # ----------------------------------------------------------------------
4 # $Id: Constraint.pm,v 1.2 2003-05-05 04:32:39 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;
50 use base 'Class::Base';
51 use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
55 use constant VALID_TYPE => {
62 # ----------------------------------------------------------------------
71 my $schema = SQL::Translator::Schema::Constraint->new(
72 table => $table, # the table to which it belongs
73 type => 'foreign_key', # type of table constraint
74 name => 'fk_phone_id', # the name of the constraint
75 fields => 'phone_id', # the field in the referring table
76 reference_fields => 'phone_id', # the referenced table
77 reference_table => 'phone', # the referenced fields
78 match_type => 'full', # how to match
79 on_delete_do => 'cascade', # what to do on deletes
80 on_update_do => '', # what to do on updates
85 my ( $self, $config ) = @_;
86 # match_type on_delete_do on_update_do
87 my @fields = qw[ name type fields reference_fields reference_table table ];
89 for my $arg ( @fields ) {
90 next unless $config->{ $arg };
91 $self->$arg( $config->{ $arg } ) or return;
97 # ----------------------------------------------------------------------
104 Get or set the whether the constraint is deferrable. If not defined,
105 then returns "1." The argument is evaluated by Perl for True or
106 False, so the following are eqivalent:
108 $deferrable = $field->deferrable(0);
109 $deferrable = $field->deferrable('');
110 $deferrable = $field->deferrable('0');
114 my ( $self, $arg ) = @_;
116 if ( defined $arg ) {
117 $self->{'deferrable'} = $arg ? 1 : 0;
120 return defined $self->{'deferrable'} ? $self->{'deferrable'} : 1;
123 # ----------------------------------------------------------------------
130 Gets and set the expression used in a CHECK constraint.
132 my $expression = $constraint->expression('...');
138 if ( my $arg = shift ) {
140 $self->{'expression'} = $arg;
143 return $self->{'expression'} || '';
146 # ----------------------------------------------------------------------
153 Determine whether the constraint is valid or not.
155 my $ok = $constraint->is_valid;
160 my $type = $self->type or return $self->error('No type');
161 my $table = $self->table or return $self->error('No table');
162 my @fields = $self->fields or return $self->error('No fields');
163 my $table_name = $table->name or return $self->error('No table name');
165 for my $f ( @fields ) {
166 next if $table->get_field( $f );
168 "Constraint references non-existent field '$f' ",
169 "in table '$table_name'"
173 my $schema = $table->schema or return $self->error(
174 'Table ', $table->name, ' has no schema object'
177 if ( $type eq FOREIGN_KEY ) {
178 return $self->error('Only one field allowed for foreign key')
179 if scalar @fields > 1;
181 my $ref_table_name = $self->reference_table or
182 return $self->error('No reference table');
184 my $ref_table = $schema->get_table( $ref_table_name ) or
185 return $self->error("No table named '$ref_table_name' in schema");
187 my @ref_fields = $self->reference_fields or return;
189 return $self->error('Only one field allowed for foreign key reference')
190 if scalar @ref_fields > 1;
192 for my $ref_field ( @ref_fields ) {
193 next if $ref_table->get_field( $ref_field );
195 "Constraint from field(s) ",
196 join(', ', map {qq['$table_name.$_']} @fields),
197 " to non-existent field '$ref_table_name.$ref_field'"
201 elsif ( $type eq CHECK_C ) {
202 return $self->error('No expression for CHECK') unless
209 # ----------------------------------------------------------------------
216 Gets and set the fields the constraint is on. Accepts a string, list or
217 arrayref; returns an array or array reference. Will unique the field
218 names and keep them in order by the first occurrence of a field name.
220 $constraint->fields('id');
221 $constraint->fields('id', 'name');
222 $constraint->fields( 'id, name' );
223 $constraint->fields( [ 'id', 'name' ] );
224 $constraint->fields( qw[ id name ] );
226 my @fields = $constraint->fields;
231 my $fields = UNIVERSAL::isa( $_[0], 'ARRAY' )
232 ? shift : [ map { s/^\s+|\s+$//g; $_ } map { split /,/ } @_ ];
235 my ( %unique, @unique );
236 for my $f ( @$fields ) {
237 next if $unique{ $f };
242 $self->{'fields'} = \@unique;
245 return wantarray ? @{ $self->{'fields'} || [] } : $self->{'fields'};
248 # ----------------------------------------------------------------------
255 Get or set the constraint's name.
257 my $name = $constraint->name('foo');
262 $self->{'name'} = shift if @_;
263 return $self->{'name'} || '';
266 # ----------------------------------------------------------------------
273 Get or set the constraint's "on delete" action.
275 my $action = $constraint->on_delete('cascade');
281 if ( my $arg = shift ) {
283 $self->{'on_delete'} = $arg;
286 return $self->{'on_delete'} || '';
289 # ----------------------------------------------------------------------
296 Get or set the constraint's "on update" action.
298 my $action = $constraint->on_update('no action');
304 if ( my $arg = shift ) {
306 $self->{'on_update'} = $arg;
309 return $self->{'on_update'} || '';
312 # ----------------------------------------------------------------------
313 sub reference_fields {
317 =head2 reference_fields
319 Gets and set the fields in the referred table. Accepts a string, list or
320 arrayref; returns an array or array reference.
322 $constraint->reference_fields('id');
323 $constraint->reference_fields('id', 'name');
324 $constraint->reference_fields( 'id, name' );
325 $constraint->reference_fields( [ 'id', 'name' ] );
326 $constraint->reference_fields( qw[ id name ] );
328 my @reference_fields = $constraint->reference_fields;
333 my $fields = UNIVERSAL::isa( $_[0], 'ARRAY' )
334 ? shift : [ map { s/^\s+|\s+$//g; $_ } map { split /,/ } @_ ];
337 $self->{'reference_fields'} = $fields;
340 unless ( ref $self->{'reference_fields'} ) {
341 my $table = $self->table or return $self->error('No table');
342 my $schema = $table->schema or return $self->error('No schema');
343 my $ref_table_name = $self->reference_table or
344 return $self->error('No table');
345 my $ref_table = $schema->get_table( $ref_table_name ) or
346 return $self->error("Can't find table '$ref_table_name'");
348 if ( my $constraint = $ref_table->primary_key ) {
349 $self->{'reference_fields'} = [ $constraint->fields ];
353 'No reference fields defined and cannot find primary key in ',
354 "reference table '$ref_table_name'"
359 if ( ref $self->{'reference_fields'} ) {
361 ? @{ $self->{'reference_fields'} || [] }
362 : $self->{'reference_fields'};
365 return wantarray ? () : [];
369 # ----------------------------------------------------------------------
370 sub reference_table {
374 =head2 reference_table
376 Get or set the table referred to by the constraint.
378 my $reference_table = $constraint->reference_table('foo');
383 $self->{'reference_table'} = shift if @_;
384 return $self->{'reference_table'} || '';
388 # ----------------------------------------------------------------------
395 Get or set the constraint's type.
397 my $type = $constraint->type( PRIMARY_KEY );
403 if ( my $type = shift ) {
404 return $self->error("Invalid constraint type: $type")
405 unless VALID_TYPE->{ $type };
406 $self->{'type'} = $type;
409 return $self->{'type'} || '';
413 # ----------------------------------------------------------------------
420 Get or set the field's table object.
422 my $table = $field->table;
427 if ( my $arg = shift ) {
428 return $self->error('Not a table object') unless
429 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
430 $self->{'table'} = $arg;
433 return $self->{'table'};
436 # ----------------------------------------------------------------------
443 Gets or adds to the constraints's options (e.g., "INITIALLY IMMEDIATE").
444 Returns an array or array reference.
446 $constraint->options('NORELY');
447 my @options = $constraint->options;
452 my $options = UNIVERSAL::isa( $_[0], 'ARRAY' )
453 ? shift : [ map { s/^\s+|\s+$//g; $_ } map { split /,/ } @_ ];
455 push @{ $self->{'options'} }, @$options;
457 if ( ref $self->{'options'} ) {
458 return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'};
461 return wantarray ? () : [];
467 # ----------------------------------------------------------------------
473 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>