[svn:dbi] r2318 - in dbi/trunk: . lib/DBD t

[timbo]

Author: timbo
Date: Mon Dec 19 03:27:05 2005
New Revision: 2318

Modified:
   dbi/trunk/Changes
   dbi/trunk/DBI.pm
   dbi/trunk/lib/DBD/ExampleP.pm
   dbi/trunk/t/03handle.t
   dbi/trunk/t/10examp.t
Log:
Fixed $dbh->clone method 'signature' thanks to Jeffrey Klein.
Fixed default ping() method to return false if !$dbh->{Active}.


Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes   (original)
+++ dbi/trunk/Changes   Mon Dec 19 03:27:05 2005
@@ -4,6 +4,11 @@ DBI::Changes - List of significant chang
 
 =cut
 
+=head2 Changes in DBI 1.51 (svn rev XXX),   XXX
+
+  Fixed $dbh->clone method 'signature' thanks to Jeffrey Klein.
+  Fixed default ping() method to return false if !$dbh->{Active}.
+
 =head2 Changes in DBI 1.50 (svn rev 2307),   13 December 2005
 
   Fixed Makefile.PL options for gcc bug introduced in 1.49.

Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm    (original)
+++ dbi/trunk/DBI.pm    Mon Dec 19 03:27:05 2005
@@ -391,7 +391,7 @@ my $keeperr = { O=>0x0004 };
     db => {            # Database Session Class Interface
        data_sources    => { U =>[1,2,'[\%attr]' ], O=>0x0200 },
        take_imp_data   => { U =>[1,1], },
-       clone           => { U =>[1,1,''] },
+       clone           => { U =>[1,2,'[\%attr]'] },
        connected       => { O=>0x0100 },
        begin_work      => { U =>[1,2,'[ \%attr ]'], O=>0x0400 },
        commit          => { U =>[1,1], O=>0x0480|0x0800 },
@@ -1646,8 +1646,11 @@ sub _new_sth {   # called by DBD::<drivern
     }
 
     sub ping {
-       shift->_not_impl('ping');
-       "0 but true";   # special kind of true 0
+       my $dbh = shift;
+       $dbh->_not_impl('ping');
+       # "0 but true" is a special kind of true 0 that is used here so
+       # applications can check if the ping was a real ping or not
+       ($dbh->FETCH('Active')) ?  "0 but true" : 0;
     }
 
     sub begin_work {

Modified: dbi/trunk/lib/DBD/ExampleP.pm
==============================================================================
--- dbi/trunk/lib/DBD/ExampleP.pm       (original)
+++ dbi/trunk/lib/DBD/ExampleP.pm       Mon Dec 19 03:27:05 2005
@@ -200,7 +200,7 @@
 
 
     sub ping {
-       return 2;       # used by t/80proxy.t
+       (shift->FETCH('Active')) ? 2 : 0;    # the value 2 is checked for by 
t/80proxy.t
     }
 
 

Modified: dbi/trunk/t/03handle.t
==============================================================================
--- dbi/trunk/t/03handle.t      (original)
+++ dbi/trunk/t/03handle.t      Mon Dec 19 03:27:05 2005
@@ -2,7 +2,7 @@
 
 use strict;
 
-use Test::More tests => 135;
+use Test::More tests => 137;
 
 ## ----------------------------------------------------------------------------
 ## 03handle.t - tests handles
@@ -180,7 +180,9 @@ do {
        $dbh_nullp->disconnect;
     }
 
+    ok(  $dbh->ping, 'ping should be true before disconnect');
     $dbh->disconnect;
+    ok( !$dbh->ping, 'ping should be false after disconnect');
 
     SKIP: {
         skip "Kids and ActiveKids attributes not supported under 
DBI::PurePerl", 2 if $DBI::PurePerl;

Modified: dbi/trunk/t/10examp.t
==============================================================================
--- dbi/trunk/t/10examp.t       (original)
+++ dbi/trunk/t/10examp.t       Mon Dec 19 03:27:05 2005
@@ -10,9 +10,7 @@ $^W = 1;
 my $haveFileSpec = eval { require File::Spec };
 require VMS::Filespec if $^O eq 'VMS';
 
-# originally 246 tests
-use Test::More tests => 253;
-#use Test::More 'no_plan';
+use Test::More tests => 254;
 
 # "globals"
 my ($r, $dbh);
@@ -717,5 +715,6 @@ ok((%tables == 0));
 
 $dbh->disconnect;
 ok(!$dbh->{Active});
+ok(!$dbh->ping, "ping should return false after disconnect");
 
 1;