support quoted PostgreSQL schema names with special chars (RT#64766)

diff --git a/Changes b/Changes
index ec8d49f..fb780d2 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,6 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+        - support quoted PostgreSQL schema names with special chars (RT#64766)
         - automatically turn on quoting for MySQL (RT#60469)
         - become utf8-aware (RT#67920)
         - handle duplicate relationship names (RT#64041)

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 79886cc..7a791fa 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -1845,6 +1845,18 @@ sub _make_column_accessor_name {
     return $accessor;
 }
 
+sub _quote {
+    my ($self, $identifier) = @_;
+
+    my $qt = $self->schema->storage->sql_maker->quote_char;
+
+    if (ref $qt) {
+        return $qt->[0] . $identifier . $qt->[1];
+    }
+
+    return "${qt}${identifier}${qt}";
+}
+
 # Set up metadata (cols, pks, etc)
 sub _setup_src_meta {
     my ($self, $table) = @_;
@@ -1856,16 +1868,20 @@ sub _setup_src_meta {
     my $table_moniker = $self->monikers->{$table};
 
     my $table_name = $table;
-    my $name_sep   = $self->schema->storage->sql_maker->name_sep;
+
+    my $sql_maker  = $self->schema->storage->sql_maker;
+    my $name_sep   = $sql_maker->name_sep;
 
     if ($name_sep && $table_name =~ /\Q$name_sep\E/) {
-        $table_name = \ $self->_quote_table_name($table_name);
+        $table_name = \ $self->_quote($table_name);
     }
 
-    my $full_table_name = ($self->qualify_objects ? ($self->db_schema . '.') : '') . (ref $table_name ? $$table_name : $table_name);
+    my $full_table_name = ($self->qualify_objects ?
+        ($self->_quote($self->db_schema) . '.') : '')
+        . (ref $table_name ? $$table_name : $table_name);
 
     # be careful to not create refs Data::Dump can "optimize"
-    $full_table_name    = \do {"".$full_table_name} if ref $table_name;
+    $full_table_name = \do {"".$full_table_name} if ref $table_name;
 
     $self->_dbic_stmt($table_class, 'table', $full_table_name);
 
@@ -2216,20 +2232,6 @@ sub _ext_stmt {
     push(@{$self->{_ext_storage}->{$class}}, $stmt);
 }
 
-sub _quote_table_name {
-    my ($self, $table) = @_;
-
-    my $qt = $self->schema->storage->sql_maker->quote_char;
-
-    return $table unless $qt;
-
-    if (ref $qt) {
-        return $qt->[0] . $table . $qt->[1];
-    }
-
-    return $qt . $table . $qt;
-}
-
 sub _custom_column_info {
     my ( $self, $table_name, $column_name, $column_info ) = @_;
 

diff --git a/lib/DBIx/Class/Schema/Loader/DBI.pm b/lib/DBIx/Class/Schema/Loader/DBI.pm
index a7372eb..0f53430 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/DBI.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI.pm
@@ -108,7 +108,7 @@ sub _tables_list {
     my $all_tables_quoted = (grep /$qt/, @tables) == @tables;
 
     if ($self->{_quoter} && $all_tables_quoted) {
-        s/.* $qt (?= .* $qt)//xg for @tables;
+        s/.* $qt (?= .* $qt\z)//xg for @tables;
     } else {
         s/^.*\Q$self->{_namesep}\E// for @tables;
     }
@@ -167,14 +167,17 @@ sub load {
 sub _table_as_sql {
     my ($self, $table) = @_;
 
-    if($self->{db_schema}) {
-        $table = $self->{db_schema} . $self->{_namesep} .
-            $self->_quote_table_name($table);
-    } else {
-        $table = $self->_quote_table_name($table);
+    my $sql_maker = $self->schema->storage->sql_maker;
+    my $name_sep  = $sql_maker->name_sep;
+    my $db_schema = $self->db_schema;
+
+    if($db_schema) {
+        return $self->_quote($self->{db_schema})
+            . $name_sep
+            . $self->_quote($table);
     }
 
-    return $table;
+    return $self->_quote($table);
 }
 
 sub _sth_for {

diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm b/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm
index bf9f2ae..913e1d1 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm
@@ -47,6 +47,26 @@ sub _setup {
     }
 }
 
+sub _tables_list {
+    my ($self, $opts) = @_;
+
+    my $dbh = $self->schema->storage->dbh;
+    my @tables = $dbh->tables(undef, $self->db_schema, '%', '%');
+
+    my $schema_quoted = $tables[0] =~ /^"/;
+
+    if ($schema_quoted) {
+        s/^"[^"]+"\.// for @tables;
+    }
+    else {
+        s/^[^.]+\.// for @tables;
+    }
+
+    s/^"([^"]+)"\z/$1/ for @tables;
+
+    return $self->_filter_tables(\@tables, $opts);
+}
+
 sub _table_uniq_info {
     my ($self, $table) = @_;
 
@@ -254,7 +274,8 @@ EOF
         }
 
 # process SERIAL columns
-        if (ref($info->{default_value}) eq 'SCALAR' && ${ $info->{default_value} } =~ /\bnextval\(['"]([.\w]+)/i) {
+        if (ref($info->{default_value}) eq 'SCALAR'
+                && ${ $info->{default_value} } =~ /\bnextval\('([^:]+)'/i) {
             $info->{is_auto_increment} = 1;
             $info->{sequence}          = $1;
             delete $info->{default_value};

diff --git a/lib/DBIx/Class/Schema/Loader/Utils.pm b/lib/DBIx/Class/Schema/Loader/Utils.pm
index 22a2194..667caee 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/Utils.pm
+++ b/lib/DBIx/Class/Schema/Loader/Utils.pm
@@ -8,7 +8,7 @@ use Test::More;
 use namespace::clean;
 use Exporter 'import';
 
-our @EXPORT_OK = qw/split_name dumper dumper_squashed eval_package_without_redefine_warnings class_path warnings_exist warnings_exist_silent/;
+our @EXPORT_OK = qw/split_name dumper dumper_squashed eval_package_without_redefine_warnings class_path no_warnings warnings_exist warnings_exist_silent/;
 
 use constant BY_CASE_TRANSITION =>
     qr/(?<=[[:lower:]\d])[\W_]*(?=[[:upper:]])|[\W_]+/;
@@ -84,6 +84,22 @@ sub class_path {
     return $class_path;
 }
 
+sub no_warnings(&;$) {
+    my ($code, $test_name) = @_;
+
+    my $failed = 0;
+
+    my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
+    local $SIG{__WARN__} = sub {
+        $failed = 1;
+        $warn_handler->(@_);
+    };
+
+    $code->();
+
+    ok ((not $failed), $test_name);
+}
+
 sub warnings_exist(&$$) {
     my ($code, $re, $test_name) = @_;
 

diff --git a/t/10_03pg_common.t b/t/10_03pg_common.t
index 894be67..cbf0645 100644 (file)
--- a/t/10_03pg_common.t
+++ b/t/10_03pg_common.t
@@ -1,10 +1,14 @@
 use strict;
 use lib qw(t/lib);
+use DBIx::Class::Schema::Loader 'make_schema_at';
+use DBIx::Class::Schema::Loader::Utils 'no_warnings';
 use dbixcsl_common_tests;
 use Test::More;
+use Test::Exception;
 use File::Slurp 'slurp';
 use utf8;
 use Encode 'decode';
+use Try::Tiny;
 
 my $dsn      = $ENV{DBICTEST_PG_DSN} || '';
 my $user     = $ENV{DBICTEST_PG_USER} || '';
@@ -149,20 +153,54 @@ my $tester = dbixcsl_common_tests->new(
             },
             q{
                 CREATE TABLE pg_loader_test2 (
-                    id SERIAL NOT NULL PRIMARY KEY,
+                    id SERIAL PRIMARY KEY,
                     value VARCHAR(100)
                 )
             },
             q{
                 COMMENT ON TABLE pg_loader_test2 IS 'very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very long comment'
             },
+            q{
+                CREATE SCHEMA "dbicsl-test"
+            },
+            q{
+                CREATE TABLE "dbicsl-test".pg_loader_test3 (
+                    id SERIAL PRIMARY KEY,
+                    value VARCHAR(100)
+                )
+            },
+            q{
+                CREATE TABLE "dbicsl-test".pg_loader_test4 (
+                    id SERIAL PRIMARY KEY,
+                    value VARCHAR(100),
+                    three_id INTEGER UNIQUE REFERENCES "dbicsl-test".pg_loader_test3 (id)
+                )
+            },
+            q{
+                CREATE SCHEMA "dbicsl.test"
+            },
+            q{
+                CREATE TABLE "dbicsl.test".pg_loader_test5 (
+                    id SERIAL PRIMARY KEY,
+                    value VARCHAR(100)
+                )
+            },
+            q{
+                CREATE TABLE "dbicsl.test".pg_loader_test6 (
+                    id SERIAL PRIMARY KEY,
+                    value VARCHAR(100),
+                    five_id INTEGER UNIQUE REFERENCES "dbicsl.test".pg_loader_test5 (id)
+                )
+            },
         ],
         pre_drop_ddl => [
             'DROP SCHEMA dbicsl_test CASCADE',
+            'DROP SCHEMA "dbicsl-test" CASCADE',
+            'DROP SCHEMA "dbicsl.test" CASCADE',
             'DROP TYPE pg_loader_test_enum',
         ],
         drop  => [ qw/ pg_loader_test1 pg_loader_test2 / ],
-        count => 4,
+        count => 24,
         run   => sub {
             my ($schema, $monikers, $classes) = @_;
 
@@ -184,10 +222,113 @@ my $tester = dbixcsl_common_tests->new(
             $class    = $classes->{pg_loader_test2};
             $filename = $schema->_loader->get_dump_filename($class);
 
-            $code = slurp $filename;
+            $code = decode('UTF-8', scalar slurp $filename);
 
             like $code, qr/^=head1 NAME\n\n^$class\n\n=head1 DESCRIPTION\n\n^very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very very long comment\n\n^=cut\n/m,
                 'long table comment is in DESCRIPTION';
+
+            lives_and {
+                no_warnings {
+                    make_schema_at(
+                        'PGSchemaWithDash',
+                        {
+                            naming => 'current',
+                            preserve_case => 1,
+                            db_schema => 'dbicsl-test'
+                        },
+                        [ $dsn, $user, $password, {
+                            on_connect_do  => [ 'SET client_min_messages=WARNING' ],
+                        } ],
+                    );
+                };
+            } 'created dynamic schema for "dbicsl-test" with no warnings';
+
+            my ($rsrc, %uniqs, $rel_info);
+
+            lives_and {
+                ok $rsrc = PGSchemaWithDash->source('PgLoaderTest3');
+            } 'got source for table in schema name with dash';
+
+            is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
+                'column in schema name with dash';
+
+            is try { $rsrc->column_info('value')->{data_type} }, 'varchar',
+                'column in schema name with dash';
+
+            is try { $rsrc->column_info('value')->{size} }, 100,
+                'column in schema name with dash';
+
+            $rel_info = try { $rsrc->relationship_info('pg_loader_test4') };
+
+            is_deeply $rel_info->{cond}, {
+                'foreign.three_id' => 'self.id'
+            }, 'relationship in schema name with dash';
+
+            is $rel_info->{attrs}{accessor}, 'single',
+                'relationship in schema name with dash';
+
+            is $rel_info->{attrs}{join_type}, 'LEFT',
+                'relationship in schema name with dash';
+
+            lives_and {
+                ok $rsrc = PGSchemaWithDash->source('PgLoaderTest4');
+            } 'got source for table in schema name with dash';
+
+            %uniqs = try { $rsrc->unique_constraints };
+
+            is keys %uniqs, 2,
+                'got unique and primary constraint in schema name with dash';
+
+            lives_and {
+                no_warnings {
+                    make_schema_at(
+                        'PGSchemaWithDot',
+                        {
+                            naming => 'current',
+                            preserve_case => 1,
+                            db_schema => 'dbicsl.test'
+                        },
+                        [ $dsn, $user, $password, {
+                            on_connect_do  => [ 'SET client_min_messages=WARNING' ],
+                        } ],
+                    );
+                };
+            } 'created dynamic schema for "dbicsl.test" with no warnings';
+
+            lives_and {
+                ok $rsrc = PGSchemaWithDot->source('PgLoaderTest5');
+            } 'got source for table in schema name with dot';
+
+            is try { $rsrc->column_info('id')->{is_auto_increment} }, 1,
+                'column in schema name with dot introspected correctly';
+
+            is try { $rsrc->column_info('value')->{data_type} }, 'varchar',
+                'column in schema name with dash introspected correctly';
+
+            is try { $rsrc->column_info('value')->{size} }, 100,
+                'column in schema name with dash introspected correctly';
+
+            $rel_info = try { $rsrc->relationship_info('pg_loader_test6') };
+
+            is_deeply $rel_info->{cond}, {
+                'foreign.five_id' => 'self.id'
+            }, 'relationship in schema name with dot';
+
+            is $rel_info->{attrs}{accessor}, 'single',
+                'relationship in schema name with dot';
+
+            is $rel_info->{attrs}{join_type}, 'LEFT',
+                'relationship in schema name with dot';
+
+            lives_and {
+                ok $rsrc = PGSchemaWithDot->source('PgLoaderTest6');
+            } 'got source for table in schema name with dot';
+
+            %uniqs = try { $rsrc->unique_constraints };
+
+            is keys %uniqs, 2,
+                'got unique and primary constraint in schema name with dot';
+
         },
     },
 );

diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm
index 6e86008..0e20c36 100644 (file)
--- a/t/lib/dbixcsl_common_tests.pm
+++ b/t/lib/dbixcsl_common_tests.pm
@@ -26,6 +26,8 @@ rmtree $DUMP_DIR;
 
 use constant RESCAN_WARNINGS => qr/(?i:loader_test|LoaderTest)\d+s? has no primary key|^Dumping manual schema|^Schema dump completed|collides with an inherited method|invalidates \d+ active statement|^Bad table or view/;
 
+use constant SOURCE_DDL => qr/CREATE (?:TABLE|VIEW) (?!"dbicsl[.-]test")/i;
+
 sub new {
     my $class = shift;
 
@@ -150,7 +152,7 @@ sub run_only_extra_tests {
 
         $self->{_created} = 1;
 
-        my $file_count = grep /CREATE (?:TABLE|VIEW)/i, @{ $self->{extra}{create} || [] };
+        my $file_count = grep $_ =~ SOURCE_DDL, @{ $self->{extra}{create} || [] };
         $file_count++; # schema
         
         if (not ($self->{vendor} eq 'mssql' && $dbh->{Driver}{Name} eq 'Sybase')) {
@@ -267,7 +269,8 @@ sub setup_schema {
                 $expected_count++ for @{ $self->{data_type_tests}{table_names} || [] };
             }
 
-            $expected_count += grep /CREATE (?:TABLE|VIEW)/i,
+            # skip schema-qualified tables
+            $expected_count += grep $_ =~ SOURCE_DDL,
                 @{ $self->{extra}{create} || [] };
      
             $expected_count -= grep /CREATE TABLE/, @statements_inline_rels