From: Stephan Szabo <sszabo@bigpanda.com>
Date: Fri, 31 Mar 2006 17:07:57 +0000 (+0000)
Subject: Added support for unique constraints to SQLT::Parser::DBIx::Class
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7b90bb139d64454ea6ebae5876fcb181988c03c1;p=dbsrgits%2FDBIx-Class-Historic.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'});