maint/benchmark_hashrefinflator.pl

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use FindBin;
   7
   8 #
   9 # So you wrote a new mk_hash implementation which passed all tests (particularly
  10 # t/68inflate_resultclass_hashrefinflator) and would like to see how it holds up
  11 # against older versions of the same. Just add your subroutine somewhere below and
  12 # add its name to the @bench array. Happy testing.
  13
  14 my @bench = qw/current_mk_hash old_mk_hash/;
  15
  16 use Benchmark qw/timethis cmpthese/;
  17
  18 use lib ("$FindBin::Bin/../lib", "$FindBin::Bin/../t/lib");
  19 use DBICTest;
  20 use DBIx::Class::ResultClass::HashRefInflator;
  21
  22 chdir ("$FindBin::Bin/..");
  23 my $schema = DBICTest->init_schema();
  24
  25 my $test_sub = sub {
  26     my $rs_hashrefinf = $schema->resultset ('Artist')->search ({}, {
  27         prefetch => { cds => 'tracks' },
  28     });
  29     $rs_hashrefinf->result_class('DBIx::Class::ResultClass::HashRefInflator');
  30     my @stuff = $rs_hashrefinf->all;
  31 };
  32
  33
  34 my $results;
  35 for my $b (@bench) {
  36     die "No such subroutine '$b' defined!\n" if not __PACKAGE__->can ($b);
  37     print "Timing $b... ";
  38
  39     # switch the inflator
  40     no warnings qw/redefine/;
  41     no strict qw/refs/;
  42     local *DBIx::Class::ResultClass::HashRefInflator::mk_hash = \&$b;
  43
  44     $results->{$b} = timethis (-2, $test_sub);
  45 }
  46 cmpthese ($results);
  47
  48 #-----------------------------
  49 # mk_hash implementations
  50 #-----------------------------
  51
  52 # the (incomplete, fails a test) implementation before svn:4760
  53 sub old_mk_hash {
  54     my ($me, $rest) = @_;
  55
  56     # $me is the hashref of cols/data from the immediate resultsource
  57     # $rest is a deep hashref of all the data from the prefetched
  58     # related sources.
  59
  60     # to avoid emtpy has_many rels contain one empty hashref
  61     return undef if (not keys %$me);
  62
  63     my $def;
  64
  65     foreach (values %$me) {
  66         if (defined $_) {
  67             $def = 1;
  68             last;
  69         }
  70     }
  71     return undef unless $def;
  72
  73     return { %$me,
  74         map {
  75           ( $_ =>
  76              ref($rest->{$_}[0]) eq 'ARRAY'
  77                  ? [ grep defined, map old_mk_hash(@$_), @{$rest->{$_}} ]
  78                  : old_mk_hash( @{$rest->{$_}} )
  79           )
  80         } keys %$rest
  81     };
  82 }
  83
  84 # current implementation as of svn:4760
  85 sub current_mk_hash {
  86     if (ref $_[0] eq 'ARRAY') {     # multi relationship
  87         return [ map { current_mk_hash (@$_) || () } (@_) ];
  88     }
  89     else {
  90         my $hash = {
  91             # the main hash could be an undef if we are processing a skipped-over join
  92             $_[0] ? %{$_[0]} : (),
  93
  94             # the second arg is a hash of arrays for each prefetched relation
  95             map
  96                 { $_ => current_mk_hash( @{$_[1]->{$_}} ) }
  97                 ( $_[1] ? (keys %{$_[1]}) : () )
  98         };
  99
 100         # if there is at least one defined column consider the resultset real
 101         # (and not an emtpy has_many rel containing one empty hashref)
 102         for (values %$hash) {
 103             return $hash if defined $_;
 104         }
 105
 106         return undef;
 107     }
 108 }