X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FSchema%2FConstraint.pm;h=ee1ae1aa24abdd941708682cb0f04d2097b12ce2;hb=10f704905fedd15d897e8deb6911b6d47b707df1;hp=e8ae2abcda42e1daedba184f7cb60b119d90dbcb;hpb=2d034ab486b874d2d22225626a6d1aaeefcc1626;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Schema/Constraint.pm b/lib/SQL/Translator/Schema/Constraint.pm index e8ae2ab..ee1ae1a 100644 --- a/lib/SQL/Translator/Schema/Constraint.pm +++ b/lib/SQL/Translator/Schema/Constraint.pm @@ -1,9 +1,7 @@ package SQL::Translator::Schema::Constraint; # ---------------------------------------------------------------------- -# $Id: Constraint.pm,v 1.11 2004-02-29 16:05:31 grommit Exp $ -# ---------------------------------------------------------------------- -# Copyright (C) 2002-4 SQLFairy Authors +# 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 @@ -44,14 +42,14 @@ C is the constraint object. =cut use strict; -use Class::Base; use SQL::Translator::Schema::Constants; use SQL::Translator::Utils 'parse_list_arg'; -use base 'Class::Base'; +use base 'SQL::Translator::Schema::Object'; + use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); -$VERSION = sprintf "%d.%02d", q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/; +$VERSION = '1.59'; my %VALID_CONSTRAINT_TYPE = ( PRIMARY_KEY, 1, @@ -62,8 +60,16 @@ my %VALID_CONSTRAINT_TYPE = ( ); # ---------------------------------------------------------------------- -sub init { +__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 @@ -84,19 +90,9 @@ Object constructor. =cut - my ( $self, $config ) = @_; - my @fields = qw[ - table name type fields reference_fields reference_table - match_type on_delete on_update expression - ]; - - for my $arg ( @fields ) { - next unless $config->{ $arg }; - next if ref $config->{ $arg } eq 'ARRAY' && ! @{ $config->{ $arg } }; - defined $self->$arg( $config->{ $arg } ) or return; - } - - return $self; + my $self = shift; + foreach ( values %{$_[0]} ) { $_ = undef if ref($_) eq "ARRAY" && ! @$_; } + $self->SUPER::init(@_); } # ---------------------------------------------------------------------- @@ -222,6 +218,12 @@ 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). + +Returns undef or an empty list if the constraint has no fields set. + $constraint->fields('id'); $constraint->fields('id', 'name'); $constraint->fields( 'id, name' ); @@ -247,7 +249,11 @@ names and keep them in order by the first occurrence of a field name. } if ( @{ $self->{'fields'} || [] } ) { - return wantarray ? @{ $self->{'fields'} } : $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; @@ -255,6 +261,23 @@ names and keep them in order by the first occurrence of a field name. } # ---------------------------------------------------------------------- +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 @@ -262,17 +285,18 @@ sub match_type { =head2 match_type Get or set the constraint's match_type. Only valid values are "full" -or "partial." +"partial" and "simple" my $match_type = $constraint->match_type('FULL'); =cut - my $self = shift; + my ( $self, $arg ) = @_; - if ( my $arg = lc shift ) { + if ( $arg ) { + $arg = lc $arg; return $self->error("Invalid match type: $arg") - unless $arg eq 'full' || $arg eq 'partial'; + unless $arg eq 'full' || $arg eq 'partial' || $arg eq 'simple'; $self->{'match_type'} = $arg; } @@ -486,9 +510,10 @@ Get or set the constraint's type. =cut - my $self = shift; + my ( $self, $type ) = @_; - if ( my $type = uc shift ) { + if ( $type ) { + $type = uc $type; $type =~ s/_/ /g; return $self->error("Invalid constraint type: $type") unless $VALID_CONSTRAINT_TYPE{ $type }; @@ -497,6 +522,73 @@ Get or set the constraint's 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; @@ -511,6 +603,6 @@ sub DESTROY { =head1 AUTHOR -Ken Y. Clark Ekclark@cpan.orgE. +Ken Youens-Clark Ekclark@cpan.orgE. =cut