From: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
Date: Tue, 2 Feb 2016 18:15:08 +0000 (+0000)
Subject: Introspect view definitions
X-Git-Tag: 0.07046~8
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class-Schema-Loader.git;a=commitdiff_plain;h=d7e0e0e8e9517098567f1a5637771505476ccbc1

Introspect view definitions

Supported on PostgreSQL, MySQL, Oracle, Firebird, and InterBase.
---

diff --git a/Changes b/Changes
index d89a616..e74b15d 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+        - Introspect view definitions for PostgreSQL, MySQL, Oracle,
+          Firebird, and InterBase.
+
 0.07045  2016-01-22
         - Regenerate tarball without author-mode test dependencies
 
diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 2de8e12..923209c 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -2570,6 +2570,8 @@ sub _table_is_view {
     return 0;
 }
 
+sub _view_definition { undef }
+
 # Set up metadata (cols, pks, etc)
 sub _setup_src_meta {
     my ($self, $table) = @_;
@@ -2580,11 +2582,17 @@ sub _setup_src_meta {
     my $table_class   = $self->classes->{$table->sql_name};
     my $table_moniker = $self->monikers->{$table->sql_name};
 
+    # Must come before ->table
     $self->_dbic_stmt($table_class, 'table_class', 'DBIx::Class::ResultSource::View')
-        if $self->_table_is_view($table);
+        if my $is_view = $self->_table_is_view($table);
 
     $self->_dbic_stmt($table_class, 'table', $table->dbic_name);
 
+    # Must come after ->table
+    if ($is_view and my $view_def = $self->_view_definition($table)) {
+        $self->_dbic_stmt($table_class, 'result_source_instance->view_definition', $view_def);
+    }
+
     my $cols     = $self->_table_columns($table);
     my $col_info = $self->__columns_info_for($table);
 
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/InterBase.pm b/lib/DBIx/Class/Schema/Loader/DBI/InterBase.pm
index 1287f9d..3b5685e 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/InterBase.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/InterBase.pm
@@ -310,6 +310,16 @@ EOF
     return $result;
 }
 
+sub _view_definition {
+    my ($self, $view) = @_;
+
+    return scalar $self->schema->storage->dbh->selectrow_array(<<'EOF', {}, $view->name);
+SELECT rdb$view_source
+FROM rdb$relations
+WHERE rdb$relation_name = ?
+EOF
+}
+
 =head1 SEE ALSO
 
 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm b/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm
index 4a8dafc..fa1d523 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/Oracle.pm
@@ -409,6 +409,16 @@ sub _dbh_column_info {
     return $self->next::method(@_);
 }
 
+sub _view_definition {
+    my ($self, $view) = @_;
+
+    return scalar $self->schema->storage->dbh->selectrow_array(<<'EOF', {}, $view->schema, $view->name);
+SELECT text
+FROM all_views
+WHERE owner = ? AND view_name = ?
+EOF
+}
+
 =head1 SEE ALSO
 
 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm b/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm
index 14ad360..4ef980f 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm
@@ -342,6 +342,22 @@ EOF
     return $result;
 }
 
+sub _view_definition {
+    my ($self, $view) = @_;
+
+    my $def =  $self->schema->storage->dbh->selectrow_array(<<'EOF', {}, $view->schema, $view->name);
+SELECT pg_catalog.pg_get_viewdef(oid)
+FROM pg_catalog.pg_class
+WHERE relnamespace = (SELECT OID FROM pg_catalog.pg_namespace WHERE nspname = ?)
+AND relname = ?
+EOF
+    # The definition is returned as a complete statement including the
+    # trailing semicolon, but that's not allowed in CREATE VIEW, so
+    # strip it out
+    $def =~ s/\s*;\s*\z//;
+    return $def;
+}
+
 =head1 SEE ALSO
 
 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
diff --git a/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm b/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm
index 69d1daf..7d72dda 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm
@@ -363,6 +363,18 @@ sub _column_comment {
     return $comment;
 }
 
