X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;h=2f9d9a5a3fa09f5334572ffd51db4cefa18dd225;hb=refs%2Fheads%2Fcurrent%2Fdq;hp=9e340f0ff34f9e48d10f1b4a0e47ecaba696a8b2;hpb=85ad63df4eaa9b308b9ca5a3cd1aa20b9f730312;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 9e340f0..2f9d9a5 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -79,20 +79,24 @@ __PACKAGE__->_use_join_optimizer (1);
 sub _determine_supports_join_optimizer { 1 };
 
 # Each of these methods need _determine_driver called before itself
-# in order to function reliably. This is a purely DRY optimization
+# in order to function reliably. We also need to separate accessors
+# from plain old method calls, since an accessor called as a setter
+# does *not* need the driver determination loop fired (and in fact
+# can produce hard to find bugs, like e.g. losing on_connect_*
+# semantics on fresh connections)
 #
-# get_(use)_dbms_capability need to be called on the correct Storage
-# class, as _use_X may be hardcoded class-wide, and _supports_X calls
-# _determine_supports_X which obv. needs a correct driver as well
-my @rdbms_specific_methods = qw/
+# The construct below is simply a parameterized around()
+my $storage_accessor_idx = { map { $_ => 1 } qw(
   sqlt_type
-  deployment_statements
+  datetime_parser_type
 
   sql_maker
   cursor_class
+)};
+for my $meth (keys %$storage_accessor_idx, qw(
+  deployment_statements
 
   build_datetime_parser
-  datetime_parser_type
 
   txn_begin
 
@@ -110,15 +114,13 @@ my @rdbms_specific_methods = qw/
 
   _server_info
   _get_server_version
-/;
-
-for my $meth (@rdbms_specific_methods) {
+)) {
 
   my $orig = __PACKAGE__->can ($meth)
     or die "$meth is not a ::Storage::DBI method!";
 
-  no strict qw/refs/;
-  no warnings qw/redefine/;
+  no strict 'refs';
+  no warnings 'redefine';
   *{__PACKAGE__ ."::$meth"} = subname $meth => sub {
     if (
       # only fire when invoked on an instance, a valid class-based invocation
@@ -129,6 +131,10 @@ for my $meth (@rdbms_specific_methods) {
         and
       ! $_[0]->{_in_determine_driver}
         and
+      # if this is a known *setter* - just set it, no need to connect
+      # and determine the driver
+      ! ( $storage_accessor_idx->{$meth} and @_ > 1 )
+        and
       # Only try to determine stuff if we have *something* that either is or can
       # provide a DSN. Allows for bare $schema's generated with a plain ->connect()
       # to still be marginally useful
@@ -148,6 +154,14 @@ for my $meth (@rdbms_specific_methods) {
   };
 }
 
+sub perl_renderer {
+  my ($self) = @_;
+  $self->{perl_renderer} ||= do {
+    require DBIx::Class::PerlRenderer;
+    DBIx::Class::PerlRenderer->new;
+  };
+}
+
 =head1 NAME
 
 DBIx::Class::Storage::DBI - DBI storage handler
@@ -822,7 +836,7 @@ Example:
 
 sub dbh_do {
   my $self = shift;
-  my $run_target = shift;
+  my $run_target = shift; # either a coderef or a method name
 
   # short circuit when we know there is no need for a runner
   #
@@ -839,10 +853,15 @@ sub dbh_do {
 
   DBIx::Class::Storage::BlockRunner->new(
     storage => $self,
-    run_code => sub { $self->$run_target ($self->_get_dbh, @$args ) },
     wrap_txn => 0,
-    retry_handler => sub { ! ( $_[0]->retried_count or $_[0]->storage->connected ) },
-  )->run;
+    retry_handler => sub {
+      $_[0]->failed_attempt_count == 1
+        and
+      ! $_[0]->storage->connected
+    },
+  )->run(sub {
+    $self->$run_target ($self->_get_dbh, @$args )
+  });
 }
 
 sub txn_do {
@@ -980,8 +999,13 @@ sub _get_dbh {
   return $self->_dbh;
 }
 
+# *DELIBERATELY* not a setter (for the time being)
+# Too intertwined with everything else for any kind of sanity
 sub sql_maker {
-  my ($self) = @_;
+  my $self = shift;
+
+  $self->throw_exception('sql_maker() is not a setter method') if @_;
+
   unless ($self->_sql_maker) {
     my $sql_maker_class = $self->sql_maker_class;
 
@@ -1045,6 +1069,7 @@ sub _populate_dbh {
 
   $self->_dbh(undef); # in case ->connected failed we might get sent here
   $self->_dbh_details({}); # reset everything we know
+  $self->_sql_maker(undef); # this may also end up being different
 
   $self->_dbh($self->_connect);
 
@@ -2402,8 +2427,8 @@ sub _select_args {
   # soooooo much better now. But that is also another
   # battle...
   #return (
-  #  'select', @{$orig_attrs->{_sqlmaker_select_args}}
-  #) if $orig_attrs->{_sqlmaker_select_args};
+  #  'select', $orig_attrs->{!args_as_stored_at_the_end_of_this_method!}
+  #) if $orig_attrs->{!args_as_stored_at_the_end_of_this_method!};
 
   my $sql_maker = $self->sql_maker;
   my $alias2source = $self->_resolve_ident_sources ($ident);
@@ -2499,6 +2524,16 @@ sub _select_args {
     ($attrs->{from}, $attrs->{_aliastypes}) = $self->_prune_unused_joins ($attrs);
   }
 
+  # FIXME this is a gross, inefficient, largely incorrect and fragile hack
+  # during the result inflation stage we *need* to know what was the aliastype
+  # map as sqla saw it when the final pieces of SQL were being assembled
+  # Originally we simply carried around the entirety of $attrs, but this
+  # resulted in resultsets that are being reused growing continuously, as
+  # the hash in question grew deeper and deeper.
+  # Instead hand-pick what to take with us here (we actually don't need much
+  # at this point just the map itself)
+  $orig_attrs->{_last_sqlmaker_alias_map} = $attrs->{_aliastypes};
+
 ###
   # This would be the point to deflate anything found in $attrs->{where}
   # (and leave $attrs->{bind} intact). Problem is - inflators historically
@@ -2509,9 +2544,7 @@ sub _select_args {
   # invoked, and that's just bad...
 ###
 
-  return ( 'select', @{ $orig_attrs->{_sqlmaker_select_args} = [
-    @{$attrs}{qw(from select where)}, $attrs, @limit_args
-  ]} );
+  return ( 'select', @{$attrs}{qw(from select where)}, $attrs, @limit_args );
 }
 
 # Returns a counting SELECT for a simple count