strip schema name from ADD CONSTRAINT / CREATE INDEX

* Pg tablenames may have a schema prefix. This leads to invalid ADD CONSTRAINT / CREATE INDEX statments being generated by ->deploy(), since constraint and index names may not have a period in them. This patch strips the schema part from the table name when constructing unique index and constraint names. The fix was taken from ribasushi's email to the mailing list: http://lists.scsys.co.uk/pipermail/dbix-class/2013-February/011141.html
Perl5 · Jul 31, 2014 · 0e14d91 · 0e14d91
1 parent ba0e8d1
commit 0e14d91
Show file tree

Hide file tree

Showing 4 changed files with 31 additions and 2 deletions.
diff --git a/Changes b/Changes
@@ -49,6 +49,8 @@ Revision history for DBIx::Class
           additional codepath (missed in 0.08260)
         - Fix more inconsistencies of the quote_names attribute propagating
           to SQL::Translator (partially RT#87731)
+        - Fix SQLT constraint naming when DBIC table names are fully qualified
+          (PR#48)
         - Fix inability to handle multiple consecutive transactions with
           savepoints on DBD::SQLite < 1.39
         - Fix CDBICompat to match Class::DBI behavior handling non-result

diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
@@ -836,6 +836,7 @@ sub name_unique_constraint {
 
   my $name = $self->name;
   $name = $$name if (ref $name eq 'SCALAR');
+  $name =~ s/ ^ [^\.]+ \. //x;  # strip possible schema qualifier
 
   return join '_', $name, @$cols;
 }

diff --git a/lib/SQL/Translator/Parser/DBIx/Class.pm b/lib/SQL/Translator/Parser/DBIx/Class.pm
@@ -252,9 +252,12 @@ sub parse {
                     $tables{$table_name}{foreign_table_deps}{$rel_table}++;
                   }
 
+                  # trim schema before generating constraint/index names
+                  (my $table_abbrev = $table_name) =~ s/ ^ [^\.]+ \. //x;
+
                   $table->add_constraint(
                     type             => 'foreign_key',
-                    name             => join('_', $table_name, 'fk', @keys),
+                    name             => join('_', $table_abbrev, 'fk', @keys),
                     fields           => \@keys,
                     reference_fields => \@refkeys,
                     reference_table  => $rel_table,
@@ -275,8 +278,9 @@ sub parse {
                   next if join("\x00", @keys) eq join("\x00", @primary);
 
                   if ($add_fk_index_rel) {
+                      (my $idx_name = $table_name) =~ s/ ^ [^\.]+ \. //x;
                       my $index = $table->add_index(
-                          name   => join('_', $table_name, 'idx', @keys),
+                          name   => join('_', $table_abbrev, 'idx', @keys),
                           fields => \@keys,
                           type   => 'NORMAL',
                       );

diff --git a/t/99dbic_sqlt_parser.t b/t/99dbic_sqlt_parser.t
@@ -259,6 +259,28 @@ lives_ok (sub {
   }, 'partial schema tests successful');
 }
 
+{
+  my $cd_rsrc = $schema->source('CD');
+  $cd_rsrc->name(\'main.cd');
+
+  my $sqlt_schema = create_schema(
+    { schema => $schema },
+    args => { ignore_constraint_names => 0, ignore_index_names => 0 }
+  );
+
+  foreach my $source_name (qw(CD)) {
+    my $table = get_table($sqlt_schema, $schema, $source_name);
+    ok(
+      !(grep {$_->name =~ m/main\./} $table->get_indices),
+      'indices have periods stripped out'
+    );
+    ok(
+      !(grep {$_->name =~ m/main\./} $table->get_constraints),
+      'constraints have periods stripped out'
+    );
+  }
+}
+
 done_testing;
 
 sub create_schema {