Bring back _TempExtlib (d0435d75), this time for Sub::Quote
[dbsrgits/DBIx-Class.git] / examples / Benchmarks / benchmark_hashrefinflator.pl
CommitLineData
f54428ab 1#!/usr/bin/env perl
2328814a 2
2328814a 3#
9839286b 4# So you wrote a new mk_hash implementation which passed all tests
5# (particularly t/inflate/hri.t) and would like to see how it holds
6# up against older (and often buggy) versions of the same. Just run
7# this script and wait (no editing necessary)
2328814a 8
a5b29361 9use warnings;
10use strict;
2328814a 11
9839286b 12use FindBin;
62628242 13use lib ("$FindBin::Bin/../../lib", "$FindBin::Bin/../../t/lib");
2328814a 14
9839286b 15use Class::Unload '0.07';
16use Benchmark ();
17use Dumbbench;
18use Benchmark::Dumb ':all';
19use DBICTest;
2328814a 20
9839286b 21# for git reporting to work, and to use it as INC key directly
62628242 22chdir ("$FindBin::Bin/../../lib");
9839286b 23my $hri_fn = 'DBIx/Class/ResultClass/HashRefInflator.pm';
2328814a 24
9839286b 25require Getopt::Long;
26my $getopt = Getopt::Long::Parser->new(
27 config => [qw/gnu_getopt bundling_override no_ignore_case pass_through/]
a5b29361 28);
9839286b 29my $args = {
30 'bench-commits' => 2,
31 'no-cpufreq-checks' => undef,
32};
33$getopt->getoptions($args, qw/
34 bench-commits
35 no-cpufreq-checks
36/);
37
38if (
39 !$args->{'no-cpufreq-checks'}
40 and
41 $^O eq 'linux'
42 and
43 -r '/sys/devices/system/cpu/cpu0/cpufreq/scaling_cur_freq'
44) {
45 my ($min_freq, $max_freq, $governor) = map { local @ARGV = $_; my $s = <>; chomp $s; $s } qw|
46 /sys/devices/system/cpu/cpu0/cpufreq/scaling_min_freq
47 /sys/devices/system/cpu/cpu0/cpufreq/scaling_max_freq
48 /sys/devices/system/cpu/cpu0/cpufreq/scaling_governor
49 |;
50
51 if ($min_freq != $max_freq) {
52 die "Your OS seems to have an active CPU governor '$governor' -"
53 . ' this will render benchmark results meaningless. Disable it'
54 . ' by setting /sys/devices/system/cpu/cpu*/cpufreq/scaling_max_freq'
55 . ' to the same value as /sys/devices/system/cpu/cpu*/cpufreq/scaling_min_freq'
56 . " ($min_freq). Alternatively skip this check with --no-cpufreq-checks.\n";
57 }
58}
2328814a 59
9839286b 60my %skip_commits = map { $_ => 1 } qw/
61 e1540ee
62 a5b2936
63 4613ee1
64 419ff18
65/;
66my (@to_bench, $not_latest);
67for my $commit (`git log --format=%h HEAD ^8330454^ $hri_fn `) {
68 chomp $commit;
69 next if $skip_commits{$commit};
70 my $diff = `git show -w -U0 --format=%ar%n%b $commit $hri_fn`;
71 if ($diff =~ /^ (?: \@\@ \s .+? | [+-] sub \s) \$? mk_hash /xm ) {
72 my ($age) = $diff =~ /\A(.+?)\n/;
73
74 push @to_bench, {
75 commit => $commit,
76 title => $not_latest ? $commit : 'LATEST',
77 desc => sprintf ("commit %s (%smade %s)...\t\t",
78 $commit,
79 $not_latest ? '' : 'LATEST, ',
80 $age,
81 ),
82 code => scalar `git show $commit:lib/DBIx/Class/ResultClass/HashRefInflator.pm`,
83 };
2328814a 84
9839286b 85 last if @to_bench == $args->{'bench-commits'};
86 $not_latest = 1;
87 }
88}
89die "Can't find any commits... something is wrong\n" unless @to_bench;
a5b29361 90
9839286b 91unshift @to_bench, {
92 desc => "the current uncommitted HRI...\t\t\t\t",
93 title => 'CURRENT',
94 code => do { local (@ARGV, $/) = ($hri_fn); <> },
95} if `git status --porcelain $hri_fn`;
a5b29361 96
9839286b 97printf "\nAbout to benchmark %d HRI variants (%s)\n",
98 scalar @to_bench,
99 (join ', ', map { $_->{title} } @to_bench),
100;
a5b29361 101
a5b29361 102my $schema = DBICTest->init_schema();
103
9839286b 104# add some extra data for the complex test
105$schema->resultset ('Artist')->create({
106 name => 'largggge',
107 cds => [
108 {
109 genre => { name => 'massive' },
110 title => 'largesse',
111 year => 2011,
112 tracks => [
113 {
114 title => 'larguitto',
115 cd_single => {
116 title => 'mongo',
117 year => 2012,
118 artist => 1,
119 genre => { name => 'massive' },
120 tracks => [
121 { title => 'yo momma' },
122 { title => 'so much momma' },
123 ],
124 },
125 },
126 ],
127 },
128 ],
129});
130
131# get what data to feed during benchmarks
132{
133 package _BENCH_::DBIC::InflateResult::Trap;
134 sub inflate_result { shift; return \@_ }
135}
136my %bench_dataset = (
137 simple => do {
138 my $rs = $schema->resultset ('Artist')->search ({}, {
139 prefetch => { cds => 'tracks' },
140 result_class => '_BENCH_::DBIC::InflateResult::Trap',
a5b29361 141 });
9839286b 142 [ $rs->all ];
143 },
144 complex => do {
145 my $rs = $schema->resultset ('Artist')->search ({}, {
146 prefetch => { cds => [ { tracks => { cd_single => [qw/artist genre tracks/] } }, 'genre' ] },
147 result_class => '_BENCH_::DBIC::InflateResult::Trap',
148 });
149 [ $rs->all ];
150 },
151);
a5b29361 152
9839286b 153# benchmark coderefs (num iters is set below)
154my %num_iters;
155my %bench = ( map { $_ => eval "sub {
156 for (1 .. (\$num_iters{$_}||1) ) {
157 DBIx::Class::ResultClass::HashRefInflator->inflate_result(\$bench_dataset{$_})
158 }
159}" } qw/simple complex/ );
160
161$|++;
162print "\nPre-timing current HRI to determine iteration counts...";
163# crude unreliable and quick test how many to run in the loop
164# designed to return a value so that there ~ 1/$div runs in a second
165# (based on the current @INC implementation)
166my $div = 1;
167require DBIx::Class::ResultClass::HashRefInflator;
168for (qw/simple complex/) {
169 local $SIG{__WARN__} = sub {};
170 my $tst = Benchmark::timethis(-1, $bench{$_}, '', 'none');
171 $num_iters{$_} ||= int( $tst->[5] / $tst->[1] / $div );
172 $num_iters{$_} ||= 1;
173}
174print " done\n\nBenchmarking - this can taka a LOOOOOONG time\n\n";
175
176my %results;
177
178for my $bch (@to_bench) {
179 Class::Unload->unload('DBIx::Class::ResultClass::HashRefInflator');
180 eval $bch->{code} or die $@;
181 $INC{'DBIx/Class/ResultClass/HashRefInflator.pm'} = $bch->{title};
182
183 for my $t (qw/simple complex/) {
184 my $label = "Timing $num_iters{$t} $t iterations of $bch->{desc}";
185
186 my $bench = Dumbbench->new(
187 initial_runs => 30,
188 target_rel_precision => 0.0005,
189 );
190 $bench->add_instances( Dumbbench::Instance::PerlSub->new (
191 name => $label, code => $bench{$t},
192 ));
193
194 print $label;
195 $bench->run;
196
197 print(
198 ($results{ (substr $t, 0, 1) . "_$bch->{title}" }
199 = Benchmark::Dumb->_new( instance => ($bench->instances)[0] ) )
200 ->timestr('')
201 );
202 print "\n";
203 }
204}
a5b29361 205
9839286b 206for my $t (qw/s c/) {
207 cmpthese ({ map { $_ =~ /^${t}_/ ? ( $_ => $results{$_}) : () } keys %results }, '', '');
2328814a 208}