[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Schema / Constraint.pm

package SQL::Translator::Schema::Constraint;

# ----------------------------------------------------------------------
# $Id: Constraint.pm,v 1.9 2003-09-25 01:31:28 allenday Exp $
# ----------------------------------------------------------------------
# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; version 2.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
# 02111-1307  USA
# -------------------------------------------------------------------

=pod

=head1 NAME

SQL::Translator::Schema::Constraint - SQL::Translator constraint object

=head1 SYNOPSIS

  use SQL::Translator::Schema::Constraint;
  my $constraint = SQL::Translator::Schema::Constraint->new(
      name   => 'foo',
      fields => [ id ],
      type   => PRIMARY_KEY,
  );

=head1 DESCRIPTION

C<SQL::Translator::Schema::Constraint> is the constraint object.

=head1 METHODS

=cut

use strict;
use Class::Base;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils 'parse_list_arg';

use base 'Class::Base';
use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);

$VERSION = sprintf "%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/;

my %VALID_CONSTRAINT_TYPE = (
    PRIMARY_KEY, 1,
    UNIQUE,      1,
    CHECK_C,     1,
    FOREIGN_KEY, 1,
    NOT_NULL,    1,
);

# ----------------------------------------------------------------------
sub init {

=pod

=head2 new

Object constructor.

  my $schema           =  SQL::Translator::Schema::Constraint->new(
      table            => $table,        # table to which it belongs
      type             => 'foreign_key', # type of table constraint
      name             => 'fk_phone_id', # name of the constraint
      fields           => 'phone_id',    # field in the referring table
      reference_fields => 'phone_id',    # referenced field
      reference_table  => 'phone',       # referenced table
      match_type       => 'full',        # how to match
      on_delete_do     => 'cascade',     # what to do on deletes
      on_update_do     => '',            # what to do on updates
  );

=cut

    my ( $self, $config ) = @_;
    my @fields = qw[ 
        table name type fields reference_fields reference_table 
        match_type on_delete on_update expression
    ];

    for my $arg ( @fields ) {
        next unless $config->{ $arg };
        next if ref $config->{ $arg } eq 'ARRAY' && ! @{ $config->{ $arg } };
        defined $self->$arg( $config->{ $arg } ) or return;
    }

    return $self;
}

# ----------------------------------------------------------------------
sub deferrable {

=pod

=head2 deferrable

Get or set the whether the constraint is deferrable.  If not defined,
then returns "1."  The argument is evaluated by Perl for True or
False, so the following are eqivalent:

  $deferrable = $field->deferrable(0);
  $deferrable = $field->deferrable('');
  $deferrable = $field->deferrable('0');

=cut

    my ( $self, $arg ) = @_;

    if ( defined $arg ) {
        $self->{'deferrable'} = $arg ? 1 : 0;
    }

    return defined $self->{'deferrable'} ? $self->{'deferrable'} : 1;
}

# ----------------------------------------------------------------------
sub expression {

=pod

=head2 expression

Gets and set the expression used in a CHECK constraint.

  my $expression = $constraint->expression('...');

=cut

    my $self = shift;
    
    if ( my $arg = shift ) {
        # check arg here?
        $self->{'expression'} = $arg;
    }

    return $self->{'expression'} || '';
}

# ----------------------------------------------------------------------
sub is_valid {

=pod

=head2 is_valid

Determine whether the constraint is valid or not.

  my $ok = $constraint->is_valid;

=cut

    my $self       = shift;
    my $type       = $self->type   or return $self->error('No type');
    my $table      = $self->table  or return $self->error('No table');
    my @fields     = $self->fields or return $self->error('No fields');
    my $table_name = $table->name  or return $self->error('No table name');

    for my $f ( @fields ) {
        next if $table->get_field( $f );
        return $self->error(
            "Constraint references non-existent field '$f' ",
            "in table '$table_name'"
        );
    }

    my $schema = $table->schema or return $self->error(
        'Table ', $table->name, ' has no schema object'
    );

    if ( $type eq FOREIGN_KEY ) {
        return $self->error('Only one field allowed for foreign key')
            if scalar @fields > 1;

        my $ref_table_name  = $self->reference_table or 
            return $self->error('No reference table');

        my $ref_table = $schema->get_table( $ref_table_name ) or
            return $self->error("No table named '$ref_table_name' in schema");

        my @ref_fields = $self->reference_fields or return;

        return $self->error('Only one field allowed for foreign key reference')
            if scalar @ref_fields > 1;

        for my $ref_field ( @ref_fields ) {
            next if $ref_table->get_field( $ref_field );
            return $self->error(
                "Constraint from field(s) ", 
                join(', ', map {qq['$table_name.$_']} @fields),
                " to non-existent field '$ref_table_name.$ref_field'"
            );
        }
    }
    elsif ( $type eq CHECK_C ) {
        return $self->error('No expression for CHECK') unless 
            $self->expression;
    }

    return 1;
}

