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

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

=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 SQL::Translator::Schema::Constants;
use SQL::Translator::Utils 'parse_list_arg';

use base 'SQL::Translator::Schema::Object';

use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);

$VERSION = '1.59';

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

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

__PACKAGE__->_attributes( qw/
    table name type fields reference_fields reference_table 
    match_type on_delete on_update expression deferrable
/);

# Override to remove empty arrays from args.
# t/14postgres-parser breaks without this.
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 = shift;
    foreach ( values %{$_[0]} ) { $_ = undef if ref($_) eq "ARRAY" && ! @$_; }
    $self->SUPER::init(@_);
}

# ----------------------------------------------------------------------
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.

The fields are returned as Field objects if they exist or as plain
names if not. (If you just want the names and want to avoid the Field's overload
magic use L<field_names>).

Returns undef or an empty list if the constraint has no fields set.

  $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'} || [] } ) {
        # We have to return fields that don't exist on the table as names in
        # case those fields havn't been created yet.
        my @ret = map {
            $self->table->get_field($_) || $_ } @{ $self->{'fields'} };
        return wantarray ? @ret : \@ret;
    }
    else {
        return wantarray ? () : undef;
    }
}

# ----------------------------------------------------------------------
sub field_names {

=head2 field_names

Read-only method to return a list or array ref of the field names. Returns undef
or an empty list if the constraint has no fields set. Useful if you want to
avoid the overload magic of the Field objects returned by the fields method.

  my @names = $constraint->field_names;

=cut

    my $self = shift;
    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"
"partial" and "simple"

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

=cut

    my ( $self, $arg ) = @_;
    
    if ( $arg ) {
        $arg = lc $arg;
        return $self->error("Invalid match type: $arg")
            unless $arg eq 'full' || $arg eq 'partial' || $arg eq 'simple';
        $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, $type ) = @_;

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

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

# ----------------------------------------------------------------------
sub equals {

=pod

=head2 equals

Determines if this constraint is the same as another

  my $isIdentical = $constraint1->equals( $constraint2 );

=cut

    my $self = shift;
    my $other = shift;
    my $case_insensitive = shift;
    my $ignore_constraint_names = shift;
    
    return 0 unless $self->SUPER::equals($other);
    return 0 unless $self->type eq $other->type;
    unless ($ignore_constraint_names) {
        return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
    }
    return 0 unless $self->deferrable eq $other->deferrable;
    #return 0 unless $self->is_valid eq $other->is_valid;
    return 0 unless $case_insensitive ? uc($self->table->name) eq uc($other->table->name)
    	: $self->table->name eq $other->table->name;
    return 0 unless $self->expression eq $other->expression;
    
    # Check fields, regardless of order
    my %otherFields = ();	# create a hash of the other fields
    foreach my $otherField ($other->fields) {
    	$otherField = uc($otherField) if $case_insensitive;
    	$otherFields{$otherField} = 1;
    }
    foreach my $selfField ($self->fields) { # check for self fields in hash
    	$selfField = uc($selfField) if $case_insensitive;
    	return 0 unless $otherFields{$selfField};
    	delete $otherFields{$selfField};
    }
    # Check all other fields were accounted for
    return 0 unless keys %otherFields == 0;

    # Check reference fields, regardless of order
    my %otherRefFields = ();	# create a hash of the other reference fields
    foreach my $otherRefField ($other->reference_fields) {
    	$otherRefField = uc($otherRefField) if $case_insensitive;
    	$otherRefFields{$otherRefField} = 1;
    }
    foreach my $selfRefField ($self->reference_fields) { # check for self reference fields in hash
    	$selfRefField = uc($selfRefField) if $case_insensitive;
    	return 0 unless $otherRefFields{$selfRefField};
    	delete $otherRefFields{$selfRefField};
    }
    # Check all other reference fields were accounted for
    return 0 unless keys %otherRefFields == 0;

    return 0 unless $case_insensitive ? uc($self->reference_table) eq uc($other->reference_table) : $self->reference_table eq $other->reference_table;
    return 0 unless $self->match_type eq $other->match_type;
    return 0 unless $self->on_delete eq $other->on_delete;
    return 0 unless $self->on_update eq $other->on_update;
    return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options);
    return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
    return 1;
}

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

