X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FDBI.pm;h=f0cb40681907d6c8ad4161c09a86586f2f11edc6;hb=afa71a988919e114101e41f0241b08ffc2f436f5;hp=c7bf5534c18c1e257414648c5f0a7ea9e73155f6;hpb=4295c4b477aafd9d66d88134c38805b50adfcc9e;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

diff --git a/lib/DBIx/Class/Schema/Loader/DBI.pm b/lib/DBIx/Class/Schema/Loader/DBI.pm
index c7bf553..f0cb406 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI.pm
@@ -4,17 +4,21 @@ use strict;
 use warnings;
 use base qw/DBIx::Class::Schema::Loader::Base/;
 use mro 'c3';
-use Carp::Clan qw/^DBIx::Class/;
 use Try::Tiny;
+use List::Util 'any';
+use Carp::Clan qw/^DBIx::Class/;
 use namespace::clean;
+use DBIx::Class::Schema::Loader::Table ();
 
-our $VERSION = '0.07010';
+our $VERSION = '0.07048_01';
 
 __PACKAGE__->mk_group_accessors('simple', qw/
     _disable_pk_detection
     _disable_uniq_detection
     _disable_fk_detection
     _passwords
+    quote_char
+    name_sep
 /);
 
 =head1 NAME
@@ -47,45 +51,46 @@ sub new {
     # rebless to vendor-specific class if it exists and loads and we're not in a
     # custom class.
     if (not $self->loader_class) {
-        my $dbh = $self->schema->storage->dbh;
-        my $driver = $dbh->{Driver}->{Name};
+        my $driver = $self->dbh->{Driver}->{Name};
 
         my $subclass = 'DBIx::Class::Schema::Loader::DBI::' . $driver;
-        if ($self->load_optional_class($subclass)) {
-            bless $self, $subclass unless $self->isa($subclass);
+        if ((not $self->isa($subclass)) && $self->load_optional_class($subclass)) {
+            bless $self, $subclass;
             $self->_rebless;
+            Class::C3::reinitialize() if $] < 5.009005;
         }
     }
 
-    # Set up the default quoting character and name seperators
-    $self->{_quoter}  = $self->_build_quoter;
-    $self->{_namesep} = $self->_build_namesep;
-
-    # For our usage as regex matches, concatenating multiple quoter
-    # values works fine (e.g. s/\Q<>\E// if quoter was [ '<', '>' ])
-    if( ref $self->{_quoter} eq 'ARRAY') {
-        $self->{_quoter} = join(q{}, @{$self->{_quoter}});
-    }
+    # Set up the default quoting character and name separators
+    $self->quote_char($self->_build_quote_char);
+    $self->name_sep($self->_build_name_sep);
 
     $self->_setup;
 
-    $self;
+    return $self;
 }
 