# ----------------------------------------------------------------------
sub fields {

=pod

=head2 fields

Gets and set the fields the constraint is on.  Accepts a string, list or
arrayref; returns an array or array reference.  Will unique the field
names and keep them in order by the first occurrence of a field name.

  $constraint->fields('id');
  $constraint->fields('id', 'name');
  $constraint->fields( 'id, name' );
  $constraint->fields( [ 'id', 'name' ] );
  $constraint->fields( qw[ id name ] );

  my @fields = $constraint->fields;

=cut

    my $self   = shift;
    my $fields = parse_list_arg( @_ );

    if ( @$fields ) {
        my ( %unique, @unique );
        for my $f ( @$fields ) {
            next if $unique{ $f };
            $unique{ $f } = 1;
            push @unique, $f;
        }

        $self->{'fields'} = \@unique;
    }

    if ( @{ $self->{'fields'} || [] } ) {
        return wantarray ? @{ $self->{'fields'} } : $self->{'fields'};
    }
    else {
        return wantarray ? () : undef;
    }
}

# ----------------------------------------------------------------------
sub match_type {

=pod

=head2 match_type

Get or set the constraint's match_type.  Only valid values are "full"
or "partial."

  my $match_type = $constraint->match_type('FULL');

=cut

    my $self = shift;
    
    if ( my $arg = lc shift ) {
        return $self->error("Invalid match type: $arg")
            unless $arg eq 'full' || $arg eq 'partial';
        $self->{'match_type'} = $arg;
    }

    return $self->{'match_type'} || '';
}

# ----------------------------------------------------------------------
sub name {

=pod

=head2 name

Get or set the constraint's name.

  my $name = $constraint->name('foo');

=cut

    my $self = shift;
    my $arg  = shift || '';
    $self->{'name'} = $arg if $arg;
    return $self->{'name'} || '';
}

# ----------------------------------------------------------------------
sub options {

=pod

=head2 options

Gets or adds to the constraints's options (e.g., "INITIALLY IMMEDIATE").  
Returns an array or array reference.

  $constraint->options('NORELY');
  my @options = $constraint->options;

=cut

    my $self    = shift;
    my $options = parse_list_arg( @_ );

    push @{ $self->{'options'} }, @$options;

    if ( ref $self->{'options'} ) {
        return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'};
    }
    else {
        return wantarray ? () : [];
    }
}


# ----------------------------------------------------------------------
sub on_delete {

=pod

=head2 on_delete

Get or set the constraint's "on delete" action.

  my $action = $constraint->on_delete('cascade');

=cut

    my $self = shift;
    
    if ( my $arg = shift ) {
        # validate $arg?
        $self->{'on_delete'} = $arg;
    }

    return $self->{'on_delete'} || '';
}

# ----------------------------------------------------------------------
sub on_update {

=pod

=head2 on_update

Get or set the constraint's "on update" action.

  my $action = $constraint->on_update('no action');

=cut

    my $self = shift;
    
    if ( my $arg = shift ) {
        # validate $arg?
        $self->{'on_update'} = $arg;
    }

    return $self->{'on_update'} || '';
}