1;

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

=pod

=head1 AUTHOR

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

=cut
Commit	Line	Data
3c5de62a	1	package SQL::Translator::Schema::Constraint;
3c5de62a	2
3c5de62a	3	=pod
	4
	5	=head1 NAME
	6
	7	SQL::Translator::Schema::Constraint - SQL::Translator constraint object
	8
	9	=head1 SYNOPSIS
	10
	11	use SQL::Translator::Schema::Constraint;
	12	my $constraint = SQL::Translator::Schema::Constraint->new(
	13	name => 'foo',
	14	fields => [ id ],
43b9dc7a	15	type => PRIMARY_KEY,
3c5de62a	16	);
	17
	18	=head1 DESCRIPTION
	19
	20	C<SQL::Translator::Schema::Constraint> is the constraint object.
	21
	22	=head1 METHODS
	23
	24	=cut
	25
	26	use strict;
43b9dc7a	27	use SQL::Translator::Schema::Constants;
752608d5	28	use SQL::Translator::Utils 'parse_list_arg';
3c5de62a	29
b6a880d1	30	use base 'SQL::Translator::Schema::Object';
b6a880d1	31
da06ac74	32	use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
da06ac74	33
11ad2df9	34	$VERSION = '1.59';
3c5de62a	35
695c2da2	36	my %VALID_CONSTRAINT_TYPE = (
43b9dc7a	37	PRIMARY_KEY, 1,
	38	UNIQUE, 1,
	39	CHECK_C, 1,
	40	FOREIGN_KEY, 1,
695c2da2	41	NOT_NULL, 1,
695c2da2	42	);
3c5de62a	43
3c5de62a	44	# ----------------------------------------------------------------------
3c5de62a	45
9371be50	46	__PACKAGE__->_attributes( qw/
	47	table name type fields reference_fields reference_table
	48	match_type on_delete on_update expression deferrable
	49	/);
	50
	51	# Override to remove empty arrays from args.
	52	# t/14postgres-parser breaks without this.
	53	sub init {
	54
3c5de62a	55	=pod
	56
	57	=head2 new
	58
	59	Object constructor.
	60
	61	my $schema = SQL::Translator::Schema::Constraint->new(
dedb8f3b	62	table => $table, # table to which it belongs
3c5de62a	63	type => 'foreign_key', # type of table constraint
dedb8f3b	64	name => 'fk_phone_id', # name of the constraint
dedb8f3b	65	fields => 'phone_id', # field in the referring table
65157eda	66	reference_fields => 'phone_id', # referenced field
65157eda	67	reference_table => 'phone', # referenced table
3c5de62a	68	match_type => 'full', # how to match
2d034ab4	69	on_delete => 'cascade', # what to do on deletes
2d034ab4	70	on_update => '', # what to do on updates
3c5de62a	71	);
	72
	73	=cut
	74
9371be50	75	my $self = shift;
	76	foreach ( values %{$_[0]} ) { $_ = undef if ref($_) eq "ARRAY" && ! @$_; }
	77	$self->SUPER::init(@_);
3c5de62a	78	}
	79
	80	# ----------------------------------------------------------------------
