[Bast-commits] r9016 - in DBIx-Class/0.08/trunk: lib/DBIx/Class/Storage/DBI lib/DBIx/Class/Storage/DBI/Oracle t

[caelum at dev.catalyst.perl.org]

Author: caelum
Date: 2010-03-16 21:01:21 +0000 (Tue, 16 Mar 2010)
New Revision: 9016

Modified:
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/InterBase.pm
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/MSSQL.pm
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
   DBIx-Class/0.08/trunk/t/746mssql.t
   DBIx-Class/0.08/trunk/t/74mssql.t
Log:
_ping for MSSQL

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/InterBase.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/InterBase.pm	2010-03-16 15:49:45 UTC (rev 9015)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/InterBase.pm	2010-03-16 21:01:21 UTC (rev 9016)
@@ -206,6 +206,7 @@
   my $dbh = $self->_dbh or return 0;
 
   local $dbh->{RaiseError} = 1;
+  local $dbh->{PrintError} = 0;
 
   eval {
     $dbh->do('select 1 from rdb$database');

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/MSSQL.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/MSSQL.pm	2010-03-16 15:49:45 UTC (rev 9015)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/MSSQL.pm	2010-03-16 21:01:21 UTC (rev 9016)
@@ -263,6 +263,21 @@
   return $self->_sql_maker;
 }
 
+sub _ping {
+  my $self = shift;
+
+  my $dbh = $self->_dbh or return 0;
+
+  local $dbh->{RaiseError} = 1;
+  local $dbh->{PrintError} = 0;
+
+  eval {
+    $dbh->do('select 1');
+  };
+
+  return $@ ? 0 : 1;
+}
+
 1;
 
 =head1 NAME

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm	2010-03-16 15:49:45 UTC (rev 9015)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm	2010-03-16 21:01:21 UTC (rev 9016)
@@ -110,9 +110,10 @@
   my $dbh = $self->_dbh or return 0;
 
   local $dbh->{RaiseError} = 1;
+  local $dbh->{PrintError} = 0;
 
   eval {
-    $dbh->do("select 1 from dual");
+    $dbh->do('select 1 from dual');
   };
 
   return $@ ? 0 : 1;

Modified: DBIx-Class/0.08/trunk/t/746mssql.t
===================================================================
--- DBIx-Class/0.08/trunk/t/746mssql.t	2010-03-16 15:49:45 UTC (rev 9015)
+++ DBIx-Class/0.08/trunk/t/746mssql.t	2010-03-16 21:01:21 UTC (rev 9016)
@@ -33,6 +33,12 @@
   ok (! $schema2->storage->connected, 'a re-connected cloned schema starts unconnected');
 }
 
+$schema->storage->_dbh->disconnect;
+
+lives_ok {
+  $schema->storage->dbh_do(sub { $_[1]->do('select 1') })
+} '_ping works';
+
 $schema->storage->dbh_do (sub {
     my ($storage, $dbh) = @_;
     eval { $dbh->do("DROP TABLE artist") };

Modified: DBIx-Class/0.08/trunk/t/74mssql.t
===================================================================
--- DBIx-Class/0.08/trunk/t/74mssql.t	2010-03-16 15:49:45 UTC (rev 9015)
+++ DBIx-Class/0.08/trunk/t/74mssql.t	2010-03-16 21:01:21 UTC (rev 9016)
@@ -52,14 +52,15 @@
 
   isa_ok($schema->storage, "DBIx::Class::Storage::$storage_type");
 
-# start disconnected to test reconnection
+# start disconnected to test _ping
   $schema->storage->_dbh->disconnect;
 
-  my $dbh;
-  lives_ok (sub {
-    $dbh = $schema->storage->dbh;
-  }, 'reconnect works');
+  lives_ok {
+    $schema->storage->dbh_do(sub { $_[1]->do('select 1') })
+  } '_ping works';
 
+  my $dbh = $schema->storage->dbh;
+
   $dbh->do("IF OBJECT_ID('artist', 'U') IS NOT NULL
       DROP TABLE artist");
   $dbh->do("IF OBJECT_ID('cd', 'U') IS NOT NULL