# ----------------------------------------------------------------------
sub reference_fields {

=pod

=head2 reference_fields

Gets and set the fields in the referred table.  Accepts a string, list or
arrayref; returns an array or array reference.

  $constraint->reference_fields('id');
  $constraint->reference_fields('id', 'name');
  $constraint->reference_fields( 'id, name' );
  $constraint->reference_fields( [ 'id', 'name' ] );
  $constraint->reference_fields( qw[ id name ] );

  my @reference_fields = $constraint->reference_fields;

=cut

    my $self   = shift;
    my $fields = parse_list_arg( @_ );

    if ( @$fields ) {
        $self->{'reference_fields'} = $fields;
    }

    unless ( ref $self->{'reference_fields'} ) {
        my $table          = $self->table or return $self->error('No table');
        my $schema         = $table->schema or return $self->error('No schema');
        my $ref_table_name = $self->reference_table or 
            return $self->error('No table');
        my $ref_table      = $schema->get_table( $ref_table_name ) or
            return $self->error("Can't find table '$ref_table_name'");

        if ( my $constraint = $ref_table->primary_key ) { 
            $self->{'reference_fields'} = [ $constraint->fields ];
        }
        else {
            $self->error(
                'No reference fields defined and cannot find primary key in ',
                "reference table '$ref_table_name'"
            );
        }
    }

    if ( ref $self->{'reference_fields'} ) {
        return wantarray 
            ?  @{ $self->{'reference_fields'} || [] } 
            :     $self->{'reference_fields'};
    }
    else {
        return wantarray ? () : [];
    }
}

# ----------------------------------------------------------------------
sub reference_table {

=pod

=head2 reference_table

Get or set the table referred to by the constraint.

  my $reference_table = $constraint->reference_table('foo');

=cut

    my $self = shift;
    $self->{'reference_table'} = shift if @_;
    return $self->{'reference_table'} || '';
}

# ----------------------------------------------------------------------
sub table {

=pod

=head2 table

Get or set the field's table object.

  my $table = $field->table;

=cut

    my $self = shift;
    if ( my $arg = shift ) {
        return $self->error('Not a table object') unless
            UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
        $self->{'table'} = $arg;
    }

    return $self->{'table'};
}

# ----------------------------------------------------------------------
sub type {

=pod

=head2 type

Get or set the constraint's type.

  my $type = $constraint->type( PRIMARY_KEY );

=cut

    my $self = shift;

    if ( my $type = uc shift ) {
        $type =~ s/_/ /g;
        return $self->error("Invalid constraint type: $type") 
            unless $VALID_CONSTRAINT_TYPE{ $type };
        $self->{'type'} = $type;
    }

    return $self->{'type'} || '';
}
# ----------------------------------------------------------------------
sub DESTROY {
    my $self = shift;
    undef $self->{'table'}; # destroy cyclical reference
}

1;

# ----------------------------------------------------------------------

=pod

=head1 AUTHOR

Ken Y. Clark E<lt>kclark@cpan.orgE<gt>

=cut
Commit	Line	Data
3c5de62a	1	package SQL::Translator::Schema::Constraint;
	2
	3	# ----------------------------------------------------------------------
65157eda	4	# $Id: Constraint.pm,v 1.9 2003-09-25 01:31:28 allenday Exp $
3c5de62a	5	# ----------------------------------------------------------------------
	6	# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>
	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;
	47	use Class::Base;
43b9dc7a	48	use SQL::Translator::Schema::Constants;
752608d5	49	use SQL::Translator::Utils 'parse_list_arg';
3c5de62a	50
	51	use base 'Class::Base';
	52	use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
	53
65157eda	54	$VERSION = sprintf "%d.%02d", q$Revision: 1.9 $ =~ /(\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,
695c2da2	62	);
3c5de62a	63
	64	# ----------------------------------------------------------------------
	65	sub init {
	66
	67	=pod
	68
	69	=head2 new
	70
	71	Object constructor.
	72
	73	my $schema = SQL::Translator::Schema::Constraint->new(
dedb8f3b	74	table => $table, # table to which it belongs
3c5de62a	75	type => 'foreign_key', # type of table constraint
dedb8f3b	76	name => 'fk_phone_id', # name of the constraint
dedb8f3b	77	fields => 'phone_id', # field in the referring table
65157eda	78	reference_fields => 'phone_id', # referenced field
65157eda	79	reference_table => 'phone', # referenced table
3c5de62a	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
	83	);
	84
	85	=cut
	86
	87	my ( $self, $config ) = @_;
752608d5	88	my @fields = qw[
752608d5	89	table name type fields reference_fields reference_table
53ded04a	90	match_type on_delete on_update expression
752608d5	91	];
3c5de62a	92
	93	for my $arg ( @fields ) {
	94	next unless $config->{ $arg };
53ded04a	95	next if ref $config->{ $arg } eq 'ARRAY' && ! @{ $config->{ $arg } };
695c2da2	96	defined $self->$arg( $config->{ $arg } ) or return;
3c5de62a	97	}
	98
	99	return $self;
	100	}
	101
	102	# ----------------------------------------------------------------------