43b9dc7a	81	sub deferrable {
	82
	83	=pod
	84
	85	=head2 deferrable
	86
2d034ab4	87	Get or set whether the constraint is deferrable. If not defined,
43b9dc7a	88	then returns "1." The argument is evaluated by Perl for True or
	89	False, so the following are eqivalent:
	90
	91	$deferrable = $field->deferrable(0);
	92	$deferrable = $field->deferrable('');
	93	$deferrable = $field->deferrable('0');
	94
	95	=cut
	96
	97	my ( $self, $arg ) = @_;
	98
	99	if ( defined $arg ) {
	100	$self->{'deferrable'} = $arg ? 1 : 0;
	101	}
	102
	103	return defined $self->{'deferrable'} ? $self->{'deferrable'} : 1;
	104	}
	105
	106	# ----------------------------------------------------------------------
	107	sub expression {
	108
	109	=pod
	110
	111	=head2 expression
	112
	113	Gets and set the expression used in a CHECK constraint.
	114
	115	my $expression = $constraint->expression('...');
	116
	117	=cut
	118
	119	my $self = shift;
	120
	121	if ( my $arg = shift ) {
	122	# check arg here?
	123	$self->{'expression'} = $arg;
	124	}
	125
	126	return $self->{'expression'} \|\| '';
	127	}
	128
	129	# ----------------------------------------------------------------------
	130	sub is_valid {
	131
	132	=pod
	133
	134	=head2 is_valid
	135
	136	Determine whether the constraint is valid or not.
	137
	138	my $ok = $constraint->is_valid;
	139
	140	=cut
	141
	142	my $self = shift;
	143	my $type = $self->type or return $self->error('No type');
	144	my $table = $self->table or return $self->error('No table');
	145	my @fields = $self->fields or return $self->error('No fields');
	146	my $table_name = $table->name or return $self->error('No table name');
	147
	148	for my $f ( @fields ) {
	149	next if $table->get_field( $f );
	150	return $self->error(
	151	"Constraint references non-existent field '$f' ",
152	"in table '$table_name'"
153	);
154	}
155
156	my $schema = $table->schema or return $self->error(
157	'Table ', $table->name, ' has no schema object'
158	);
159
160	if ( $type eq FOREIGN_KEY ) {
161	return $self->error('Only one field allowed for foreign key')
162	if scalar @fields > 1;
163
164	my $ref_table_name = $self->reference_table or
165	return $self->error('No reference table');
166
167	my $ref_table = $schema->get_table( $ref_table_name ) or
168	return $self->error("No table named '$ref_table_name' in schema");
169
170	my @ref_fields = $self->reference_fields or return;
171
172	return $self->error('Only one field allowed for foreign key reference')
173	if scalar @ref_fields > 1;
174
175	for my $ref_field ( @ref_fields ) {
176	next if $ref_table->get_field( $ref_field );
177	return $self->error(
178	"Constraint from field(s) ",
179	join(', ', map {qq['$table_name.$_']} @fields),
180	" to non-existent field '$ref_table_name.$ref_field'"
181	);
182	}
183	}
184	elsif ( $type eq CHECK_C ) {
185	return $self->error('No expression for CHECK') unless
186	$self->expression;
187	}
188
189	return 1;
190	}
191
192	# ----------------------------------------------------------------------
3c5de62a	193	sub fields {
	194
	195	=pod
	196
	197	=head2 fields
	198
43b9dc7a	199	Gets and set the fields the constraint is on. Accepts a string, list or
	200	arrayref; returns an array or array reference. Will unique the field
	201	names and keep them in order by the first occurrence of a field name.
	202
ac095e5e	203	The fields are returned as Field objects if they exist or as plain
	204	names if not. (If you just want the names and want to avoid the Field's overload
	205	magic use L<field_names>).
	206
	207	Returns undef or an empty list if the constraint has no fields set.
	208
43b9dc7a	209	$constraint->fields('id');
	210	$constraint->fields('id', 'name');
	211	$constraint->fields( 'id, name' );
	212	$constraint->fields( [ 'id', 'name' ] );
	213	$constraint->fields( qw[ id name ] );
3c5de62a	214
43b9dc7a	215	my @fields = $constraint->fields;
3c5de62a	216
	217	=cut
	218
	219	my $self = shift;
752608d5	220	my $fields = parse_list_arg( @_ );
3c5de62a	221
3c5de62a	222	if ( @$fields ) {
43b9dc7a	223	my ( %unique, @unique );
	224	for my $f ( @$fields ) {
	225	next if $unique{ $f };
	226	$unique{ $f } = 1;
	227	push @unique, $f;
	228	}
	229
	230	$self->{'fields'} = \@unique;
3c5de62a	231	}
3c5de62a	232
53ded04a	233	if ( @{ $self->{'fields'} \|\| [] } ) {
ac095e5e	234	# We have to return fields that don't exist on the table as names in
	235	# case those fields havn't been created yet.
	236	my @ret = map {
	237	$self->table->get_field($_) \|\| $_ } @{ $self->{'fields'} };
	238	return wantarray ? @ret : \@ret;
53ded04a	239	}
	240	else {
	241	return wantarray ? () : undef;
	242	}
3c5de62a	243	}
3c5de62a	244
ebe49790	245	# ----------------------------------------------------------------------
ac095e5e	246	sub field_names {
	247
	248	=head2 field_names
	249
	250	Read-only method to return a list or array ref of the field names. Returns undef
10f70490	251	or an empty list if the constraint has no fields set. Useful if you want to
ac095e5e	252	avoid the overload magic of the Field objects returned by the fields method.
	253
	254	my @names = $constraint->field_names;
	255
	256	=cut
	257
	258	my $self = shift;
4598b71c	259	return wantarray ? @{ $self->{'fields'} \|\| [] } : ($self->{'fields'} \|\| '');
ac095e5e	260	}
ac095e5e	261
3c5de62a	262	# ----------------------------------------------------------------------
752608d5	263	sub match_type {
	264
	265	=pod
	266
	267	=head2 match_type
	268
	269	Get or set the constraint's match_type. Only valid values are "full"
840447a5	270	"partial" and "simple"
752608d5	271
	272	my $match_type = $constraint->match_type('FULL');
	273
	274	=cut
	275
c3b0b535	276	my ( $self, $arg ) = @_;
752608d5	277
c3b0b535	278	if ( $arg ) {
c3b0b535	279	$arg = lc $arg;
752608d5	280	return $self->error("Invalid match type: $arg")
840447a5	281	unless $arg eq 'full' \|\| $arg eq 'partial' \|\| $arg eq 'simple';
752608d5	282	$self->{'match_type'} = $arg;
	283	}
	284
	285	return $self->{'match_type'} \|\| '';
	286	}
	287
	288	# ----------------------------------------------------------------------
