From: Peter Rabbitson <ribasushi@cpan.org>
Date: Mon, 17 May 2010 12:15:00 +0000 (+0000)
Subject: Merge 'trunk' into 'try-tiny'
X-Git-Tag: v0.08122~57^2~12
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d5f345d5df35ce5678aacc597a491159b7dce46e;hp=-c;p=dbsrgits%2FDBIx-Class.git

Merge 'trunk' into 'try-tiny'

r9396@Thesaurus (orig r9382):  rabbit | 2010-05-15 17:50:58 +0200
Fix stupid typo-bug
r9397@Thesaurus (orig r9383):  rabbit | 2010-05-15 18:04:59 +0200
Revert erroneous commit (belongs in a branch)
r9402@Thesaurus (orig r9388):  ash | 2010-05-16 12:28:13 +0200
Fix how Schema::Versioned gets connection attributes
r9408@Thesaurus (orig r9394):  caelum | 2010-05-16 19:29:14 +0200
add sql_maker to @rdbms_specific_methods
---

d5f345d5df35ce5678aacc597a491159b7dce46e
diff --combined lib/DBIx/Class/Schema/Versioned.pm
index fe6c694,d192d21..a10e1fd
--- a/lib/DBIx/Class/Schema/Versioned.pm
+++ b/lib/DBIx/Class/Schema/Versioned.pm
@@@ -503,9 -503,8 +503,9 @@@ sub get_db_versio
      my ($self, $rs) = @_;
  
      my $vtable = $self->{vschema}->resultset('Table');
 -    my $version = eval {
 -      $vtable->search({}, { order_by => { -desc => 'installed' }, rows => 1 } )
 +    my $version;
 +    try {
 +      $version = $vtable->search({}, { order_by => { -desc => 'installed' }, rows => 1 } )
                ->get_column ('version')
                 ->next;
      };
@@@ -559,24 -558,25 +559,25 @@@ To avoid the checks on connect, set th
  sub connection {
    my $self = shift;
    $self->next::method(@_);
-   $self->_on_connect($_[3]);
+   $self->_on_connect();
    return $self;
  }
  
  sub _on_connect
  {
-   my ($self, $args) = @_;
+   my ($self) = @_;
  
-   $args = {} unless $args;
+   my $info = $self->storage->connect_info;
+   my $args = $info->[-1];
  
-   $self->{vschema} = DBIx::Class::Version->connect(@{$self->storage->connect_info()});
+   $self->{vschema} = DBIx::Class::Version->connect(@$info);
    my $vtable = $self->{vschema}->resultset('Table');
  
    # useful when connecting from scripts etc
    return if ($args->{ignore_version} || ($ENV{DBIC_NO_VERSION_CHECK} && !exists $args->{ignore_version}));
  
    # check for legacy versions table and move to new if exists
-   my $vschema_compat = DBIx::Class::VersionCompat->connect(@{$self->storage->connect_info()});
+   my $vschema_compat = DBIx::Class::VersionCompat->connect(@$info);
    unless ($self->_source_exists($vtable)) {
      my $vtable_compat = $vschema_compat->resultset('TableCompat');
      if ($self->_source_exists($vtable_compat)) {
@@@ -724,14 -724,10 +725,14 @@@ sub _source_exist
  {
      my ($self, $rs) = @_;
  
 -    my $c = eval {
 -        $rs->search({ 1, 0 })->count;
 +    my $c;
 +    my $exception;
 +    try {
 +        $c = $rs->search({ 1, 0 })->count;
 +    } catch {
 +        $exception=1;
      };
 -    return 0 if $@ || !defined $c;
 +    return 0 if $exception || !defined $c;
  
      return 1;
  }
diff --combined lib/DBIx/Class/Storage/DBI.pm
index 62ade80,09417af..686d0eb
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@@ -15,7 -15,6 +15,7 @@@ use Scalar::Util()
  use List::Util();
  use Data::Dumper::Concise();
  use Sub::Name ();
 +use Try::Tiny;
  
  use File::Path ();
  
@@@ -48,6 -47,7 +48,7 @@@ __PACKAGE__->sql_maker_class('DBIx::Cla
  my @rdbms_specific_methods = qw/
    deployment_statements
    sqlt_type
+   sql_maker
    build_datetime_parser
    datetime_parser_type
  
@@@ -158,7 -158,8 +159,7 @@@ sub DESTROY 
  
    # some databases need this to stop spewing warnings
    if (my $dbh = $self->_dbh) {
 -    local $@;
 -    eval {
 +    try {
        %{ $dbh->{CachedKids} } = ();
        $dbh->disconnect;
      };
@@@ -730,24 -731,22 +731,24 @@@ sub dbh_do 
    my @result;
    my $want_array = wantarray;
  
 -  eval {
 +  my $exception;
 +  my @args = @_;
 +  try {
  
      if($want_array) {
 -        @result = $self->$code($dbh, @_);
 +        @result = $self->$code($dbh, @args);
      }
      elsif(defined $want_array) {
 -        $result[0] = $self->$code($dbh, @_);
 +        $result[0] = $self->$code($dbh, @args);
      }
      else {
 -        $self->$code($dbh, @_);
 +        $self->$code($dbh, @args);
      }
 +  } catch {
 +    $exception = shift;
    };
  
 -  # ->connected might unset $@ - copy
 -  my $exception = $@;
 -  if(!$exception) { return $want_array ? @result : $result[0] }
 +  if(! defined $exception) { return $want_array ? @result : $result[0] }
  
    $self->throw_exception($exception) if $self->connected;
  
@@@ -778,32 -777,30 +779,32 @@@ sub txn_do 
  
    my $tried = 0;
    while(1) {
 -    eval {
 +    my $exception;
 +    my @args = @_;
 +    try {
        $self->_get_dbh;
  
        $self->txn_begin;
        if($want_array) {
 -          @result = $coderef->(@_);
 +          @result = $coderef->(@args);
        }
        elsif(defined $want_array) {
 -          $result[0] = $coderef->(@_);
 +          $result[0] = $coderef->(@args);
        }
        else {
 -          $coderef->(@_);
 +          $coderef->(@args);
        }
        $self->txn_commit;
 +    } catch {
 +      $exception = $_;
      };
  
 -    # ->connected might unset $@ - copy
 -    my $exception = $@;
 -    if(!$exception) { return $want_array ? @result : $result[0] }
 +    if(! defined $exception) { return $want_array ? @result : $result[0] }
  
      if($tried++ || $self->connected) {
 -      eval { $self->txn_rollback };
 -      my $rollback_exception = $@;
 -      if($rollback_exception) {
 +      my $rollback_exception;
 +      try { $self->txn_rollback } catch { $rollback_exception = shift };
 +      if(defined $rollback_exception) {
          my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
          $self->throw_exception($exception)  # propagate nested rollback
            if $rollback_exception =~ /$exception_class/;
@@@ -1018,7 -1015,7 +1019,7 @@@ sub _server_info 
  
      my $server_version = do {
        local $@; # might be happenin in some sort of destructor
 -      eval { $self->_get_server_version };
 +      try { $self->_get_server_version };
      };
  
      if (defined $server_version) {
@@@ -1176,8 -1173,7 +1177,8 @@@ sub _connect 
      $DBI::connect_via = 'connect';
    }
  
 -  eval {
 +  my $caught;
 +  try {
      if(ref $info[0] eq 'CODE') {
         $dbh = $info[0]->();
      }
@@@ -1202,14 -1198,12 +1203,14 @@@
        $dbh->{RaiseError} = 1;
        $dbh->{PrintError} = 0;
      }
 +  } catch {
 +    $caught = 1;
    };
  
    $DBI::connect_via = $old_connect_via if $old_connect_via;
  
    $self->throw_exception("DBI Connection failed: " . ($@||$DBI::errstr))
 -    if !$dbh || $@;
 +    if !$dbh || $caught;
  
    $self->_dbh_autocommit($dbh->{AutoCommit});
  
@@@ -1360,7 -1354,7 +1361,7 @@@ sub _dbh_commit 
  sub txn_rollback {
    my $self = shift;
    my $dbh = $self->_dbh;
 -  eval {
 +  try {
      if ($self->{transaction_depth} == 1) {
        $self->debugobj->txn_rollback()
          if ($self->debug);
@@@ -1378,8 -1372,9 +1379,8 @@@
      else {
        die DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION->new;
      }
 -  };
 -  if ($@) {
 -    my $error = $@;
 +  } catch {
 +    my $error = shift;
      my $exception_class = "DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION";
      $error =~ /$exception_class/ and $self->throw_exception($error);
      # ensure that a failed rollback resets the transaction depth
@@@ -1682,20 -1677,16 +1683,20 @@@ sub _execute_array 
      $placeholder_index++;
    }
  
 -  my $rv = eval {
 -    $self->_dbh_execute_array($sth, $tuple_status, @extra);
 +  my $rv;
 +  my $err;
 +  try {
 +    $rv = $self->_dbh_execute_array($sth, $tuple_status, @extra);
 +  } catch {
 +    $err = shift;
    };
 -  my $err = $@ || $sth->errstr;
 +  $err = defined $err ? $err : ($sth->err ? $sth->errstr : undef );
  
  # Statement must finish even if there was an exception.
 -  eval { $sth->finish };
 -  $err = $@ unless $err;
 +  try { $sth->finish } 
 +  catch { $err = shift unless defined $err };
  
 -  if ($err) {
 +  if (defined $err) {
      my $i = 0;
      ++$i while $i <= $#$tuple_status && !ref $tuple_status->[$i];
  
@@@ -1721,25 -1712,20 +1722,25 @@@ sub _dbh_execute_array 
  sub _dbh_execute_inserts_with_no_binds {
    my ($self, $sth, $count) = @_;
  
 -  eval {
 +  my $exception;
 +  try {
      my $dbh = $self->_get_dbh;
      local $dbh->{RaiseError} = 1;
      local $dbh->{PrintError} = 0;
  
      $sth->execute foreach 1..$count;
 +  } catch {
 +    $exception = shift;
    };
 -  my $exception = $@;
  
  # Make sure statement is finished even if there was an exception.
 -  eval { $sth->finish };
 -  $exception = $@ unless $exception;
 +  try { 
 +    $sth->finish 
 +  } catch {
 +    $exception = shift unless defined $exception;
 +  };
  
 -  $self->throw_exception($exception) if $exception;
 +  $self->throw_exception($exception) if defined $exception;
  
    return $count;
  }
@@@ -2074,8 -2060,7 +2075,8 @@@ sub _dbh_columns_info_for 
  
    if ($dbh->can('column_info')) {
      my %result;
 -    eval {
 +    my $caught;
 +    try {
        my ($schema,$tab) = $table =~ /^(.+?)\.(.+)$/ ? ($1,$2) : (undef,$table);
        my $sth = $dbh->column_info( undef,$schema, $tab, '%' );
        $sth->execute();
@@@ -2090,10 -2075,8 +2091,10 @@@
  
          $result{$col_name} = \%column_info;
        }
 +    } catch {
 +      $caught = 1;
      };
 -    return \%result if !$@ && scalar keys %result;
 +    return \%result if !$caught && scalar keys %result;
    }
  
    my %result;
@@@ -2194,15 -2177,12 +2195,15 @@@ sub _placeholders_supported 
  
    # some drivers provide a $dbh attribute (e.g. Sybase and $dbh->{syb_dynamic_supported})
    # but it is inaccurate more often than not
 -  eval {
 +  my $rc = 1;
 +  try {
      local $dbh->{PrintError} = 0;
      local $dbh->{RaiseError} = 1;
      $dbh->do('select ?', {}, 1);
 +  } catch {
 +    $rc = 0;
    };
 -  return $@ ? 0 : 1;
 +  return $rc;
  }
  
  # Check if placeholders bound to non-string types throw exceptions
@@@ -2211,16 -2191,13 +2212,16 @@@ sub _typeless_placeholders_supported 
    my $self = shift;
    my $dbh  = $self->_get_dbh;
  
 -  eval {
 +  my $rc = 1;
 +  try {
      local $dbh->{PrintError} = 0;
      local $dbh->{RaiseError} = 1;
      # this specifically tests a bind that is NOT a string
      $dbh->do('select 1 where 1 = ?', {}, 1);
 +  } catch {
 +    $rc = 0;
    };
 -  return $@ ? 0 : 1;
 +  return $rc;
  }
  
  =head2 sqlt_type
@@@ -2537,13 -2514,14 +2538,13 @@@ sub deploy 
      return if($line =~ /^COMMIT/m);
      return if $line =~ /^\s+$/; # skip whitespace only
      $self->_query_start($line);
 -    eval {
 +    try {
        # do a dbh_do cycle here, as we need some error checking in
        # place (even though we will ignore errors)
        $self->dbh_do (sub { $_[1]->do($line) });
 -    };
 -    if ($@) {
 +    } catch {
        carp qq{$@ (running "${line}")};
 -    }
 +    };
      $self->_query_end($line);
    };
    my @statements = $schema->deployment_statements($type, undef, $dir, { %{ $sqltargs || {} }, no_comments => 1 } );