43b9dc7a	103	sub deferrable {
	104
	105	=pod
	106
	107	=head2 deferrable
	108
	109	Get or set the whether the constraint is deferrable. If not defined,
	110	then returns "1." The argument is evaluated by Perl for True or
	111	False, so the following are eqivalent:
	112
	113	$deferrable = $field->deferrable(0);
	114	$deferrable = $field->deferrable('');
	115	$deferrable = $field->deferrable('0');
	116
	117	=cut
	118
	119	my ( $self, $arg ) = @_;
	120
	121	if ( defined $arg ) {
	122	$self->{'deferrable'} = $arg ? 1 : 0;
	123	}
	124
	125	return defined $self->{'deferrable'} ? $self->{'deferrable'} : 1;
	126	}
	127
	128	# ----------------------------------------------------------------------
	129	sub expression {
	130
	131	=pod
	132
	133	=head2 expression
	134
	135	Gets and set the expression used in a CHECK constraint.
	136
	137	my $expression = $constraint->expression('...');
	138
	139	=cut
	140
	141	my $self = shift;
	142
	143	if ( my $arg = shift ) {
	144	# check arg here?
	145	$self->{'expression'} = $arg;
	146	}
	147
	148	return $self->{'expression'} \|\| '';
	149	}
	150
	151	# ----------------------------------------------------------------------
	152	sub is_valid {
	153
	154	=pod
	155
	156	=head2 is_valid
	157
	158	Determine whether the constraint is valid or not.
	159
	160	my $ok = $constraint->is_valid;
	161
	162	=cut
	163
	164	my $self = shift;
	165	my $type = $self->type or return $self->error('No type');
	166	my $table = $self->table or return $self->error('No table');
167	my @fields = $self->fields or return $self->error('No fields');
168	my $table_name = $table->name or return $self->error('No table name');
169
170	for my $f ( @fields ) {
171	next if $table->get_field( $f );
172	return $self->error(
173	"Constraint references non-existent field '$f' ",
174	"in table '$table_name'"
175	);
176	}
177
178	my $schema = $table->schema or return $self->error(
179	'Table ', $table->name, ' has no schema object'
180	);
181
182	if ( $type eq FOREIGN_KEY ) {
183	return $self->error('Only one field allowed for foreign key')
184	if scalar @fields > 1;
185
186	my $ref_table_name = $self->reference_table or
187	return $self->error('No reference table');
188
189	my $ref_table = $schema->get_table( $ref_table_name ) or
190	return $self->error("No table named '$ref_table_name' in schema");
191
192	my @ref_fields = $self->reference_fields or return;
193
194	return $self->error('Only one field allowed for foreign key reference')
195	if scalar @ref_fields > 1;
196
197	for my $ref_field ( @ref_fields ) {
198	next if $ref_table->get_field( $ref_field );
199	return $self->error(
200	"Constraint from field(s) ",
201	join(', ', map {qq['$table_name.$_']} @fields),
202	" to non-existent field '$ref_table_name.$ref_field'"
203	);
204	}
205	}
206	elsif ( $type eq CHECK_C ) {
207	return $self->error('No expression for CHECK') unless
208	$self->expression;
209	}
210
211	return 1;
212	}
213
214	# ----------------------------------------------------------------------
3c5de62a	215	sub fields {
	216
	217	=pod
	218
	219	=head2 fields
	220
43b9dc7a	221	Gets and set the fields the constraint is on. Accepts a string, list or
	222	arrayref; returns an array or array reference. Will unique the field
	223	names and keep them in order by the first occurrence of a field name.
	224
	225	$constraint->fields('id');
	226	$constraint->fields('id', 'name');
	227	$constraint->fields( 'id, name' );
	228	$constraint->fields( [ 'id', 'name' ] );
	229	$constraint->fields( qw[ id name ] );
3c5de62a	230
43b9dc7a	231	my @fields = $constraint->fields;
3c5de62a	232
	233	=cut
	234
	235	my $self = shift;
752608d5	236	my $fields = parse_list_arg( @_ );
3c5de62a	237
3c5de62a	238	if ( @$fields ) {
43b9dc7a	239	my ( %unique, @unique );
	240	for my $f ( @$fields ) {
	241	next if $unique{ $f };
	242	$unique{ $f } = 1;
	243	push @unique, $f;
	244	}
	245
	246	$self->{'fields'} = \@unique;
3c5de62a	247	}
3c5de62a	248
53ded04a	249	if ( @{ $self->{'fields'} \|\| [] } ) {
	250	return wantarray ? @{ $self->{'fields'} } : $self->{'fields'};
	251	}
	252	else {
	253	return wantarray ? () : undef;
	254	}
3c5de62a	255	}
	256
	257	# ----------------------------------------------------------------------
