X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=maint%2Fbenchmark_hashrefinflator.pl;h=57610514dedce62d79a499ba139ec97f1f805588;hb=a5b293612996cda25ce7e7bf1a5a5a23249c7b01;hp=d8dd94737e03a911c62db359f318edde7c82fe08;hpb=fa1620994ee0dd9cf8cc1a88c3aaaa9643669d50;p=dbsrgits%2FDBIx-Class.git

diff --git a/maint/benchmark_hashrefinflator.pl b/maint/benchmark_hashrefinflator.pl
index d8dd947..5761051 100755
--- a/maint/benchmark_hashrefinflator.pl
+++ b/maint/benchmark_hashrefinflator.pl
@@ -1,56 +1,45 @@
 #!/usr/bin/perl
 
-use warnings;
-use strict;
-
-use FindBin;
-
 #
 # So you wrote a new mk_hash implementation which passed all tests (particularly 
 # t/68inflate_resultclass_hashrefinflator) and would like to see how it holds up 
-# against older versions of the same. Just add your subroutine somewhere below and
-# add its name to the @bench array. Happy testing.
-
-my @bench = qw/current_mk_hash old_mk_hash/;
+# against older versions of the same. Just add your coderef to the HRI::Bench 
+# namespace and add a name/ref pair to the %bench_list hash. Happy testing.
 
-use Benchmark qw/timethis cmpthese/;
-
-use lib ("$FindBin::Bin/../lib", "$FindBin::Bin/../t/lib");
-use DBICTest;
-use DBIx::Class::ResultClass::HashRefInflator;
-
-chdir ("$FindBin::Bin/..");
-my $schema = DBICTest->init_schema();
-
-my $test_sub = sub {
-    my $rs_hashrefinf = $schema->resultset ('Artist')->search ({}, {
-        prefetch => { cds => 'tracks' },
-    });
-    $rs_hashrefinf->result_class('DBIx::Class::ResultClass::HashRefInflator');
-    my @stuff = $rs_hashrefinf->all;
-};
+package DBIx::Class::ResultClass::HashRefInflator::Bench;
 
+use warnings;
+use strict;
 
-my $results;
-for my $b (@bench) {
-    die "No such subroutine '$b' defined!\n" if not __PACKAGE__->can ($b);
-    print "Timing $b... ";
+my $current_mk_hash;
+$current_mk_hash = sub {
+    if (ref $_[0] eq 'ARRAY') {     # multi relationship 
+        return [ map { $current_mk_hash->(@$_) || () } (@_) ];
+    }
+    else {
+        my $hash = {
+            # the main hash could be an undef if we are processing a skipped-over join 
+            $_[0] ? %{$_[0]} : (),
 
-    # switch the inflator
-    no warnings qw/redefine/;
-    no strict qw/refs/;
-    local *DBIx::Class::ResultClass::HashRefInflator::mk_hash = \&$b;
+            # the second arg is a hash of arrays for each prefetched relation 
+            map
+                { $_ => $current_mk_hash->( @{$_[1]->{$_}} ) }
+                ( $_[1] ? (keys %{$_[1]}) : () )
+        };
 
-    $results->{$b} = timethis (-2, $test_sub);
-}
-cmpthese ($results);
+        # if there is at least one defined column consider the resultset real 
+        # (and not an emtpy has_many rel containing one empty hashref) 
+        for (values %$hash) {
+            return $hash if defined $_;
+        }
 
-#-----------------------------
-# mk_hash implementations
-#-----------------------------
+        return undef;
+    }
+};
 
 # the (incomplete, fails a test) implementation before svn:4760
-sub old_mk_hash {
+my $old_mk_hash;
+$old_mk_hash = sub {
     my ($me, $rest) = @_;
 
     # $me is the hashref of cols/data from the immediate resultsource
@@ -74,35 +63,56 @@ sub old_mk_hash {
         map {
           ( $_ =>
              ref($rest->{$_}[0]) eq 'ARRAY'
-                 ? [ grep defined, map old_mk_hash(@$_), @{$rest->{$_}} ]
-                 : old_mk_hash( @{$rest->{$_}} )
+                 ? [ grep defined, map $old_mk_hash->(@$_), @{$rest->{$_}} ]
+                 : $old_mk_hash->( @{$rest->{$_}} )
           )
         } keys %$rest
     };
-}
+};
 
-# current implementation as of svn:4760
-sub current_mk_hash {
-    if (ref $_[0] eq 'ARRAY') {     # multi relationship 
-        return [ map { current_mk_hash (@$_) || () } (@_) ];
-    }
-    else {
-        my $hash = {
-            # the main hash could be an undef if we are processing a skipped-over join 
-            $_[0] ? %{$_[0]} : (),
 
-            # the second arg is a hash of arrays for each prefetched relation 
-            map
-                { $_ => current_mk_hash( @{$_[1]->{$_}} ) }
-                ( $_[1] ? (keys %{$_[1]}) : () )
-        };
+our %bench_list = (
+    current_implementation => $current_mk_hash,
+    old_implementation => $old_mk_hash,
+);
 
-        # if there is at least one defined column consider the resultset real 
-        # (and not an emtpy has_many rel containing one empty hashref) 
-        for (values %$hash) {
-            return $hash if defined $_;
-        }
+1;
 
-        return undef;
-    }
+package benchmark_hashrefinflator;
+
+use warnings;
+use strict;
+
+use FindBin;
+use lib ("$FindBin::Bin/../lib", "$FindBin::Bin/../t/lib");
+
+use Benchmark qw/timethis cmpthese/;
+use DBICTest;
+
+chdir ("$FindBin::Bin/..");
+my $schema = DBICTest->init_schema();
+
+my $test_sub = sub {
+    my $rs_hashrefinf = $schema->resultset ('Artist')->search ({}, {
+        prefetch => { cds => 'tracks' },
+    });
+    $rs_hashrefinf->result_class('DBIx::Class::ResultClass::HashRefInflator::Bench');
+    my @stuff = $rs_hashrefinf->all;
+};
+
+
+my $results;
+for my $b (keys %DBIx::Class::ResultClass::HashRefInflator::Bench::bench_list) {
+
+    print "Timing $b... ";
+
+    # switch the inflator
+    no warnings qw/redefine once/;
+    no strict qw/refs/;
+    local *DBIx::Class::ResultClass::HashRefInflator::Bench::inflate_result = sub {
+        return $DBIx::Class::ResultClass::HashRefInflator::Bench::bench_list{$b}->(@_[2,3]);
+    };
+
+    $results->{$b} = timethis (-2, $test_sub);
 }
+cmpthese ($results);