X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;h=1566fec0ea437cf0c2bc259c774e87b3536d6ed5;hb=d3cd93b9aafcf291b29dc5d2167aab0349d5155e;hp=d9fa57ac85201376663574f81e6df45770c5e237;hpb=fabbd5cca97aaef8e605a783c78abc1eaf9bdbae;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index d9fa57a..1566fec 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -12,9 +12,11 @@ use DBIx::Class::Exception;
 use Scalar::Util qw/refaddr weaken reftype blessed/;
 use List::Util qw/first/;
 use Sub::Name 'subname';
+use Context::Preserve 'preserve_context';
 use Try::Tiny;
 use overload ();
 use Data::Compare (); # no imports!!! guard against insane architecture
+use DBI::Const::GetInfoType (); # no import of retarded global hash
 use namespace::clean;
 
 # default cursor class, overridable in connect_info attributes
@@ -1105,12 +1107,18 @@ sub _server_info {
 }
 
 sub _get_server_version {
-  shift->_dbh_get_info(18);
+  shift->_dbh_get_info('SQL_DBMS_VER');
 }
 
 sub _dbh_get_info {
   my ($self, $info) = @_;
 
+  if ($info =~ /[^0-9]/) {
+    $info = $DBI::Const::GetInfoType::GetInfoType{$info};
+    $self->throw_exception("Info type '$_[1]' not provided by DBI::Const::GetInfoType")
+      unless defined $info;
+  }
+
   return try { $self->_get_dbh->get_info($info) } || undef;
 }
 
@@ -1235,10 +1243,7 @@ sub _connect {
 
   my ($old_connect_via, $dbh);
 
-  if ($INC{'Apache/DBI.pm'} && $ENV{MOD_PERL}) {
-    $old_connect_via = $DBI::connect_via;
-    $DBI::connect_via = 'connect';
-  }
+  local $DBI::connect_via = 'connect' if $INC{'Apache/DBI.pm'} && $ENV{MOD_PERL};
 
   try {
     if(ref $info[0] eq 'CODE') {
@@ -1300,9 +1305,6 @@ sub _connect {
   }
   catch {
     $self->throw_exception("DBI Connection failed: $_")
-  }
-  finally {
-    $DBI::connect_via = $old_connect_via if $old_connect_via;
   };
 
   $self->_dbh_autocommit($dbh->{AutoCommit});
@@ -2748,18 +2750,12 @@ sub deployment_statements {
     data => $schema,
   );
 
-  my @ret;
-  if (wantarray) {
-    @ret = $tr->translate;
-  }
-  else {
-    $ret[0] = $tr->translate;
-  }
-
-  $self->throw_exception( 'Unable to produce deployment statements: ' . $tr->error)
-    unless (@ret && defined $ret[0]);
-
-  return wantarray ? @ret : $ret[0];
+  return preserve_context {
+    $tr->translate
+  } after => sub {
+    $self->throw_exception( 'Unable to produce deployment statements: ' . $tr->error)
+      unless defined $_[0];
+  };
 }
 
 # FIXME deploy() currently does not accurately report sql errors