752608d5	258	sub match_type {
	259
	260	=pod
	261
	262	=head2 match_type
	263
	264	Get or set the constraint's match_type. Only valid values are "full"
	265	or "partial."
	266
	267	my $match_type = $constraint->match_type('FULL');
	268
	269	=cut
	270
	271	my $self = shift;
	272
	273	if ( my $arg = lc shift ) {
	274	return $self->error("Invalid match type: $arg")
	275	unless $arg eq 'full' \|\| $arg eq 'partial';
	276	$self->{'match_type'} = $arg;
	277	}
	278
	279	return $self->{'match_type'} \|\| '';
	280	}
	281
	282	# ----------------------------------------------------------------------
3c5de62a	283	sub name {
	284
	285	=pod
	286
	287	=head2 name
	288
	289	Get or set the constraint's name.
	290
	291	my $name = $constraint->name('foo');
	292
	293	=cut
	294
	295	my $self = shift;
695c2da2	296	my $arg = shift \|\| '';
695c2da2	297	$self->{'name'} = $arg if $arg;
3c5de62a	298	return $self->{'name'} \|\| '';
	299	}
	300
	301	# ----------------------------------------------------------------------
dedb8f3b	302	sub options {
	303
	304	=pod
	305
	306	=head2 options
	307
	308	Gets or adds to the constraints's options (e.g., "INITIALLY IMMEDIATE").
	309	Returns an array or array reference.
	310
	311	$constraint->options('NORELY');
	312	my @options = $constraint->options;
	313
	314	=cut
	315
	316	my $self = shift;
	317	my $options = parse_list_arg( @_ );
	318
	319	push @{ $self->{'options'} }, @$options;
	320
	321	if ( ref $self->{'options'} ) {
	322	return wantarray ? @{ $self->{'options'} \|\| [] } : $self->{'options'};
	323	}
	324	else {
	325	return wantarray ? () : [];
	326	}
	327	}
	328
	329
	330	# ----------------------------------------------------------------------