3c5de62a	289	sub name {
	290
	291	=pod
	292
	293	=head2 name
	294
	295	Get or set the constraint's name.
	296
	297	my $name = $constraint->name('foo');
	298
	299	=cut
	300
	301	my $self = shift;
695c2da2	302	my $arg = shift \|\| '';
695c2da2	303	$self->{'name'} = $arg if $arg;
3c5de62a	304	return $self->{'name'} \|\| '';
	305	}
	306
	307	# ----------------------------------------------------------------------
dedb8f3b	308	sub options {
	309
	310	=pod
	311
	312	=head2 options
	313
	314	Gets or adds to the constraints's options (e.g., "INITIALLY IMMEDIATE").
	315	Returns an array or array reference.
	316
	317	$constraint->options('NORELY');
	318	my @options = $constraint->options;
	319
	320	=cut
	321
	322	my $self = shift;
	323	my $options = parse_list_arg( @_ );
	324
	325	push @{ $self->{'options'} }, @$options;
	326
	327	if ( ref $self->{'options'} ) {
	328	return wantarray ? @{ $self->{'options'} \|\| [] } : $self->{'options'};
	329	}
	330	else {
	331	return wantarray ? () : [];
	332	}
	333	}
	334
	335
	336	# ----------------------------------------------------------------------
