X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FSchema%2FConstraint.pm;h=55f869b4399bf53d42e1af79b3d8b74c972e662b;hb=d4f84dd192edc7a64a0b1a9923f1bafc0bc5ef9d;hp=4f01050d6431137bad27d861f145ded9ab865531;hpb=752608d58ac3e31e5870915d64d6d4ed34e1625a;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Schema/Constraint.pm b/lib/SQL/Translator/Schema/Constraint.pm index 4f01050..55f869b 100644 --- a/lib/SQL/Translator/Schema/Constraint.pm +++ b/lib/SQL/Translator/Schema/Constraint.pm @@ -1,9 +1,9 @@ package SQL::Translator::Schema::Constraint; # ---------------------------------------------------------------------- -# $Id: Constraint.pm,v 1.3 2003-05-09 17:06:11 kycl4rk Exp $ +# $Id: Constraint.pm 1440 2009-01-17 16:31:57Z jawnsy $ # ---------------------------------------------------------------------- -# Copyright (C) 2003 Ken Y. Clark +# 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,25 +44,32 @@ 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 vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); +use base 'SQL::Translator::Schema::Object'; -$VERSION = 1.00; +use vars qw($TABLE_COUNT $VIEW_COUNT); -use constant VALID_TYPE => { +my %VALID_CONSTRAINT_TYPE = ( PRIMARY_KEY, 1, UNIQUE, 1, CHECK_C, 1, FOREIGN_KEY, 1, -}; + NOT_NULL, 1, +); # ---------------------------------------------------------------------- -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 @@ -70,31 +77,22 @@ sub init { Object constructor. my $schema = SQL::Translator::Schema::Constraint->new( - table => $table, # the table to which it belongs + table => $table, # 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 + 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_do => 'cascade', # what to do on deletes - on_update_do => '', # what to do on updates + on_delete => 'cascade', # what to do on deletes + on_update => '', # what to do on updates ); =cut - my ( $self, $config ) = @_; - my @fields = qw[ - table name type fields reference_fields reference_table - match_type on_delete on_update - ]; - - for my $arg ( @fields ) { - next unless $config->{ $arg }; - $self->$arg( $config->{ $arg } ) or return; - } - - return $self; + my $self = shift; + foreach ( values %{$_[0]} ) { $_ = undef if ref($_) eq "ARRAY" && ! @$_; } + $self->SUPER::init(@_); } # ---------------------------------------------------------------------- @@ -104,7 +102,7 @@ sub deferrable { =head2 deferrable -Get or set the whether the constraint is deferrable. If not defined, +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: @@ -220,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' ); @@ -244,7 +248,33 @@ names and keep them in order by the first occurrence of a field name. $self->{'fields'} = \@unique; } - return wantarray ? @{ $self->{'fields'} || [] } : $self->{'fields'}; + 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. Usefull 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'} || ''); } # ---------------------------------------------------------------------- @@ -286,11 +316,41 @@ Get or set the constraint's name. =cut my $self = shift; - $self->{'name'} = shift if @_; + 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 @@ -363,28 +423,31 @@ arrayref; returns an array or array reference. $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'); - 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'" - ); + 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'} } : $self->{'reference_fields'}; } else { @@ -410,81 +473,118 @@ Get or set the table referred to by the constraint. return $self->{'reference_table'} || ''; } - # ---------------------------------------------------------------------- -sub type { +sub table { =pod -=head2 type +=head2 table -Get or set the constraint's type. +Get or set the constraint's table object. - my $type = $constraint->type( PRIMARY_KEY ); + my $table = $field->table; =cut my $self = shift; - - if ( my $type = shift ) { - return $self->error("Invalid constraint type: $type") - unless VALID_TYPE->{ $type }; - $self->{'type'} = $type; + if ( my $arg = shift ) { + return $self->error('Not a table object') unless + UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' ); + $self->{'table'} = $arg; } - return $self->{'type'} || ''; + return $self->{'table'}; } - # ---------------------------------------------------------------------- -sub table { +sub type { =pod -=head2 table +=head2 type -Get or set the field's table object. +Get or set the constraint's type. - my $table = $field->table; + my $type = $constraint->type( PRIMARY_KEY ); =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; + + if ( my $type = uc shift ) { + $type =~ s/_/ /g; + return $self->error("Invalid constraint type: $type") + unless $VALID_CONSTRAINT_TYPE{ $type }; + $self->{'type'} = $type; } - return $self->{'table'}; + return $self->{'type'} || ''; } # ---------------------------------------------------------------------- -sub options { +sub equals { =pod -=head2 options +=head2 equals -Gets or adds to the constraints's options (e.g., "INITIALLY IMMEDIATE"). -Returns an array or array reference. +Determines if this constraint is the same as another - $constraint->options('NORELY'); - my @options = $constraint->options; + my $isIdentical = $constraint1->equals( $constraint2 ); =cut - my $self = shift; - my $options = parse_list_arg( @_ ); - - push @{ $self->{'options'} }, @$options; - - if ( ref $self->{'options'} ) { - return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'}; + 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; } - else { - return wantarray ? () : []; + 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; } # ---------------------------------------------------------------------- @@ -501,6 +601,6 @@ sub DESTROY { =head1 AUTHOR -Ken Y. Clark Ekclark@cpan.orgE +Ken Y. Clark Ekclark@cpan.orgE. =cut