[Bast-commits] r4206 - in DBIx-Class/0.08/trunk: lib/DBIx/Class/Storage t

[schwern at dev.catalyst.perl.org]

Author: schwern
Date: 2008-03-15 04:55:30 +0000 (Sat, 15 Mar 2008)
New Revision: 4206

Added:
   DBIx-Class/0.08/trunk/t/dbh_do.t
Modified:
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
Log:
Eliminate expensive calls to can() in some very hot portions of the code by
allowing dbh_do() to take a method name.

$obj->$method_name() is about 50% faster then $obj->can($method_name)->().

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm	2008-03-15 03:01:57 UTC (rev 4205)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm	2008-03-15 04:55:30 UTC (rev 4206)
@@ -544,9 +544,10 @@
 
 =head2 dbh_do
 
-Arguments: $subref, @extra_coderef_args?
+Arguments: ($subref | $method_name), @extra_coderef_args?
 
-Execute the given subref using the new exception-based connection management.
+Execute the given $subref or $method_name using the new exception-based
+connection management.
 
 The first two arguments will be the storage object that C<dbh_do> was called
 on and a database handle to use.  Any additional arguments will be passed
@@ -574,12 +575,9 @@
 
 sub dbh_do {
   my $self = shift;
-  my $coderef = shift;
+  my $code = shift;
 
-  ref $coderef eq 'CODE' or $self->throw_exception
-    ('$coderef must be a CODE reference');
-
-  return $coderef->($self, $self->_dbh, @_) if $self->{_in_dbh_do}
+  return $self->$code($self->_dbh, @_) if $self->{_in_dbh_do}
       || $self->{transaction_depth};
 
   local $self->{_in_dbh_do} = 1;
@@ -591,13 +589,13 @@
     $self->_verify_pid if $self->_dbh;
     $self->_populate_dbh if !$self->_dbh;
     if($want_array) {
-        @result = $coderef->($self, $self->_dbh, @_);
+        @result = $self->$code($self->_dbh, @_);
     }
     elsif(defined $want_array) {
-        $result[0] = $coderef->($self, $self->_dbh, @_);
+        $result[0] = $self->$code($self->_dbh, @_);
     }
     else {
-        $coderef->($self, $self->_dbh, @_);
+        $self->$code($self->_dbh, @_);
     }
   };
 
@@ -609,7 +607,7 @@
   # We were not connected - reconnect and retry, but let any
   #  exception fall right through this time
   $self->_populate_dbh;
-  $coderef->($self, $self->_dbh, @_);
+  $self->$code($self->_dbh, @_);
 }
 
 # This is basically a blend of dbh_do above and DBIx::Class::Storage::txn_do.
@@ -763,6 +761,8 @@
   return $self->_sql_maker;
 }
 
+sub _rebless {}
+
 sub _populate_dbh {
   my ($self) = @_;
   my @info = @{$self->_dbi_connect_info || []};
@@ -776,7 +776,7 @@
     my $driver = $self->_dbh->{Driver}->{Name};
     if ($self->load_optional_class("DBIx::Class::Storage::DBI::${driver}")) {
       bless $self, "DBIx::Class::Storage::DBI::${driver}";
-      $self->_rebless() if $self->can('_rebless');
+      $self->_rebless();
     }
   }
 
@@ -1010,7 +1010,7 @@
 
 sub _execute {
     my $self = shift;
-    $self->dbh_do($self->can('_dbh_execute'), @_)
+    $self->dbh_do('_dbh_execute', @_)
 }
 
 sub insert {
@@ -1212,7 +1212,7 @@
 
 sub sth {
   my ($self, $sql) = @_;
-  $self->dbh_do($self->can('_dbh_sth'), $sql);
+  $self->dbh_do('_dbh_sth', $sql);
 }
 
 sub _dbh_columns_info_for {
@@ -1274,7 +1274,7 @@
 
 sub columns_info_for {
   my ($self, $table) = @_;
-  $self->dbh_do($self->can('_dbh_columns_info_for'), $table);
+  $self->dbh_do('_dbh_columns_info_for', $table);
 }
 
 =head2 last_insert_id
@@ -1291,7 +1291,7 @@
 
 sub last_insert_id {
   my $self = shift;
-  $self->dbh_do($self->can('_dbh_last_insert_id'), @_);
+  $self->dbh_do('_dbh_last_insert_id', @_);
 }
 
 =head2 sqlt_type

Added: DBIx-Class/0.08/trunk/t/dbh_do.t
===================================================================
--- DBIx-Class/0.08/trunk/t/dbh_do.t	                        (rev 0)
+++ DBIx-Class/0.08/trunk/t/dbh_do.t	2008-03-15 04:55:30 UTC (rev 4206)
@@ -0,0 +1,33 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;  
+
+use Test::More tests => 8;
+use lib qw(t/lib);
+use DBICTest;
+
+
+my $schema = DBICTest->init_schema();
+my $storage = $schema->storage;
+
+my $test_func = sub {
+    is $_[0], $storage;
+    is $_[1], $storage->dbh;
+    is $_[2], "foo";
+    is $_[3], "bar";
+};
+
+$storage->dbh_do(
+    $test_func,
+    "foo", "bar"
+);
+
+my $storage_class = ref $storage;
+{
+    no strict 'refs';
+    *{$storage_class .'::__test_method'} = $test_func;
+}
+$storage->dbh_do("__test_method", "foo", "bar");
+
+    
\ No newline at end of file