account for coderefs partially
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI.pm
index 5a39029..d754a59 100644 (file)
@@ -792,7 +792,7 @@ sub dbh_do {
 
   # short circuit when we know there is no need for a runner
   #
-  # FIXME - asumption may be wrong
+  # FIXME - assumption may be wrong
   # the rationale for the txn_depth check is that if this block is a part
   # of a larger transaction, everything up to that point is screwed anyway
   return $self->$run_target($self->_get_dbh, @_)
@@ -1386,6 +1386,29 @@ sub _connect {
 
   local $DBI::connect_via = 'connect' if $INC{'Apache/DBI.pm'} && $ENV{MOD_PERL};
 
+  # this odd anonymous coderef dereference is in fact really
+  # necessary to avoid the unwanted effect described in perl5
+  # RT#75792
+  #
+  # in addition the coderef itself can't reside inside the try{} block below
+  # as it somehow triggers a leak under perl -d
+  my $dbh_error_handler_installer = sub {
+    weaken (my $weak_self = $_[0]);
+
+    # the coderef is blessed so we can distinguish it from externally
+    # supplied handles (which must be preserved)
+    $_[1]->{HandleError} = bless sub {
+      if ($weak_self) {
+        $weak_self->throw_exception("DBI Exception: $_[0]");
+      }
+      else {
+        # the handler may be invoked by something totally out of
+        # the scope of DBIC
+        DBIx::Class::Exception->throw("DBI Exception (unhandled by DBIC, ::Schema GCed): $_[0]");
+      }
+    }, '__DBIC__DBH__ERROR__HANDLER__';
+  };
+
   try {
     if(ref $info[0] eq 'CODE') {
       $dbh = $info[0]->();
@@ -1429,26 +1452,7 @@ sub _connect {
         $dbh->{RaiseError} = 1;
       }
 
-      # this odd anonymous coderef dereference is in fact really
-      # necessary to avoid the unwanted effect described in perl5
-      # RT#75792
-      sub {
-        my $weak_self = $_[0];
-        weaken $weak_self;
-
-        # the coderef is blessed so we can distinguish it from externally
-        # supplied handles (which must be preserved)
-        $_[1]->{HandleError} = bless sub {
-          if ($weak_self) {
-            $weak_self->throw_exception("DBI Exception: $_[0]");
-          }
-          else {
-            # the handler may be invoked by something totally out of
-            # the scope of DBIC
-            DBIx::Class::Exception->throw("DBI Exception (unhandled by DBIC, ::Schema GCed): $_[0]");
-          }
-        }, '__DBIC__DBH__ERROR__HANDLER__';
-      }->($self, $dbh);
+      $dbh_error_handler_installer->($self, $dbh);
     }
   }
   catch {
@@ -1960,6 +1964,7 @@ sub insert {
 sub insert_bulk {
   my ($self, $source, $cols, $data) = @_;
 
+  use DDP; p $data;
   my @col_range = (0..$#$cols);
 
   # FIXME SUBOPTIMAL - most likely this is not necessary at all
@@ -2330,9 +2335,16 @@ sub _select_args_to_query {
 sub _select_args {
   my ($self, $ident, $select, $where, $orig_attrs) = @_;
 
-  return (
-    'select', @{$orig_attrs->{_sqlmaker_select_args}}
-  ) if $orig_attrs->{_sqlmaker_select_args};
+  # FIXME - that kind of caching would be nice to have
+  # however currently we *may* pass the same $orig_attrs
+  # with different ident/select/where
+  # the whole interface needs to be rethought, since it
+  # was centered around the flawed SQLA API. We can do
+  # soooooo much better now. But that is also another
+  # battle...
+  #return (
+  #  'select', @{$orig_attrs->{_sqlmaker_select_args}}
+  #) if $orig_attrs->{_sqlmaker_select_args};
 
   my $sql_maker = $self->sql_maker;
   my $alias2source = $self->_resolve_ident_sources ($ident);
@@ -2373,8 +2385,8 @@ sub _select_args {
   my ($prefetch_needs_subquery, @limit_args);
 
   if ( $attrs->{_grouped_by_distinct} and $attrs->{collapse} ) {
-    # we already know there is a valid group_by and we know it is intended
-    # to be based *only* on the main result columns
+    # we already know there is a valid group_by (we made it) and we know it is
+    # intended to be based *only* on non-multi stuff
     # short circuit the group_by parsing below
     $prefetch_needs_subquery = 1;
   }
@@ -2392,7 +2404,7 @@ sub _select_args {
     @{$attrs->{group_by}}
       and
     my $grp_aliases = try { # try{} because $attrs->{from} may be unreadable
-      $self->_resolve_aliastypes_from_select_args( $attrs->{from}, undef, undef, { group_by => $attrs->{group_by} } )
+      $self->_resolve_aliastypes_from_select_args({ from => $attrs->{from}, group_by => $attrs->{group_by} })
     }
   ) {
     # no aliases other than our own in group_by
@@ -2406,8 +2418,7 @@ sub _select_args {
   }
 
   if ($prefetch_needs_subquery) {
-    ($ident, $select, $where, $attrs) =
-      $self->_adjust_select_args_for_complex_prefetch ($ident, $select, $where, $attrs);
+    $attrs = $self->_adjust_select_args_for_complex_prefetch ($attrs);
   }
   elsif (! $attrs->{software_limit} ) {
     push @limit_args, (
@@ -2420,17 +2431,17 @@ sub _select_args {
   if (
     ! $prefetch_needs_subquery  # already pruned
       and
-    ref $ident
+    ref $attrs->{from}
       and
-    reftype $ident eq 'ARRAY'
+    reftype $attrs->{from} eq 'ARRAY'
       and
-    @$ident != 1
+    @{$attrs->{from}} != 1
   ) {
-    ($ident, $attrs->{_aliastypes}) = $self->_prune_unused_joins ($ident, $select, $where, $attrs);
+    ($attrs->{from}, $attrs->{_aliastypes}) = $self->_prune_unused_joins ($attrs);
   }
 
 ###
-  # This would be the point to deflate anything found in $where
+  # This would be the point to deflate anything found in $attrs->{where}
   # (and leave $attrs->{bind} intact). Problem is - inflators historically
   # expect a result object. And all we have is a resultsource (it is trivial
   # to extract deflator coderefs via $alias2source above).
@@ -2440,7 +2451,7 @@ sub _select_args {
 ###
 
   return ( 'select', @{ $orig_attrs->{_sqlmaker_select_args} = [
-    $ident, $select, $where, $attrs, @limit_args
+    @{$attrs}{qw(from select where)}, $attrs, @limit_args
   ]} );
 }
 
@@ -2931,7 +2942,7 @@ sub deployment_statements {
     $self->throw_exception("Can't deploy without a ddl_dir or " . DBIx::Class::Optional::Dependencies->req_missing_for ('deploy') );
   }
 
-  # sources needs to be a parser arg, but for simplicty allow at top level
+  # sources needs to be a parser arg, but for simplicity allow at top level
   # coming in
   $sqltargs->{parser_args}{sources} = delete $sqltargs->{sources}
       if exists $sqltargs->{sources};