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

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

# ----------------------------------------------------------------------
# $Id: Constraint.pm,v 1.3 2003-05-09 17:06:11 kycl4rk 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 = 1.00;

use constant VALID_TYPE => {
    PRIMARY_KEY, 1,
    UNIQUE,      1,
    CHECK_C,     1,
    FOREIGN_KEY, 1,
};

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

=pod

=head2 new

Object constructor.

  my $schema           =  SQL::Translator::Schema::Constraint->new(
      table            => $table,        # the table to which it belongs
      type             => 'foreign_key', # type of table constraint
      name             => 'fk_phone_id', # the name of the constraint
      fields           => 'phone_id',    # the field in the referring table
      reference_fields => 'phone_id',    # the referenced table
      reference_table  => 'phone',       # the referenced fields
      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
    ];

    for my $arg ( @fields ) {
        next unless $config->{ $arg };
        $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;
    }

    return wantarray ? @{ $self->{'fields'} || [] } : $self->{'fields'};
}

# ----------------------------------------------------------------------
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;
    $self->{'name'} = shift if @_;
    return $self->{'name'} || '';
}

# ----------------------------------------------------------------------
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 type {

=pod

=head2 type

Get or set the constraint's type.

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

=cut

    my $self = shift;

    if ( my $type = shift ) {
        return $self->error("Invalid constraint type: $type") 
            unless VALID_TYPE->{ $type };
        $self->{'type'} = $type;
    }

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


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