- Allow explicit specification of ON DELETE/ON UPDATE constraints when using the...
[dbsrgits/DBIx-Class.git] / maint / benchmark_hashrefinflator.pl
CommitLineData
2328814a 1#!/usr/bin/perl
2
3use warnings;
4use strict;
5
6use 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
14my @bench = qw/current_mk_hash old_mk_hash/;
15
16use Benchmark qw/timethis cmpthese/;
17
18use lib ("$FindBin::Bin/../lib", "$FindBin::Bin/../t/lib");
19use DBICTest;
20use DBIx::Class::ResultClass::HashRefInflator;
21
22chdir ("$FindBin::Bin/..");
23my $schema = DBICTest->init_schema();
24
25my $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
34my $results;
35for 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}
46cmpthese ($results);
47
48#-----------------------------
49# mk_hash implementations
50#-----------------------------
51
52# the (incomplete, fails a test) implementation before svn:4760
53sub 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
85sub 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}