view release on metacpan or  search on metacpan

examples/Benchmarks/benchmark_hashrefinflator.pl  view on Meta::CPAN

          },
        },
      ],
    },
  ],
});

# get what data to feed during benchmarks
{
  package _BENCH_::DBIC::InflateResult::Trap;
  sub inflate_result { shift; return \@_ }
}
my %bench_dataset = (
  simple => do {
    my $rs = $schema->resultset ('Artist')->search ({}, {
      prefetch => { cds => 'tracks' },
      result_class => '_BENCH_::DBIC::InflateResult::Trap',
    });
    [ $rs->all ];
  },
  complex => do {
    my $rs = $schema->resultset ('Artist')->search ({}, {
      prefetch => { cds => [ { tracks => { cd_single => [qw/artist genre tracks/] } }, 'genre' ] },
      result_class => '_BENCH_::DBIC::InflateResult::Trap',
    });
    [ $rs->all ];
  },
);

# benchmark coderefs (num iters is set below)
my %num_iters;
my %bench = ( map { $_ => eval "sub {
  for (1 .. (\$num_iters{$_}||1) ) {
    DBIx::Class::ResultClass::HashRefInflator->inflate_result(\$bench_dataset{$_})
  }
}" } qw/simple complex/ );

$|++;
print "\nPre-timing current HRI to determine iteration counts...";
# crude unreliable and quick test how many to run in the loop
# designed to return a value so that there ~ 1/$div runs in a second
# (based on the current @INC implementation)
my $div = 1;
require DBIx::Class::ResultClass::HashRefInflator;
for (qw/simple complex/) {
  local $SIG{__WARN__} = sub {};
  my $tst = Benchmark::timethis(-1, $bench{$_}, '', 'none');
  $num_iters{$_} ||= int( $tst->[5] / $tst->[1] / $div );
  $num_iters{$_} ||= 1;
}
print " done\n\nBenchmarking - this can taka a LOOOOOONG time\n\n";

my %results;

for my $bch (@to_bench) {
  Class::Unload->unload('DBIx::Class::ResultClass::HashRefInflator');
  eval $bch->{code} or die $@;
  $INC{'DBIx/Class/ResultClass/HashRefInflator.pm'} = $bch->{title};

  for my $t (qw/simple complex/) {
    my $label = "Timing $num_iters{$t} $t iterations of $bch->{desc}";

    my $bench = Dumbbench->new(
      initial_runs => 30,
      target_rel_precision => 0.0005,
    );
    $bench->add_instances( Dumbbench::Instance::PerlSub->new (
      name => $label, code => $bench{$t},
    ));

    print $label;
    $bench->run;

    print(
      ($results{ (substr $t, 0, 1) . "_$bch->{title}" }
        = Benchmark::Dumb->_new( instance => ($bench->instances)[0] ) )
      ->timestr('')
    );
    print "\n";
  }
}

for my $t (qw/s c/) {
  cmpthese ({ map { $_ =~ /^${t}_/ ? ( $_ => $results{$_}) : () } keys %results }, '', '');
}