From: Stephan Szabo Date: Fri, 31 Mar 2006 17:07:57 +0000 (+0000) Subject: Added support for unique constraints to SQLT::Parser::DBIx::Class X-Git-Tag: v0.07002~75^2~256 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7b90bb139d64454ea6ebae5876fcb181988c03c1;p=dbsrgits%2FDBIx-Class.git Added support for unique constraints to SQLT::Parser::DBIx::Class along with tests. --- diff --git a/lib/SQL/Translator/Parser/DBIx/Class.pm b/lib/SQL/Translator/Parser/DBIx/Class.pm index 73c0e80..c0fece0 100644 --- a/lib/SQL/Translator/Parser/DBIx/Class.pm +++ b/lib/SQL/Translator/Parser/DBIx/Class.pm @@ -73,6 +73,18 @@ sub parse { } $table->primary_key($source->primary_columns); + my @primary = $source->primary_columns; + my %unique_constraints = $source->unique_constraints; + foreach my $uniq (keys %unique_constraints) { + if (!equal_keys($unique_constraints{$uniq}, \@primary)) { + $table->add_constraint( + type => 'unique', + name => "$uniq", + fields => $unique_constraints{$uniq} + ); + } + } + my @rels = $source->relationships(); foreach my $rel (@rels) { @@ -94,38 +106,9 @@ sub parse { #Decide if this is a foreign key based on whether the self #items are our primary columns. - # Make sure every self key is in the primary key list - my $found; - foreach my $key (@keys) { - $found = 0; - foreach my $prim ($source->primary_columns) { - if ($prim eq $key) { - $found = 1; - last; - } - } - last unless $found; - } - - # Make sure every primary key column is in the self keys - if ($found) { - foreach my $prim ($source->primary_columns) { - $found = 0; - foreach my $key (@keys) { - if ($prim eq $key) { - $found = 1; - last; - } - } - last unless $found; - } - } - - # if $found then the two sets are equal. - # If the sets are different, then we assume it's a foreign key from # us to another table. - if (!$found) { + if (!equal_keys(\@keys, \@primary)) { $table->add_constraint( type => 'foreign_key', name => "fk_$keys[0]", @@ -140,4 +123,42 @@ sub parse { return 1; } +# ------------------------------------------------------------------- +# equal_keys($key1, $key2) +# +# See if the set of keys in $key1 is equal to the set of keys in $key2 +# ------------------------------------------------------------------- +sub equal_keys { + my ($key1, $key2) = @_; + + # Make sure every key1 is in key2 + my $found; + foreach my $key (@$key1) { + $found = 0; + foreach my $prim (@$key2) { + if ($prim eq $key) { + $found = 1; + last; + } + } + last unless $found; + } + + # Make sure every key2 is in key1 + if ($found) { + foreach my $prim (@$key2) { + $found = 0; + foreach my $key (@$key1) { + if ($prim eq $key) { + $found = 1; + last; + } + } + last unless $found; + } + } + + return $found; +} + 1; diff --git a/t/helperrels/26sqlt.t b/t/helperrels/26sqlt.t index 4ea58ec..66eea48 100644 --- a/t/helperrels/26sqlt.t +++ b/t/helperrels/26sqlt.t @@ -8,7 +8,7 @@ plan skip_all => 'SQL::Translator required' if $@; my $schema = DBICTest::Schema; -plan tests => 27; +plan tests => 31; my $translator = SQL::Translator->new( parser_args => { @@ -23,7 +23,7 @@ $translator->producer('SQLite'); my $output = $translator->translate(); -my @constraints = +my @fk_constraints = ( {'display' => 'twokeys->cd', 'selftable' => 'twokeys', 'foreigntable' => 'cd', @@ -79,43 +79,106 @@ my @constraints = 'needed' => 1, on_delete => '', on_update => ''}, ); +my @unique_constraints = ( + {'display' => 'cd artist and title unique', + 'table' => 'cd', 'cols' => ['artist', 'title'], + 'needed' => 1}, + {'display' => 'twokeytreelike name unique', + 'table' => 'twokeytreelike', 'cols' => ['name'], + 'needed' => 1}, +); + my $tschema = $translator->schema(); for my $table ($tschema->get_tables) { my $table_name = $table->name; for my $c ( $table->get_constraints ) { - next unless $c->type eq 'FOREIGN KEY'; - - ok(check($table_name, scalar $c->fields, - $c->reference_table, scalar $c->reference_fields, - $c->on_delete, $c->on_update), "Constraint on $table_name matches an expected constraint"); + if ($c->type eq 'FOREIGN KEY') { + ok(check_fk($table_name, scalar $c->fields, + $c->reference_table, scalar $c->reference_fields, + $c->on_delete, $c->on_update), "Foreign key constraint on $table_name matches an expected constraint"); + } + elsif ($c->type eq 'UNIQUE') { + ok(check_unique($table_name, scalar $c->fields), + "Unique constraint on $table_name matches an expected constraint"); + } } } +# Make sure all the foreign keys are done. my $i; -for ($i = 0; $i <= $#constraints; ++$i) { - ok(!$constraints[$i]->{'needed'}, "Constraint $constraints[$i]->{display}"); +for ($i = 0; $i <= $#fk_constraints; ++$i) { + ok(!$fk_constraints[$i]->{'needed'}, "Constraint $fk_constraints[$i]->{display}"); +} +# Make sure all the uniques are done. +for ($i = 0; $i <= $#unique_constraints; ++$i) { + ok(!$unique_constraints[$i]->{'needed'}, "Constraint $unique_constraints[$i]->{display}"); } -sub check { +sub check_fk { my ($selftable, $selfcol, $foreigntable, $foreigncol, $ondel, $onupd) = @_; $ondel = '' if (!defined($ondel)); $onupd = '' if (!defined($onupd)); my $i; - for ($i = 0; $i <= $#constraints; ++$i) { - if ($selftable eq $constraints[$i]->{'selftable'} && - $foreigntable eq $constraints[$i]->{'foreigntable'} && - ($ondel eq $constraints[$i]->{on_delete}) && - ($onupd eq $constraints[$i]->{on_update})) { + for ($i = 0; $i <= $#fk_constraints; ++$i) { + if ($selftable eq $fk_constraints[$i]->{'selftable'} && + $foreigntable eq $fk_constraints[$i]->{'foreigntable'} && + ($ondel eq $fk_constraints[$i]->{on_delete}) && + ($onupd eq $fk_constraints[$i]->{on_update})) { # check columns my $found = 0; for (my $j = 0; $j <= $#$selfcol; ++$j) { $found = 0; - for (my $k = 0; $k <= $#{$constraints[$i]->{'selfcols'}}; ++$k) { - if ($selfcol->[$j] eq $constraints[$i]->{'selfcols'}->[$k] && - $foreigncol->[$j] eq $constraints[$i]->{'foreigncols'}->[$k]) { + for (my $k = 0; $k <= $#{$fk_constraints[$i]->{'selfcols'}}; ++$k) { + if ($selfcol->[$j] eq $fk_constraints[$i]->{'selfcols'}->[$k] && + $foreigncol->[$j] eq $fk_constraints[$i]->{'foreigncols'}->[$k]) { + $found = 1; + last; + } + } + last unless $found; + } + + if ($found) { + for (my $j = 0; $j <= $#{$fk_constraints[$i]->{'selfcols'}}; ++$j) { + $found = 0; + for (my $k = 0; $k <= $#$selfcol; ++$k) { + if ($selfcol->[$k] eq $fk_constraints[$i]->{'selfcols'}->[$j] && + $foreigncol->[$k] eq $fk_constraints[$i]->{'foreigncols'}->[$j]) { + $found = 1; + last; + } + } + last unless $found; + } + } + + if ($found) { + --$fk_constraints[$i]->{needed}; + return 1; + } + } + } + return 0; +} + +sub check_unique { + my ($selftable, $selfcol) = @_; + + $ondel = '' if (!defined($ondel)); + $onupd = '' if (!defined($onupd)); + + my $i; + for ($i = 0; $i <= $#unique_constraints; ++$i) { + if ($selftable eq $unique_constraints[$i]->{'table'}) { + + my $found = 0; + for (my $j = 0; $j <= $#$selfcol; ++$j) { + $found = 0; + for (my $k = 0; $k <= $#{$unique_constraints[$i]->{'cols'}}; ++$k) { + if ($selfcol->[$j] eq $unique_constraints[$i]->{'cols'}->[$k]) { $found = 1; last; } @@ -124,11 +187,10 @@ sub check { } if ($found) { - for (my $j = 0; $j <= $#{$constraints[$i]->{'selfcols'}}; ++$j) { + for (my $j = 0; $j <= $#{$unique_constraints[$i]->{'cols'}}; ++$j) { $found = 0; for (my $k = 0; $k <= $#$selfcol; ++$k) { - if ($selfcol->[$k] eq $constraints[$i]->{'selfcols'}->[$j] && - $foreigncol->[$k] eq $constraints[$i]->{'foreigncols'}->[$j]) { + if ($selfcol->[$k] eq $unique_constraints[$i]->{'cols'}->[$j]) { $found = 1; last; } @@ -138,7 +200,7 @@ sub check { } if ($found) { - --$constraints[$i]->{needed}; + --$unique_constraints[$i]->{needed}; return 1; } } diff --git a/t/lib/DBICTest/Schema/TwoKeyTreeLike.pm b/t/lib/DBICTest/Schema/TwoKeyTreeLike.pm index 9547baf..c7258e0 100644 --- a/t/lib/DBICTest/Schema/TwoKeyTreeLike.pm +++ b/t/lib/DBICTest/Schema/TwoKeyTreeLike.pm @@ -16,6 +16,7 @@ __PACKAGE__->add_columns( }, ); __PACKAGE__->set_primary_key(qw/id1 id2/); +__PACKAGE__->add_unique_constraint('tktlnameunique' => ['name']); __PACKAGE__->belongs_to('parent', 'TwoKeyTreeLike', { 'foreign.id1' => 'self.parent1', 'foreign.id2' => 'self.parent2'});