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

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

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