-sub _build_quoter {
+sub _build_quote_char {
     my $self = shift;
-    my $dbh = $self->schema->storage->dbh;
-    return $dbh->get_info(29)
-           || $self->schema->storage->sql_maker->quote_char
-           || q{"};
+
+    my $quote_char = $self->dbh->get_info(29)
+        || $self->schema->storage->sql_maker->quote_char
+        || q{"};
+
+    # For our usage as regex matches, concatenating multiple quote_char
+    # values works fine (e.g. s/[\Q<>\E]// if quote_char was [ '<', '>' ])
+    if (ref $quote_char eq 'ARRAY') {
+        $quote_char = join '', @$quote_char;
+    }
+
+    return $quote_char;
 }
 
-sub _build_namesep {
+sub _build_name_sep {
     my $self = shift;
-    my $dbh = $self->schema->storage->dbh;
-    return $dbh->get_info(41)
-           || $self->schema->storage->sql_maker->name_sep
-           || q{.};
+    return $self->dbh->get_info(41)
+        || $self->schema->storage->sql_maker->name_sep
+        || '.';
 }
 
 # Override this in vendor modules to do things at the end of ->new()
@@ -94,55 +99,154 @@ sub _setup { }
 # Override this in vendor module to load a subclass if necessary
 sub _rebless { }
 
-# Returns an array of table names
-sub _tables_list { 
-    my ($self, $opts) = (shift, shift);
+sub _system_schemas {
+    return ('information_schema');
+}
 
-    my ($table, $type) = @_ ? @_ : ('%', '%');
+sub _system_tables {
+    return ();
+}
 
-    my $dbh = $self->schema->storage->dbh;
-    my @tables = $dbh->tables(undef, $self->db_schema, $table, $type);
+sub _dbh_tables {
+    my $self = shift;
+
+    return $self->dbh->tables(undef, @_);
+}
+
+# default to be overridden in subclasses if necessary
+sub _supports_db_schema { 1 }
+
+# Returns an array of table objects
+sub _tables_list {
+    my ($self) = @_;
+
+    my @tables;
+
+    my $qt  = qr/[\Q$self->{quote_char}\E"'`\[\]]/;
+    my $nqt = qr/[^\Q$self->{quote_char}\E"'`\[\]]/;
+    my $ns  = qr/[\Q$self->{name_sep}\E]/;
+    my $nns = qr/[^\Q$self->{name_sep}\E]/;
+
+    foreach my $schema (@{ $self->db_schema || [undef] }) {
+        my @raw_table_names = $self->_dbh_tables($schema);
+
+        TABLE: foreach my $raw_table_name (@raw_table_names) {
+            my $quoted = $raw_table_name =~ /^$qt/;
+
+            # These regexes are not entirely correct, but hopefully they will work
+            # in most cases. RT reports welcome.
+            my ($schema_name, $table_name1, $table_name2) = $quoted ?
+                $raw_table_name =~ /^(?:${qt}(${nqt}+?)${qt}${ns})?(?:${qt}(.+?)${qt}|(${nns}+))\z/
+                :
+                $raw_table_name =~ /^(?:(${nns}+?)${ns})?(?:${qt}(.+?)${qt}|(${nns}+))\z/;
+
+            my $table_name = $table_name1 || $table_name2;
+
+            foreach my $system_schema ($self->_system_schemas) {
+                if ($schema_name) {
+                    my $matches = 0;
+
+                    if (ref $system_schema) {
+                        $matches = 1
+                            if $schema_name =~ $system_schema
+                                && $schema  !~ $system_schema;
+                    }
+                    else {
+                        $matches = 1
+                            if $schema_name eq $system_schema
+                                && $schema  ne $system_schema;
+                    }
+
+                    next TABLE if $matches;
+                }
+            }
+
+            foreach my $system_table ($self->_system_tables) {
+                my $matches = 0;
+
+                if (ref $system_table) {
+                    $matches = 1 if $table_name =~ $system_table;
+                }
+                else {
+                    $matches = 1 if $table_name eq $system_table
+                }
 
-    my $qt = qr/[\Q$self->{_quoter}\E"'`\[\]]/;
+                next TABLE if $matches;
+            }
+
+            $schema_name ||= $schema;
 
-    my $all_tables_quoted = (grep /$qt/, @tables) == @tables;
+            my $table = DBIx::Class::Schema::Loader::Table->new(
+                loader => $self,
+                name   => $table_name,
+                schema => $schema_name,
+                ($self->_supports_db_schema ? () : (
+                    ignore_schema => 1
+                )),
+            );
 
-    if ($self->{_quoter} && $all_tables_quoted) {
-        s/.* $qt (?= .* $qt)//xg for @tables;
-    } else {
-        s/^.*\Q$self->{_namesep}\E// for @tables;
+            push @tables, $table;
+        }
     }
-    s/$qt//g for @tables;
 
-    return $self->_filter_tables(\@tables, $opts);
+    return $self->_filter_tables(\@tables);
+}
+
+sub _recurse_constraint {
+    my ($constraint, @parts) = @_;
+
+    my $name = shift @parts;
+
+    # If there are any parts left, the constraint must be an arrayref
+    croak "depth of constraint/exclude array does not match length of moniker_parts"
+        unless !!@parts == !!(ref $constraint eq 'ARRAY');
+
+    # if ths is the last part, use the constraint directly
+    return $name =~ $constraint unless @parts;
+
+    # recurse into the first matching subconstraint
+    foreach (@{$constraint}) {
+        my ($re, $sub) = @{$_};
+        return _recurse_constraint($sub, @parts)
+            if $name =~ $re;
+    }
+    return 0;
+}
+
+sub _check_constraint {
+    my ($include, $constraint, @tables) = @_;
+
+    return @tables unless defined $constraint;
+
+    return grep { !$include xor _recurse_constraint($constraint, @{$_}) } @tables
+        if ref $constraint eq 'ARRAY';
+
+    return grep { !$include xor /$constraint/ } @tables;
 }
 
+
+
 # apply constraint/exclude and ignore bad tables and views
 sub _filter_tables {
-    my ($self, $tables, $opts) = @_;
+    my ($self, $tables) = @_;
 
     my @tables = @$tables;
     my @filtered_tables;
 
-    $opts ||= {};
-    my $constraint   = $opts->{constraint};
-    my $exclude      = $opts->{exclude};
+    @tables = _check_constraint(1, $self->constraint, @tables);
+    @tables = _check_constraint(0, $self->exclude, @tables);
 
-    @tables = grep { /$constraint/ } @$tables if defined $constraint;
-    @tables = grep { ! /$exclude/  } @$tables if defined $exclude;
-
-    LOOP: for my $table (@tables) {
+    TABLE: for my $table (@tables) {
         try {
             local $^W = 0; # for ADO
             my $sth = $self->_sth_for($table, undef, \'1 = 0');
             $sth->execute;
+            1;
         }
         catch {
             warn "Bad table or view '$table', ignoring: $_\n";
-            $self->_unregister_source_for_table($table);
-            no warnings 'exiting';
-            next LOOP;
-        };
+            0;
+        } or next TABLE;
 
         push @filtered_tables, $table;
     }
@@ -159,31 +263,17 @@ We override L<DBIx::Class::Schema::Loader::Base/load> here to hook in our locali
 sub load {
     my $self = shift;
 
-    local $self->schema->storage->dbh->{RaiseError} = 1;
-    local $self->schema->storage->dbh->{PrintError} = 0;
-    $self->next::method(@_);
-}
-
-sub _table_as_sql {
-    my ($self, $table) = @_;
+    local $self->dbh->{RaiseError} = 1;
+    local $self->dbh->{PrintError} = 0;
 
-    if($self->{db_schema}) {
-        $table = $self->{db_schema} . $self->{_namesep} .
-            $self->_quote_table_name($table);
-    } else {
-        $table = $self->_quote_table_name($table);
-    }
-
-    return $table;
+    $self->next::method(@_);
 }
 
 sub _sth_for {
     my ($self, $table, $fields, $where) = @_;
 
-    my $dbh = $self->schema->storage->dbh;
-
-    my $sth = $dbh->prepare($self->schema->storage->sql_maker
-        ->select(\$self->_table_as_sql($table), $fields, $where));
+    my $sth = $self->dbh->prepare($self->schema->storage->sql_maker
+        ->select(\$table->sql_name, $fields || \'*', $where));
 
     return $sth;
 }
@@ -194,22 +284,22 @@ sub _table_columns {
 
     my $sth = $self->_sth_for($table, undef, \'1 = 0');
     $sth->execute;
-    my $retval = $self->preserve_case ? \@{$sth->{NAME}} : \@{$sth->{NAME_lc}};
+
+    my $retval = [ map $self->_lc($_), @{$sth->{NAME}} ];
+
     $sth->finish;
 
-    $retval;
+    return $retval;
 }
 
 # Returns arrayref of pk col names
-sub _table_pk_info { 
+sub _table_pk_info {
     my ($self, $table) = @_;
 
     return [] if $self->_disable_pk_detection;
 
-    my $dbh = $self->schema->storage->dbh;
-
     my @primary = try {
-        $dbh->primary_key('', $self->db_schema, $table);
+        $self->dbh->primary_key('', $table->schema, $table->name);
     }
     catch {
         warn "Cannot find primary keys for this driver: $_";
@@ -220,7 +310,7 @@ sub _table_pk_info {
     return [] if not @primary;
 
     @primary = map { $self->_lc($_) } @primary;
-    s/\Q$self->{_quoter}\E//g for @primary;
+    s/[\Q$self->{quote_char}\E]//g for @primary;
 
     return \@primary;
 }
@@ -231,48 +321,97 @@ sub _table_uniq_info {
 
     return [] if $self->_disable_uniq_detection;
 
-    my $dbh = $self->schema->storage->dbh;
-
-    if (not $dbh->can('statistics_info')) {
+    if (not $self->dbh->can('statistics_info')) {
         warn "No UNIQUE constraint information can be gathered for this driver";
         $self->_disable_uniq_detection(1);
         return [];
     }
 
     my %indices;
-    my $sth = $dbh->statistics_info(undef, $self->db_schema, $table, 1, 1);
+    my $sth = $self->dbh->statistics_info(undef, $table->schema, $table->name, 1, 1);
     while(my $row = $sth->fetchrow_hashref) {
         # skip table-level stats, conditional indexes, and any index missing
         #  critical fields
         next if $row->{TYPE} eq 'table'
             || defined $row->{FILTER_CONDITION}
             || !$row->{INDEX_NAME}
-            || !defined $row->{ORDINAL_POSITION}
-            || !$row->{COLUMN_NAME};
+            || !defined $row->{ORDINAL_POSITION};
 
-        $indices{$row->{INDEX_NAME}}[$row->{ORDINAL_POSITION}] = $self->_lc($row->{COLUMN_NAME});
+        $indices{$row->{INDEX_NAME}}[$row->{ORDINAL_POSITION}] = $self->_lc($row->{COLUMN_NAME} || '');
     }
     $sth->finish;
 
     my @retval;
-    foreach my $index_name (keys %indices) {
-        my $index = $indices{$index_name};
-        push(@retval, [ $index_name => [ @$index[1..$#$index] ] ]);
+    foreach my $index_name (sort keys %indices) {
+        my (undef, @cols) = @{$indices{$index_name}};
+        # skip indexes with missing column names (e.g. expression indexes)
+        next unless @cols == grep $_, @cols;
+        push(@retval, [ $index_name => \@cols ]);
     }
 
     return \@retval;
 }
 
+sub _table_comment {
+    my ($self, $table) = @_;
+    my $dbh = $self->dbh;
+
+    my $comments_table = $table->clone;
+    $comments_table->name($self->table_comments_table);
+
+    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) ]}
+EOF
+
+    # Failback: try the REMARKS column on table_info
+    if (!$comment) {
+        my $info = $self->_dbh_table_info( $dbh, $table );
+        $comment = $info->{REMARKS} if $info;
+    }
+
+    return $comment;
+}
+
+sub _column_comment {
+    my ($self, $table, $column_number, $column_name) = @_;
+    my $dbh = $self->dbh;
+
+    my $comments_table = $table->clone;
+    $comments_table->name($self->column_comments_table);
+
+    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) ]}
+AND column_name = @{[ $dbh->quote($column_name) ]}
+EOF
+
+    # Failback: try the REMARKS column on column_info
+    if (!$comment && $dbh->can('column_info')) {
+        if (my $sth = try { $self->_dbh_column_info( $dbh, undef, $table->schema, $table->name, $column_name ) }) {
+            my $info = $sth->fetchrow_hashref();
+            $comment = $info->{REMARKS};
+        }
+    }
+
+    return $comment;
+}
+
 # Find relationships
 sub _table_fk_info {
     my ($self, $table) = @_;
 
     return [] if $self->_disable_fk_detection;
 
-    my $dbh = $self->schema->storage->dbh;
     my $sth = try {
-        $dbh->foreign_key_info( '', $self->db_schema, '',
-                                '', $self->db_schema, $table );
+        $self->dbh->foreign_key_info( '', '', '',
+                                '', ($table->schema || ''), $table->name );
     }
     catch {
         warn "Cannot introspect relationships for this driver: $_";
@@ -284,27 +423,76 @@ sub _table_fk_info {
 
     my %rels;
 
+    my @rules = (
+        'CASCADE',
+        'RESTRICT',
+        'SET NULL',
+        'NO ACTION',
+        'SET DEFAULT',
+    );
+
     my $i = 1; # for unnamed rels, which hopefully have only 1 column ...
-    while(my $raw_rel = $sth->fetchrow_arrayref) {
+    REL: while(my $raw_rel = $sth->fetchrow_arrayref) {
+        my $uk_scm  = $raw_rel->[1];
         my $uk_tbl  = $raw_rel->[2];
         my $uk_col  = $self->_lc($raw_rel->[3]);
+        my $fk_scm  = $raw_rel->[5];
         my $fk_col  = $self->_lc($raw_rel->[7]);
+        my $key_seq = $raw_rel->[8] - 1;
         my $relid   = ($raw_rel->[11] || ( "__dcsld__" . $i++ ));
-        $uk_tbl =~ s/\Q$self->{_quoter}\E//g;
-        $uk_col =~ s/\Q$self->{_quoter}\E//g;
-        $fk_col =~ s/\Q$self->{_quoter}\E//g;
-        $relid  =~ s/\Q$self->{_quoter}\E//g;
-        $rels{$relid}->{tbl} = $uk_tbl;
-        $rels{$relid}->{cols}{$uk_col} = $fk_col;
+
+        my $update_rule = $raw_rel->[9];
+        my $delete_rule = $raw_rel->[10];
+
+        $update_rule = $rules[$update_rule] if defined $update_rule;
+        $delete_rule = $rules[$delete_rule] if defined $delete_rule;
+
+        my $is_deferrable = $raw_rel->[13];
+
+        ($is_deferrable = $is_deferrable == 7 ? 0 : 1)
+            if defined $is_deferrable;
+
+        foreach my $var ($uk_scm, $uk_tbl, $uk_col, $fk_scm, $fk_col, $relid) {
+            $var =~ s/[\Q$self->{quote_char}\E]//g if defined $var;
+        }
+
+        if ($self->db_schema && $self->db_schema->[0] ne '%'
+            && (not any { $_ eq $uk_scm } @{ $self->db_schema })) {
+
+            next REL;
+        }
+
+        $rels{$relid}{tbl} ||= DBIx::Class::Schema::Loader::Table->new(
+            loader => $self,
+            name   => $uk_tbl,
+            schema => $uk_scm,
+            ($self->_supports_db_schema ? () : (
+                ignore_schema => 1
+            )),
+        );
+
+        $rels{$relid}{attrs}{on_delete}     = $delete_rule if $delete_rule;
+        $rels{$relid}{attrs}{on_update}     = $update_rule if $update_rule;
+        $rels{$relid}{attrs}{is_deferrable} = $is_deferrable if defined $is_deferrable;
+
+        # Add this data IN ORDER
+        $rels{$relid}{rcols}[$key_seq] = $uk_col;
+        $rels{$relid}{lcols}[$key_seq] = $fk_col;
     }
     $sth->finish;
 
     my @rels;
     foreach my $relid (keys %rels) {
         push(@rels, {
-            remote_columns => [ keys   %{$rels{$relid}->{cols}} ],
-            local_columns  => [ values %{$rels{$relid}->{cols}} ],
+            remote_columns => [ grep defined, @{ $rels{$relid}{rcols} } ],
+            local_columns  => [ grep defined, @{ $rels{$relid}{lcols} } ],
             remote_table   => $rels{$relid}->{tbl},
+            (exists $rels{$relid}{attrs} ?
+                (attrs => $rels{$relid}{attrs})
+                :
+                ()
+            ),
+            _constraint_name => $relid,
         });
     }
 
@@ -318,10 +506,12 @@ sub _columns_info_for {
     my $dbh = $self->schema->storage->dbh;
 
     my %result;
+    my %raw_result;
+
+    if (my $sth = try { $self->_dbh_column_info($dbh, undef, $table->schema, $table->name, '%' ) }) {
+        COL_INFO: while (my $info = try { $sth->fetchrow_hashref } catch { +{} }) {
+            next COL_INFO unless %$info;
 
-    if ($dbh->can('column_info')) {
-        my $sth = $self->_dbh_column_info($dbh, undef, $self->db_schema, $table, '%' );
-        while ( my $info = $sth->fetchrow_hashref() ){
             my $column_info = {};
             $column_info->{data_type}     = lc $info->{TYPE_NAME};
 
@@ -339,18 +529,15 @@ sub _columns_info_for {
             my $col_name = $info->{COLUMN_NAME};
             $col_name =~ s/^\"(.*)\"$/$1/;
 
-            $col_name = $self->_lc($col_name);
-
             my $extra_info = $self->_extra_column_info(
                 $table, $col_name, $column_info, $info
             ) || {};
             $column_info = { %$column_info, %$extra_info };
 
+            $raw_result{$col_name} = $info;
             $result{$col_name} = $column_info;
         }
         $sth->finish;
-
-        return \%result if %result;
     }
 
     my $sth = $self->_sth_for($table, undef, \'1 = 0');
@@ -358,7 +545,9 @@ sub _columns_info_for {
 
     my @columns = @{ $sth->{NAME} };
 
-    for my $i (0 .. $#columns) {
+    COL: for my $i (0 .. $#columns) {
+        next COL if %{ $result{ $columns[$i] }||{} };
+
         my $column_info = {};
         $column_info->{data_type} = lc $sth->{TYPE}[$i];
 
@@ -378,10 +567,10 @@ sub _columns_info_for {
             $column_info->{size}    = $2;
         }
 
-        my $extra_info = $self->_extra_column_info($table, $columns[$i], $column_info) || {};
+        my $extra_info = $self->_extra_column_info($table, $columns[$i], $column_info, $sth) || {};
         $column_info = { %$column_info, %$extra_info };
 
-        $result{ $self->_lc($columns[$i]) } = $column_info;
+        $result{ $columns[$i] } = $column_info;
     }
     $sth->finish;
 
@@ -390,18 +579,75 @@ sub _columns_info_for {
         my $type_num = $colinfo->{data_type};
         my $type_name;
         if (defined $type_num && $type_num =~ /^-?\d+\z/ && $dbh->can('type_info')) {
-            my $type_info = $dbh->type_info($type_num);
-            $type_name = $type_info->{TYPE_NAME} if $type_info;
+            my $type_name = $self->_dbh_type_info_type_name($type_num);
             $colinfo->{data_type} = lc $type_name if $type_name;
         }
     }
 
-    return \%result;
+    # check for instances of the same column name with different case in preserve_case=0 mode
+    if (not $self->preserve_case) {
+        my %lc_colnames;
+
+        foreach my $col (keys %result) {
+            push @{ $lc_colnames{lc $col} }, $col;
+        }
+
+        if (keys %lc_colnames != keys %result) {
+            my @offending_colnames = map @$_, grep @$_ > 1, values %lc_colnames;
+
+            my $offending_colnames = join ", ", map "'$_'", @offending_colnames;
+
+            croak "columns $offending_colnames in table @{[ $table->sql_name ]} collide in preserve_case=0 mode. preserve_case=1 mode required";
+        }
+
+        # apply lowercasing
+        my %lc_result;
+
+        while (my ($col, $info) = each %result) {
+            $lc_result{ $self->_lc($col) } = $info;
+        }
+
+        %result = %lc_result;
+    }
+
+    return wantarray ? (\%result, \%raw_result) : \%result;
+}
+
+# Need to override this for the buggy Firebird ODBC driver.
+sub _dbh_type_info_type_name {
+    my ($self, $type_num) = @_;
+
+    # We wrap it in a try block for MSSQL+DBD::Sybase, which can have issues.
+    # TODO investigate further
+    my $type_info = try { $self->dbh->type_info($type_num) };
+
+    return $type_info ? $type_info->{TYPE_NAME} : undef;
 }
 
 # do not use this, override _columns_info_for instead
 sub _extra_column_info {}
 
+# override to mask warnings if needed
+sub _dbh_table_info {
+    my ($self, $dbh, $table) = (shift, shift, shift);
+
+    return undef if !$dbh->can('table_info');
+    my $sth = $dbh->table_info(undef, $table->schema, $table->name);
+    while (my $info = $sth->fetchrow_hashref) {
+        next if !$self->_table_info_matches($table, $info);
+        return $info;
+    }
+    return undef;
+}
+
+sub _table_info_matches {
+    my ($self, $table, $info) = @_;
+
+    no warnings 'uninitialized';
+    return $info->{TABLE_SCHEM} eq $table->schema
+        && $info->{TABLE_NAME}  eq $table->name;
+}
+
 # override to mask warnings if needed (see mysql)
 sub _dbh_column_info {
     my ($self, $dbh) = (shift, shift);
@@ -426,13 +672,27 @@ sub _try_infer_connect_info_from_coderef {
     return ($dsn, $user, $pass, $params);
 }
 
+sub dbh {
+    my $self = shift;
+
+    return $self->schema->storage->dbh;
+}
+
+sub _table_is_view {
+    my ($self, $table) = @_;
+
+    my $info = $self->_dbh_table_info($self->dbh, $table)
+        or return 0;
+    return $info->{TABLE_TYPE} eq 'VIEW';
+}
+
 =head1 SEE ALSO
 
 L<DBIx::Class::Schema::Loader>
 
-=head1 AUTHOR
+=head1 AUTHORS
 
-See L<DBIx::Class::Schema::Loader/AUTHOR> and L<DBIx::Class::Schema::Loader/CONTRIBUTORS>.
+See L<DBIx::Class::Schema::Loader/AUTHORS>.
 
 =head1 LICENSE