43b9dc7a	331	sub on_delete {
	332
	333	=pod
	334
	335	=head2 on_delete
	336
	337	Get or set the constraint's "on delete" action.
	338
	339	my $action = $constraint->on_delete('cascade');
	340
	341	=cut
	342
	343	my $self = shift;
	344
	345	if ( my $arg = shift ) {
	346	# validate $arg?
	347	$self->{'on_delete'} = $arg;
	348	}
	349
	350	return $self->{'on_delete'} \|\| '';
	351	}
	352
	353	# ----------------------------------------------------------------------
	354	sub on_update {
	355
	356	=pod
	357
	358	=head2 on_update
	359
	360	Get or set the constraint's "on update" action.
	361
	362	my $action = $constraint->on_update('no action');
	363
	364	=cut
	365
	366	my $self = shift;
	367
	368	if ( my $arg = shift ) {
	369	# validate $arg?
	370	$self->{'on_update'} = $arg;
	371	}
	372
	373	return $self->{'on_update'} \|\| '';
	374	}
	375
	376	# ----------------------------------------------------------------------
	377	sub reference_fields {
	378
	379	=pod
	380
	381	=head2 reference_fields
	382
	383	Gets and set the fields in the referred table. Accepts a string, list or
	384	arrayref; returns an array or array reference.
	385
	386	$constraint->reference_fields('id');
	387	$constraint->reference_fields('id', 'name');
	388	$constraint->reference_fields( 'id, name' );
	389	$constraint->reference_fields( [ 'id', 'name' ] );
	390	$constraint->reference_fields( qw[ id name ] );
	391
	392	my @reference_fields = $constraint->reference_fields;
	393
	394	=cut
395
396	my $self = shift;
752608d5	397	my $fields = parse_list_arg( @_ );
43b9dc7a	398
	399	if ( @$fields ) {
	400	$self->{'reference_fields'} = $fields;
	401	}
	402
	403	unless ( ref $self->{'reference_fields'} ) {
	404	my $table = $self->table or return $self->error('No table');
	405	my $schema = $table->schema or return $self->error('No schema');
	406	my $ref_table_name = $self->reference_table or
	407	return $self->error('No table');
	408	my $ref_table = $schema->get_table( $ref_table_name ) or
	409	return $self->error("Can't find table '$ref_table_name'");
	410
	411	if ( my $constraint = $ref_table->primary_key ) {
	412	$self->{'reference_fields'} = [ $constraint->fields ];
	413	}
	414	else {
	415	$self->error(
	416	'No reference fields defined and cannot find primary key in ',
	417	"reference table '$ref_table_name'"
	418	);
	419	}
	420	}
	421
	422	if ( ref $self->{'reference_fields'} ) {
	423	return wantarray
	424	? @{ $self->{'reference_fields'} \|\| [] }
	425	: $self->{'reference_fields'};
	426	}
	427	else {
	428	return wantarray ? () : [];
	429	}
	430	}
	431
	432	# ----------------------------------------------------------------------
	433	sub reference_table {
	434
	435	=pod
	436
	437	=head2 reference_table
	438
	439	Get or set the table referred to by the constraint.
	440
	441	my $reference_table = $constraint->reference_table('foo');
	442
	443	=cut
	444
	445	my $self = shift;
	446	$self->{'reference_table'} = shift if @_;
	447	return $self->{'reference_table'} \|\| '';
	448	}
	449
3c5de62a	450	# ----------------------------------------------------------------------
43b9dc7a	451	sub table {
3c5de62a	452
	453	=pod
	454
43b9dc7a	455	=head2 table
3c5de62a	456
43b9dc7a	457	Get or set the field's table object.
3c5de62a	458
43b9dc7a	459	my $table = $field->table;
3c5de62a	460
	461	=cut
	462
	463	my $self = shift;
43b9dc7a	464	if ( my $arg = shift ) {
	465	return $self->error('Not a table object') unless
	466	UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
	467	$self->{'table'} = $arg;
	468	}
	469
	470	return $self->{'table'};
	471	}
	472
	473	# ----------------------------------------------------------------------
dedb8f3b	474	sub type {
43b9dc7a	475
	476	=pod
	477
dedb8f3b	478	=head2 type
43b9dc7a	479
dedb8f3b	480	Get or set the constraint's type.
43b9dc7a	481
dedb8f3b	482	my $type = $constraint->type( PRIMARY_KEY );
43b9dc7a	483
	484	=cut
	485
dedb8f3b	486	my $self = shift;
43b9dc7a	487
dedb8f3b	488	if ( my $type = uc shift ) {
	489	$type =~ s/_/ /g;
	490	return $self->error("Invalid constraint type: $type")
695c2da2	491	unless $VALID_CONSTRAINT_TYPE{ $type };
dedb8f3b	492	$self->{'type'} = $type;
43b9dc7a	493	}
3c5de62a	494
dedb8f3b	495	return $self->{'type'} \|\| '';
dedb8f3b	496	}
752608d5	497	# ----------------------------------------------------------------------
	498	sub DESTROY {
	499	my $self = shift;
	500	undef $self->{'table'}; # destroy cyclical reference
	501	}
	502
3c5de62a	503	1;
	504
	505	# ----------------------------------------------------------------------
	506
	507	=pod
	508
	509	=head1 AUTHOR
	510
	511	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
	512
	513	=cut