Refactor table fetching into a driver-overridable

DBIx::DBSchema::DBD->tables method, patch from Nathan Anderson
<http://1id.com/=nathan.anderson>

diff --git a/Changes b/Changes
index 8d02b37..02ffdcb 100644 (file)
--- a/Changes
+++ b/Changes
@@ -2,6 +2,9 @@ Revision history for Perl module DBIx::DBSchema
 
 0.46 unreleased
     - Add IF EXISTS to DROP INDEX (except under MySQL)
+    - Refactor table fetching into a driver-overridable
+      DBIx::DBSchema::DBD->tables method, patch from Nathan Anderson
+      <http://1id.com/=nathan.anderson>
 
 0.45 Wed May  6 22:17:33 PDT 2015
     - MySQL does not support DEFAULT for TEXT/BLOB columns, closes: CPAN#58505

diff --git a/DBSchema.pm b/DBSchema.pm
index af5cfd0..7ba1921 100644 (file)
--- a/DBSchema.pm
+++ b/DBSchema.pm
@@ -8,7 +8,7 @@ use DBIx::DBSchema::Index;
 use DBIx::DBSchema::Column;
 use DBIx::DBSchema::ForeignKey;
 
-our $VERSION = '0.46_01';
+our $VERSION = '0.46_02';
 $VERSION = eval $VERSION; # modperlstyle: convert the string into a number
 
 our $DEBUG = 0;
@@ -498,16 +498,8 @@ sub pretty_read {
 sub _tables_from_dbh {
   my($dbh) = @_;
   my $driver = _load_driver($dbh);
-  my $db_catalog =
-    scalar(eval "DBIx::DBSchema::DBD::$driver->default_db_catalog");
-  my $db_schema  =
-    scalar(eval "DBIx::DBSchema::DBD::$driver->default_db_schema");
-  my $sth = $dbh->table_info($db_catalog, $db_schema, '', 'TABLE')
-    or die $dbh->errstr;
-  #map { $_->{TABLE_NAME} } grep { $_->{TABLE_TYPE} eq 'TABLE' }
-  #  @{ $sth->fetchall_arrayref({ TABLE_NAME=>1, TABLE_TYPE=>1}) };
-  map { $_->[0] } grep { $_->[1] =~ /^TABLE$/i }
-    @{ $sth->fetchall_arrayref([2,3]) };
+  my $driver_class = "DBIx::DBSchema::DBD::$driver";
+  $driver_class->tables($dbh);
 }
 
 =back
@@ -527,6 +519,9 @@ internal usage of the old API.
 Slaven Rezic <srezic@cpan.org> contributed column and table dropping, Pg
 bugfixes and more.
 
+Nathan Anderson <http://1id.com/=nathan.anderson> contribued updates to the
+SQLite and Sybase drivers.
+
 =head1 CONTRIBUTIONS
 
 Contributions are welcome!  I'm especially keen on any interest in the top
@@ -548,7 +543,7 @@ Or on the web:
 
 Copyright (c) 2000-2007 Ivan Kohler
 Copyright (c) 2000 Mail Abuse Prevention System LLC
-Copyright (c) 2007-2015 Freeside Internet Services, Inc.
+Copyright (c) 2007-2017 Freeside Internet Services, Inc.
 All rights reserved.
 This program is free software; you can redistribute it and/or modify it under
 the same terms as Perl itself.

diff --git a/DBSchema/DBD.pm b/DBSchema/DBD.pm
index 898d0aa..43aaa64 100644 (file)
--- a/DBSchema/DBD.pm
+++ b/DBSchema/DBD.pm
@@ -259,6 +259,21 @@ sub column_value_needs_quoting {
 
 }
 
+sub tables {
+  my ($proto, $dbh, $sth) = @_;
+
+  my $db_catalog = $proto->default_db_catalog;
+  my $db_schema  = $proto->default_db_schema;
+
+  $sth ||= $dbh->table_info($db_catalog, $db_schema, '', 'TABLE')
+    or die $dbh->errstr;
+
+  #map { $_->{TABLE_NAME} } grep { $_->{TABLE_TYPE} eq 'TABLE' }
+  #  @{ $sth->fetchall_arrayref({ TABLE_NAME=>1, TABLE_TYPE=>1}) };
+  map { $_->[0] } grep { $_->[1] =~ /^TABLE$/i }
+    @{ $sth->fetchall_arrayref([2,3]) };
+}
+
 =back
 
 =head1 TYPE MAPPING
@@ -286,7 +301,7 @@ Ivan Kohler <ivan-dbix-dbschema@420.am>
 =head1 COPYRIGHT
 
 Copyright (c) 2000-2005 Ivan Kohler
-Copyright (c) 2007-2013 Freeside Internet Services, Inc.
+Copyright (c) 2007-2017 Freeside Internet Services, Inc.
 All rights reserved.
 This program is free software; you can redistribute it and/or modify it under
 the same terms as Perl itself.

diff --git a/debian/changelog b/debian/changelog
index bbad6ca..da4459d 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+libdbix-dbschema-perl (0.46~02-1) unstable; urgency=medium
+
+  * new upstream (test) release
+
+ -- Ivan Kohler <ivan-debian@420.am>  Sun, 01 Oct 2017 12:00:46 -0700
+
 libdbix-dbschema-perl (0.46~01-1) unstable; urgency=medium
 
   * new upstream (test) release