experimental support for Pg loader run inside txn

To get this to work, there must not be any database errors thrown. So we
cannot use our usual technique of selecting from nonexistant tables and
throwing away the errors.

To that end, _table_comment and _column_comment in ::Loader::DBI now
check for the tables in $self->_tables before doing a query on them.

jnap added a test to the common tests in a previous commit which I
augment here to be $TODO for DBs other than Pg and to throw away the
usual rescan warnings.

There is also a warning for 'commit ineffective with AutoCommit enabled'
which we also throw away and is more worrisome, and will need further
attention, and is one of the reason this support is marked experimental.
That and this test failing for SQLite as well as some other DBs.

diff --git a/Changes b/Changes
index d9494c5..87cab4f 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+        - *EXPERIMENTAL* support for dumping PostgreSQL schemas inside of a
+          transaction
+
 0.07015  2011-12-09 10:36:17
         - generate many_to_many bridges for targets of link tables
 

diff --git a/lib/DBIx/Class/Schema/Loader.pm b/lib/DBIx/Class/Schema/Loader.pm
index a1fa4eb..6a5d4f6 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader.pm
+++ b/lib/DBIx/Class/Schema/Loader.pm
@@ -560,6 +560,8 @@ gugu: Andrey Kostenko <a.kostenko@rambler-co.ru>
 
 jhannah: Jay Hannah <jay@jays.net>
 
+jnap: John Napiorkowski <jjn1056@yahoo.com>
+
 rbuels: Robert Buels <rmb32@cornell.edu>
 
 timbunce: Tim Bunce <timb@cpan.org>

diff --git a/lib/DBIx/Class/Schema/Loader/DBI.pm b/lib/DBIx/Class/Schema/Loader/DBI.pm
index 17451a0..37ca4d2 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/DBI.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI.pm
@@ -328,7 +328,9 @@ sub _table_comment {
     my $comments_table = $table->clone;
     $comments_table->name($self->table_comments_table);
 
-    my ($comment) = try { $dbh->selectrow_array(<<"EOF") };
+    my ($comment) =
+        (exists $self->_tables->{$comments_table->sql_name} || undef)
+        && try { $dbh->selectrow_array(<<"EOF") };
 SELECT comment_text
 FROM @{[ $comments_table->sql_name ]}
 WHERE table_name = @{[ $dbh->quote($table->name) ]}
@@ -351,7 +353,9 @@ sub _column_comment {
     my $comments_table = $table->clone;
     $comments_table->name($self->column_comments_table);
 
-    my ($comment) = try { $dbh->selectrow_array(<<"EOF") };
+    my ($comment) =
+        (exists $self->_tables->{$comments_table->sql_name} || undef)
+        && try { $dbh->selectrow_array(<<"EOF") };
 SELECT comment_text
 FROM @{[ $comments_table->sql_name ]}
 WHERE table_name = @{[ $dbh->quote($table->name) ]}

diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm
index dcb9b9f..5b04a41 100644 (file)
--- a/t/lib/dbixcsl_common_tests.pm
+++ b/t/lib/dbixcsl_common_tests.pm
@@ -210,6 +210,11 @@ my (@statements, @statements_reltests, @statements_advanced,
     @statements_advanced_sqlite, @statements_inline_rels,
     @statements_implicit_rels);
 
+sub CONSTRAINT {
+    my $self = shift;
+return qr/^(?:\S+\.)?(?:(?:$self->{vendor}|extra)[_-]?)?loader[_-]?test[0-9]+(?!.*_)/i;
+}
+
 sub setup_schema {
     my ($self, $connect_info, $expected_count) = @_;
 
@@ -225,8 +230,7 @@ sub setup_schema {
     }
 
     my %loader_opts = (
-        constraint              =>
-          qr/^(?:\S+\.)?(?:(?:$self->{vendor}|extra)[_-]?)?loader[_-]?test[0-9]+(?!.*_)/i,
+        constraint              => $self->CONSTRAINT,
         result_namespace        => RESULT_NAMESPACE,
         resultset_namespace     => RESULTSET_NAMESPACE,
         schema_base_class       => 'TestSchemaBaseClass',
@@ -1216,24 +1220,40 @@ EOF
     # run extra tests
     $self->{extra}{run}->($conn, $monikers, $classes, $self) if $self->{extra}{run};
 
-    ## Create a SL from existing $dbh
+    ## Create a dump from an existing $dbh in a transaction
+
+TODO: {
+    local $TODO = 'dumping in a txn is experimental and Pg-only right now'
+        unless $self->{vendor} eq 'Pg';
 
     ok eval {
-    my %opts = (
-      naming => { ALL => 'v7'},
-      use_namespaces => 1,
-      debug => $ENV{DBIC_SL_SCHEMA_FROM_DEBUG}||0);
+        my %opts = (
+          naming         => 'current',
+          constraint     => $self->CONSTRAINT,
+          dump_directory => DUMP_DIR,
+          debug          => ($ENV{SCHEMA_LOADER_TESTS_DEBUG}||0)
+        );
 
-    my $guard = $schema_class->txn_scope_guard;
+        my $guard = $conn->txn_scope_guard;
 
-    my $schema_from = DBIx::Class::Schema::Loader::make_schema_at(
-        "TestSchemFromAnother", \%opts, [ sub {$schema_class->storage->dbh} ]);
+        my $warn_handler = $SIG{__WARN__} || sub { warn @_ };
+        local $SIG{__WARN__} = sub {
+            $warn_handler->(@_)
+                unless $_[0] =~ RESCAN_WARNINGS
+                    || $_[0] =~ /commit ineffective with AutoCommit enabled/; # FIXME
+        };
+
+        my $schema_from = DBIx::Class::Schema::Loader::make_schema_at(
+            "TestSchemaFromAnother", \%opts, [ sub { $conn->storage->dbh } ]
+        );
 
-    $guard->commit;
+        $guard->commit;
 
-    1 }, 'Making a schema from another schema inside a transaction worked';
+        1;
+    }, 'Making a schema from another schema inside a transaction worked';
 
-    diag $@ if $@;
+    diag $@ if $@ && (not $TODO);
+}
 
     $self->drop_tables unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP};