The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
Changes 09
MANIFEST 01
lib/DBD/Multi.pm 210
t/get_info.t 025
4 files changed (This is a version diff) 245
@@ -1,3 +1,12 @@
+0.18    2013-04-09
+
+  - Added get_info() patch from Jon Isbell (RT #84240)
+
+0.17    2011-03-08
+
+  - New regression test verifying that previously failed databases are
+    eventually re-tried.  
+
 0.16    2010-09-05
 
   - No longer derived from DBD::File.   Fixes compatability issues with DBI
@@ -23,4 +23,5 @@ t/pod.t
 t/random.t
 t/lazy-load.t
 t/handle-as-coderef.t
+t/get_info.t
 TODO
@@ -1,5 +1,5 @@
 package DBD::Multi;
-# $Id: Multi.pm,v 1.24 2010/09/05 20:28:21 wright Exp $
+# $Id: Multi.pm,v 1.26 2013/04/09 21:57:19 wright Exp $
 use strict;
 
 use DBI;
@@ -7,7 +7,7 @@ DBI->setup_driver('DBD::Multi');
 
 use vars qw[$VERSION $err $errstr $sqlstate $drh];
 
-$VERSION   = '0.16';
+$VERSION   = '0.18';
 
 $err       = 0;        # DBI::err
 $errstr    = "";       # DBI::errstr
@@ -129,6 +129,14 @@ sub rollback {
     return;
 }
 
+sub get_info {
+    my($dbh, $info_type) = @_;
+
+    # return info from current connection
+    my $handler = $dbh->FETCH('_handler');
+    my $_dbh = $handler->dbh;
+    return $_dbh->get_info($info_type);
+}
 
 sub STORE {
     my ($self, $attr, $val) = @_;
@@ -0,0 +1,25 @@
+# vim: ft=perl
+use Test::More 'no_plan';
+use strict;
+$^W = 1;
+
+# Test that two dbs with the same priority are actually randomly selected.
+
+use DBI;
+use DBD::SQLite;
+use DBD::Multi;
+use Data::Dumper;
+use DBI::Const::GetInfoType;
+
+my $dbh_1 = DBI->connect("dbi:SQLite:one.db");
+my $multi = DBI->connect('DBI:Multi:', undef, undef, { dsns => [ 1 => $dbh_1 ] } );
+
+
+foreach my $i ( qw( SQL_DBMS_NAME SQL_DBMS_VER SQL_IDENTIFIER_QUOTE_CHAR SQL_CATALOG_NAME_SEPARATOR SQL_CATALOG_LOCATION ) ) {
+    my $type = $GetInfoType{$i};
+    is ( $dbh_1->get_info($type), $multi->get_info($type), "Compare $i info." );
+}
+
+$multi->disconnect();
+
+unlink "one.db";