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

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

# ----------------------------------------------------------------------
# $Id: Constraint.pm,v 1.11 2004-02-29 16:05:31 grommit Exp $
# ----------------------------------------------------------------------
# Copyright (C) 2002-4 SQLFairy Authors
#
# 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.11 $ =~ /(\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        => 'cascade',     # what to do on deletes
      on_update        => '',            # 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 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;
    }

    # Nothing set so try and derive it from the other constraint data
    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');
        if ( my $ref_table_name = $self->reference_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'"
                );
            }
        }
        # No ref table so we are not that sort of constraint, hence no ref
        # fields. So we let the return below return an empty list.
    }

    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 constraint'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	# ----------------------------------------------------------------------
2d034ab4	4	# $Id: Constraint.pm,v 1.11 2004-02-29 16:05:31 grommit 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;
	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
2d034ab4	54	$VERSION = sprintf "%d.%02d", q$Revision: 1.11 $ =~ /(\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
2d034ab4	81	on_delete => 'cascade', # what to do on deletes
2d034ab4	82	on_update => '', # what to do on updates
3c5de62a	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
2d034ab4	109	Get or set whether the constraint is deferrable. If not defined,
43b9dc7a	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
2d034ab4	403	# Nothing set so try and derive it from the other constraint data
43b9dc7a	404	unless ( ref $self->{'reference_fields'} ) {
2d034ab4	405	my $table = $self->table or return $self->error('No table');
	406	my $schema = $table->schema or return $self->error('No schema');
	407	if ( my $ref_table_name = $self->reference_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	}
43b9dc7a	420	}
2d034ab4	421	# No ref table so we are not that sort of constraint, hence no ref
2d034ab4	422	# fields. So we let the return below return an empty list.
43b9dc7a	423	}
	424
	425	if ( ref $self->{'reference_fields'} ) {
	426	return wantarray
2d034ab4	427	? @{ $self->{'reference_fields'} }
43b9dc7a	428	: $self->{'reference_fields'};
	429	}
	430	else {
	431	return wantarray ? () : [];
	432	}
	433	}
	434
	435	# ----------------------------------------------------------------------
	436	sub reference_table {
	437
	438	=pod
	439
	440	=head2 reference_table
	441
	442	Get or set the table referred to by the constraint.
	443
	444	my $reference_table = $constraint->reference_table('foo');
	445
	446	=cut
	447
	448	my $self = shift;
	449	$self->{'reference_table'} = shift if @_;
	450	return $self->{'reference_table'} \|\| '';
	451	}
	452
3c5de62a	453	# ----------------------------------------------------------------------
43b9dc7a	454	sub table {
3c5de62a	455
	456	=pod
	457
43b9dc7a	458	=head2 table
3c5de62a	459
2d034ab4	460	Get or set the constraint's table object.
3c5de62a	461
43b9dc7a	462	my $table = $field->table;
3c5de62a	463
	464	=cut
	465
	466	my $self = shift;
43b9dc7a	467	if ( my $arg = shift ) {
	468	return $self->error('Not a table object') unless
	469	UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
	470	$self->{'table'} = $arg;
	471	}
	472
	473	return $self->{'table'};
	474	}
	475
	476	# ----------------------------------------------------------------------
dedb8f3b	477	sub type {
43b9dc7a	478
	479	=pod
	480
dedb8f3b	481	=head2 type
43b9dc7a	482
dedb8f3b	483	Get or set the constraint's type.
43b9dc7a	484
dedb8f3b	485	my $type = $constraint->type( PRIMARY_KEY );
43b9dc7a	486
	487	=cut
	488
dedb8f3b	489	my $self = shift;
43b9dc7a	490
dedb8f3b	491	if ( my $type = uc shift ) {
	492	$type =~ s/_/ /g;
	493	return $self->error("Invalid constraint type: $type")
695c2da2	494	unless $VALID_CONSTRAINT_TYPE{ $type };
dedb8f3b	495	$self->{'type'} = $type;
43b9dc7a	496	}
3c5de62a	497
dedb8f3b	498	return $self->{'type'} \|\| '';
dedb8f3b	499	}
752608d5	500	# ----------------------------------------------------------------------
	501	sub DESTROY {
	502	my $self = shift;
	503	undef $self->{'table'}; # destroy cyclical reference
	504	}
	505
3c5de62a	506	1;
	507
	508	# ----------------------------------------------------------------------
	509
	510	=pod
	511
	512	=head1 AUTHOR
	513
6606c4c6	514	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
3c5de62a	515
3c5de62a	516	=cut