From e7dd1d416aab83e26b2403e6b5e9737ca674703a Mon Sep 17 00:00:00 2001 From: Ivan Kohler Date: Sun, 1 Oct 2017 12:04:54 -0700 Subject: [PATCH] Refactor table fetching into a driver-overridable DBIx::DBSchema::DBD->tables method, patch from Nathan Anderson --- Changes | 3 +++ DBSchema.pm | 19 +++++++------------ DBSchema/DBD.pm | 17 ++++++++++++++++- debian/changelog | 6 ++++++ 4 files changed, 32 insertions(+), 13 deletions(-) diff --git a/Changes b/Changes index 8d02b37..02ffdcb 100644 --- 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 + 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 --- 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 contributed column and table dropping, Pg bugfixes and more. +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 --- 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 =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 --- 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 Sun, 01 Oct 2017 12:00:46 -0700 + libdbix-dbschema-perl (0.46~01-1) unstable; urgency=medium * new upstream (test) release -- 2.11.0