Introspect view definitions

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

Author: ilmari

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
 

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);
 

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>,

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>,

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>,

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>,

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};

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');
 

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 },

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};