+sub _view_definition {
+    my ($self, $view) = @_;
+
+    return scalar $self->schema->storage->dbh->selectrow_array(
+        q{SELECT view_definition
+            FROM information_schema.views
+           WHERE table_schema = schema()
+             AND table_name = ?
+        }, undef, $view->name,
+    );
+}
+
 =head1 SEE ALSO
 
 L<DBIx::Class::Schema::Loader>, L<DBIx::Class::Schema::Loader::Base>,
diff --git a/t/10_01sqlite_common.t b/t/10_01sqlite_common.t
index ff8eb6d..1820e7a 100644
--- a/t/10_01sqlite_common.t
+++ b/t/10_01sqlite_common.t
@@ -173,7 +173,7 @@ my $tester = dbixcsl_common_tests->new(
 
             # test that views are marked as such
             isa_ok $schema->resultset($monikers->{extra_loader_test5})->result_source, 'DBIx::Class::ResultSource::View',
-                'views have table_class set correctly';
+                'view result source';
 
             isnt $schema->resultset($monikers->{extra_loader_test6})->result_source->column_info('id1')->{is_auto_increment}, 1,
                 q{two integer PKs don't get marked autoinc};
diff --git a/t/10_02mysql_common.t b/t/10_02mysql_common.t
index 082ac52..504e60c 100644
--- a/t/10_02mysql_common.t
+++ b/t/10_02mysql_common.t
@@ -205,7 +205,7 @@ dbixcsl_common_tests->new(
         ],
         pre_drop_ddl => [ 'DROP VIEW mysql_loader_test2', ],
         drop => [ 'mysql_loader-test1', 'mysql_loader_test3', 'mysql_loader_test11', 'mysql_loader_test12' ],
-        count => 9 + 30 * 2,
+        count => 10 + 30 * 2,   # regular + multi-schema * 2
         run => sub {
             my ($monikers, $classes);
             ($schema, $monikers, $classes) = @_;
@@ -219,8 +219,13 @@ dbixcsl_common_tests->new(
                 'view introspected successfully';
 
             # test that views are marked as such
-            isa_ok $schema->resultset($monikers->{mysql_loader_test2})->result_source, 'DBIx::Class::ResultSource::View',
-                'views have table_class set correctly';
+            my $view_source = $schema->resultset($monikers->{mysql_loader_test2})->result_source;
+            isa_ok $view_source, 'DBIx::Class::ResultSource::View',
+                'view result source';
+
+            like $view_source->view_definition,
+                qr/\A \s* select \b .* \b from \s+ `.*?` \. `mysql_loader-test1` \s* \z/imsx,
+                'view defintion';
 
             $rsrc = $schema->source('MysqlLoaderTest3');
 
diff --git a/t/10_03pg_common.t b/t/10_03pg_common.t
index 08d83aa..b1ab020 100644
--- a/t/10_03pg_common.t
+++ b/t/10_03pg_common.t
@@ -294,7 +294,7 @@ dbixcsl_common_tests->new(
             'DROP VIEW pg_loader_test11',
         ],
         drop  => [ qw/pg_loader_test1 pg_loader_test2 pg_loader_test9 pg_loader_test10 pg_loader_test12/ ],
-        count => 10 + 30 * 2,
+        count => 11 + 30 * 2,   # regular + multi-schema * 2
         run   => sub {
             my ($schema, $monikers, $classes) = @_;
 
@@ -490,8 +490,13 @@ dbixcsl_common_tests->new(
             }
 
             # test that views are marked as such
-            isa_ok $schema->resultset($monikers->{pg_loader_test11})->result_source, 'DBIx::Class::ResultSource::View',
-                'views have table_class set correctly';
+            my $view_source = $schema->resultset($monikers->{pg_loader_test11})->result_source;
+            isa_ok $view_source, 'DBIx::Class::ResultSource::View',
+                'view result source';
+
+            like $view_source->view_definition,
+                qr/\A \s* select\b .* \bfrom \s+ pg_loader_test1 \s* \z/imsx,
+                'view definition';
 
             is_deeply
                 { $schema->source($monikers->{pg_loader_test12})->unique_constraints },
diff --git a/t/10_05ora_common.t b/t/10_05ora_common.t
index 8f248be..c63f9e3 100644
--- a/t/10_05ora_common.t
+++ b/t/10_05ora_common.t
@@ -192,9 +192,13 @@ dbixcsl_common_tests->new(
             },
             $auto_inc_cb->('oracle_loader_test11', 'id'),
             'alter trigger oracle_loader_test11_id_trg disable',
+            'CREATE VIEW oracle_loader_test12 AS SELECT * FROM oracle_loader_test1',
+        ],
+        pre_drop_ddl => [
+            'DROP VIEW oracle_loader_test12',
         ],
         drop  => [qw/oracle_loader_test1 oracle_loader_test9 oracle_loader_test10 oracle_loader_test11/],
-        count => 10 + 31 * 2,  # basic + cross-schema * 2
+        count => 12 + 31 * 2,  # basic + cross-schema * 2
         run   => sub {
             my ($monikers, $classes);
             ($schema, $monikers, $classes) = @_;
@@ -247,6 +251,14 @@ dbixcsl_common_tests->new(
             ok !$source11->column_info('id')->{is_auto_increment},
                 'Disabled autoinc trigger not loaded';
 
+            my $view_source = $schema->resultset($monikers->{oracle_loader_test12})->result_source;
+            isa_ok $view_source, 'DBIx::Class::ResultSource::View',
+                'view result source';
+
+            like $view_source->view_definition,
+                qr/\A \s* select\b .* \bfrom \s+ oracle_loader_test1 \s* \z/imsx,
+                'view definition';
+
             SKIP: {
                 skip 'Set the DBICTEST_ORA_EXTRAUSER_DSN, _USER and _PASS environment variables to run the cross-schema relationship tests', 31 * 2
                     unless $ENV{DBICTEST_ORA_EXTRAUSER_DSN};
diff --git a/t/10_09firebird_common.t b/t/10_09firebird_common.t
index 47fff42..50b74be 100644
--- a/t/10_09firebird_common.t
+++ b/t/10_09firebird_common.t
@@ -120,7 +120,7 @@ my $tester = dbixcsl_common_tests->new(
                       => { data_type => 'blob sub_type text character set unicode_fss' },
     },
     extra => {
-        count  => 9,
+        count  => 11,
         create => [
             q{
                 CREATE TABLE "Firebird_Loader_Test1" (
@@ -140,8 +140,12 @@ my $tester = dbixcsl_common_tests->new(
                   NEW."Id" = GEN_ID("Gen_Firebird_Loader_Test1_Id",1);
                 END
             },
+            q{
+                CREATE VIEW firebird_loader_test2 AS SELECT * FROM "Firebird_Loader_Test1"
+            },
         ],
         pre_drop_ddl => [
+            'DROP VIEW firebird_loader_test2',
             'DROP TRIGGER "Firebird_Loader_Test1_BI"',
             'DROP GENERATOR "Gen_Firebird_Loader_Test1_Id"',
             'DROP TABLE "Firebird_Loader_Test1"',
@@ -175,6 +179,15 @@ my $tester = dbixcsl_common_tests->new(
 
             is eval { $rsrc->column_info('Foo')->{default_value} }, 42, 'default_value detected for mixed case column';
 
+            # test that views are marked as such
+            my $view_source = $schema->resultset($monikers->{firebird_loader_test2})->result_source;
+            isa_ok $view_source, 'DBIx::Class::ResultSource::View',
+                'view result source';
+
+            like $view_source->view_definition,
+                qr/\A \s* select\b .* \bfrom \s+ (?-i:"Firebird_Loader_Test1") \s* \z/imsx,
+                'view definition';
+
             # test the fixed up ->_dbh_type_info_type_name for the ODBC driver
             if ($schema->storage->_dbi_connect_info->[0] =~ /:ODBC:/i) {
                 my %truncated_types = (