43b9dc7a	337	sub on_delete {
	338
	339	=pod
	340
	341	=head2 on_delete
	342
	343	Get or set the constraint's "on delete" action.
	344
	345	my $action = $constraint->on_delete('cascade');
	346
	347	=cut
	348
	349	my $self = shift;
	350
	351	if ( my $arg = shift ) {
	352	# validate $arg?
	353	$self->{'on_delete'} = $arg;
	354	}
	355
	356	return $self->{'on_delete'} \|\| '';
	357	}
	358
	359	# ----------------------------------------------------------------------
	360	sub on_update {
	361
	362	=pod
	363
	364	=head2 on_update
	365
	366	Get or set the constraint's "on update" action.
	367
	368	my $action = $constraint->on_update('no action');
	369
	370	=cut
	371
	372	my $self = shift;
	373
	374	if ( my $arg = shift ) {
	375	# validate $arg?
	376	$self->{'on_update'} = $arg;
	377	}
	378
	379	return $self->{'on_update'} \|\| '';
	380	}
	381
	382	# ----------------------------------------------------------------------
	383	sub reference_fields {
	384
	385	=pod
	386
	387	=head2 reference_fields
	388
	389	Gets and set the fields in the referred table. Accepts a string, list or
	390	arrayref; returns an array or array reference.
	391
	392	$constraint->reference_fields('id');
	393	$constraint->reference_fields('id', 'name');
	394	$constraint->reference_fields( 'id, name' );
	395	$constraint->reference_fields( [ 'id', 'name' ] );
	396	$constraint->reference_fields( qw[ id name ] );
	397
	398	my @reference_fields = $constraint->reference_fields;
	399
	400	=cut
401
402	my $self = shift;
752608d5	403	my $fields = parse_list_arg( @_ );
43b9dc7a	404
	405	if ( @$fields ) {
	406	$self->{'reference_fields'} = $fields;
	407	}
	408
2d034ab4	409	# Nothing set so try and derive it from the other constraint data
43b9dc7a	410	unless ( ref $self->{'reference_fields'} ) {
2d034ab4	411	my $table = $self->table or return $self->error('No table');
	412	my $schema = $table->schema or return $self->error('No schema');
	413	if ( my $ref_table_name = $self->reference_table ) {
	414	my $ref_table = $schema->get_table( $ref_table_name ) or
	415	return $self->error("Can't find table '$ref_table_name'");
	416
	417	if ( my $constraint = $ref_table->primary_key ) {
	418	$self->{'reference_fields'} = [ $constraint->fields ];
	419	}
	420	else {
	421	$self->error(
	422	'No reference fields defined and cannot find primary key in ',
	423	"reference table '$ref_table_name'"
	424	);
	425	}
43b9dc7a	426	}
2d034ab4	427	# No ref table so we are not that sort of constraint, hence no ref
2d034ab4	428	# fields. So we let the return below return an empty list.
43b9dc7a	429	}
	430
	431	if ( ref $self->{'reference_fields'} ) {
	432	return wantarray
2d034ab4	433	? @{ $self->{'reference_fields'} }
43b9dc7a	434	: $self->{'reference_fields'};
	435	}
	436	else {
	437	return wantarray ? () : [];
	438	}
	439	}
	440
	441	# ----------------------------------------------------------------------
	442	sub reference_table {
	443
	444	=pod
	445
	446	=head2 reference_table
	447
	448	Get or set the table referred to by the constraint.
	449
	450	my $reference_table = $constraint->reference_table('foo');
	451
	452	=cut
	453
	454	my $self = shift;
	455	$self->{'reference_table'} = shift if @_;
	456	return $self->{'reference_table'} \|\| '';
	457	}
	458
3c5de62a	459	# ----------------------------------------------------------------------
43b9dc7a	460	sub table {
3c5de62a	461
	462	=pod
	463
43b9dc7a	464	=head2 table
3c5de62a	465
2d034ab4	466	Get or set the constraint's table object.
3c5de62a	467
43b9dc7a	468	my $table = $field->table;
3c5de62a	469
	470	=cut
	471
	472	my $self = shift;
43b9dc7a	473	if ( my $arg = shift ) {
	474	return $self->error('Not a table object') unless
	475	UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
	476	$self->{'table'} = $arg;
	477	}
	478
	479	return $self->{'table'};
	480	}
	481
	482	# ----------------------------------------------------------------------
dedb8f3b	483	sub type {
43b9dc7a	484
	485	=pod
	486
dedb8f3b	487	=head2 type
43b9dc7a	488
dedb8f3b	489	Get or set the constraint's type.
43b9dc7a	490
dedb8f3b	491	my $type = $constraint->type( PRIMARY_KEY );
43b9dc7a	492
	493	=cut
	494
c3b0b535	495	my ( $self, $type ) = @_;
43b9dc7a	496
c3b0b535	497	if ( $type ) {
c3b0b535	498	$type = uc $type;
dedb8f3b	499	$type =~ s/_/ /g;
dedb8f3b	500	return $self->error("Invalid constraint type: $type")
695c2da2	501	unless $VALID_CONSTRAINT_TYPE{ $type };
dedb8f3b	502	$self->{'type'} = $type;
43b9dc7a	503	}
3c5de62a	504
dedb8f3b	505	return $self->{'type'} \|\| '';
dedb8f3b	506	}
abf315bb	507
	508	# ----------------------------------------------------------------------
	509	sub equals {
	510
	511	=pod
	512
	513	=head2 equals
	514
	515	Determines if this constraint is the same as another
	516
	517	my $isIdentical = $constraint1->equals( $constraint2 );
	518
	519	=cut
	520
	521	my $self = shift;
	522	my $other = shift;
	523	my $case_insensitive = shift;
d990d84b	524	my $ignore_constraint_names = shift;
abf315bb	525
abf315bb	526	return 0 unless $self->SUPER::equals($other);
b8d24485	527	return 0 unless $self->type eq $other->type;
d990d84b	528	unless ($ignore_constraint_names) {
	529	return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
	530	}
abf315bb	531	return 0 unless $self->deferrable eq $other->deferrable;
4598b71c	532	#return 0 unless $self->is_valid eq $other->is_valid;
abf315bb	533	return 0 unless $case_insensitive ? uc($self->table->name) eq uc($other->table->name)
	534	: $self->table->name eq $other->table->name;
	535	return 0 unless $self->expression eq $other->expression;
6a0f3000	536
	537	# Check fields, regardless of order
	538	my %otherFields = (); # create a hash of the other fields
	539	foreach my $otherField ($other->fields) {
	540	$otherField = uc($otherField) if $case_insensitive;
	541	$otherFields{$otherField} = 1;
	542	}
	543	foreach my $selfField ($self->fields) { # check for self fields in hash
	544	$selfField = uc($selfField) if $case_insensitive;
	545	return 0 unless $otherFields{$selfField};
	546	delete $otherFields{$selfField};
	547	}
	548	# Check all other fields were accounted for
	549	return 0 unless keys %otherFields == 0;
	550
	551	# Check reference fields, regardless of order
	552	my %otherRefFields = (); # create a hash of the other reference fields
	553	foreach my $otherRefField ($other->reference_fields) {
	554	$otherRefField = uc($otherRefField) if $case_insensitive;
	555	$otherRefFields{$otherRefField} = 1;
	556	}
	557	foreach my $selfRefField ($self->reference_fields) { # check for self reference fields in hash
	558	$selfRefField = uc($selfRefField) if $case_insensitive;
	559	return 0 unless $otherRefFields{$selfRefField};
	560	delete $otherRefFields{$selfRefField};
	561	}
	562	# Check all other reference fields were accounted for
	563	return 0 unless keys %otherRefFields == 0;
	564
b8d24485	565	return 0 unless $case_insensitive ? uc($self->reference_table) eq uc($other->reference_table) : $self->reference_table eq $other->reference_table;
abf315bb	566	return 0 unless $self->match_type eq $other->match_type;
	567	return 0 unless $self->on_delete eq $other->on_delete;
	568	return 0 unless $self->on_update eq $other->on_update;
4598b71c	569	return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options);
4598b71c	570	return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
abf315bb	571	return 1;
	572	}
	573
752608d5	574	# ----------------------------------------------------------------------
	575	sub DESTROY {
	576	my $self = shift;
	577	undef $self->{'table'}; # destroy cyclical reference
	578	}
	579
3c5de62a	580	1;
	581
	582	# ----------------------------------------------------------------------
	583
	584	=pod
	585
	586	=head1 AUTHOR
	587
c3b0b535	588	Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
3c5de62a	589
3c5de62a	590	=cut