[Bast-commits] r5965 - in DBIx-Class/0.08/branches/prepare_cached/lib/DBIx/Class: . Storage

[solomon at dev.catalyst.perl.org]

Author: solomon
Date: 2009-04-23 16:39:22 +0100 (Thu, 23 Apr 2009)
New Revision: 5965

Modified:
   DBIx-Class/0.08/branches/prepare_cached/lib/DBIx/Class/ResultSet.pm
   DBIx-Class/0.08/branches/prepare_cached/lib/DBIx/Class/Row.pm
   DBIx-Class/0.08/branches/prepare_cached/lib/DBIx/Class/Storage/DBI.pm
Log:
Prepare_cached now works in theory, with correct backward compat and inheritence, but is not yet tested

Modified: DBIx-Class/0.08/branches/prepare_cached/lib/DBIx/Class/ResultSet.pm
===================================================================
--- DBIx-Class/0.08/branches/prepare_cached/lib/DBIx/Class/ResultSet.pm	2009-04-23 13:10:47 UTC (rev 5964)
+++ DBIx-Class/0.08/branches/prepare_cached/lib/DBIx/Class/ResultSet.pm	2009-04-23 15:39:22 UTC (rev 5965)
@@ -1777,6 +1777,9 @@
     %{ $self->_remove_alias($values, $alias) },
     -source_handle => $self->_source_handle,
     -result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED
+    ( exists $self->{attrs}{prepare_cached}
+        ? (-prepare_cached => $self->{attrs}{prepare_cached})
+        : () ),
   );
 
   return $self->result_class->new(\%new);

Modified: DBIx-Class/0.08/branches/prepare_cached/lib/DBIx/Class/Row.pm
===================================================================
--- DBIx-Class/0.08/branches/prepare_cached/lib/DBIx/Class/Row.pm	2009-04-23 13:10:47 UTC (rev 5964)
+++ DBIx-Class/0.08/branches/prepare_cached/lib/DBIx/Class/Row.pm	2009-04-23 15:39:22 UTC (rev 5965)
@@ -155,8 +155,9 @@
     $new->result_source($source);
   }
 
-  if (my $prepare_cached = delete $attrs->{-prepare_cached}) {
-    $new->prepare_cached($prepare_cached);
+  if (exists $attrs->{-prepare_cached}) {
+    # Force zero or non-zero value so that undef means this wasn't set
+    $new->prepare_cached(delete $attrs->{-prepare_cached} ? 1 : 0);
   }
 
   if (my $related = delete $attrs->{-from_resultset}) {

Modified: DBIx-Class/0.08/branches/prepare_cached/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/prepare_cached/lib/DBIx/Class/Storage/DBI.pm	2009-04-23 13:10:47 UTC (rev 5964)
+++ DBIx-Class/0.08/branches/prepare_cached/lib/DBIx/Class/Storage/DBI.pm	2009-04-23 15:39:22 UTC (rev 5965)
@@ -14,13 +14,14 @@
 
 __PACKAGE__->mk_group_accessors('simple' =>
     qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts
-       _conn_pid _conn_tid transaction_depth _dbh_autocommit savepoints/
+       _conn_pid _conn_tid transaction_depth _dbh_autocommit savepoints
+       prepare_cached disable_sth_caching/
 );
 
 # the values for these accessors are picked out (and deleted) from
 # the attribute hashref passed to connect_info
 my @storage_options = qw/
-  on_connect_do on_disconnect_do disable_sth_caching prepare_cached unsafe auto_savepoint
+  on_connect_do on_disconnect_do unsafe auto_savepoint
 /;
 __PACKAGE__->mk_group_accessors('simple' => @storage_options);
 
@@ -650,8 +651,11 @@
   $self->_sql_maker(undef);
   $self->_sql_maker_opts({});
 
-  $self->prepare_cached(1); # Default prepare_cached to enabled
   if(keys %attrs) {
+    for (grep {exists $attrs{$_}} qw(prepare_cached disable_sth_caching)) {
+      # Force zero or non-zero value so that undef means this wasn't set
+      $self->$_(delete $attrs{$_} ? 1 : 0);
+    }
     $self->$_(delete $attrs{$_})
       for grep {exists $attrs{$_}} (@storage_options, 'cursor_class');   # @storage_options is declared at the top of the module
     $self->_sql_maker_opts->{$_} = delete $attrs{$_}
@@ -1394,8 +1398,8 @@
     };
   }
   my $bind_attrs = {}; ## Future support
-  my $cached = (exists $attrs->{prepare_cached}) ? $attrs->{prepare_cached}
-                                                 : $self->prepare_cached;
+  my $cached = $attrs->{prepare_cached} ? 1 : 0
+    if exists $attrs->{prepare_cached};
   my @args = ('select', $attrs->{bind}, $ident, $bind_attrs, $cached,
               $select, $condition, $order);
   if ($attrs->{software_limit} ||
@@ -1471,6 +1475,10 @@
 
 sub _dbh_sth {
   my ($self, $dbh, $sql, $cached) = @_;
+  $cached = $self->prepare_cached unless defined $cached;
+  $cached = ! $self->disable_sth_caching
+    if defined $self->disable_sth_caching and !defined $cached;
+  $cached = 1 unless defined $cached;
 
   # 3 is the if_active parameter which avoids active sth re-use
   my $sth = $cached ? $dbh->prepare_cached($sql, {}, 3)