From: Peter Rabbitson Date: Fri, 22 Aug 2008 12:46:11 +0000 (+0000) Subject: Multiple HashRefInflator improvements: X-Git-Tag: v0.08240~374 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2328814a26b6ee181d9999ddf57fc16d862c6ccd;p=dbsrgits%2FDBIx-Class.git Multiple HashRefInflator improvements: - rewrite the inflator logic to work correctly with some weird cases of prefetch - it is now possible to automatically inflate the leaf values in the resulting hash (via a global variable) - a simple benchmark script for testing future mk_hash implementations --- diff --git a/lib/DBIx/Class/ResultClass/HashRefInflator.pm b/lib/DBIx/Class/ResultClass/HashRefInflator.pm index fc0ee37..fb35d13 100644 --- a/lib/DBIx/Class/ResultClass/HashRefInflator.pm +++ b/lib/DBIx/Class/ResultClass/HashRefInflator.pm @@ -3,6 +3,9 @@ package DBIx::Class::ResultClass::HashRefInflator; use strict; use warnings; +our %inflator_cache; +our $inflate_data; + =head1 NAME DBIx::Class::ResultClass::HashRefInflator @@ -36,6 +39,19 @@ recommended. =back +=head1 AUTOMATICALLY INFLATING COLUMN VALUES + +So you want to skip the DBIx::Class object creation part, but you still want +all your data to be inflated according to the rules you defined in your table +classes. Setting the global variable +C<$DBIx::Class::ResultClass::HashRefInflator::inflate_data> to a true value +will instruct L to interrogate the processed columns and apply any +inflation methods declared via L. + +For increased speed the inflation method lookups are cached in +C<%DBIx::Class::ResultClass::HashRefInflator::inflator_cache>. Make sure to +reset this hash if you modify column inflators at run time. + =head1 METHODS =head2 inflate_result @@ -47,7 +63,9 @@ Inflates the result and prefetched data into a hash-ref using L. sub inflate_result { my ($self, $source, $me, $prefetch) = @_; - return mk_hash($me, $prefetch); + my $hashref = mk_hash($me, $prefetch); + inflate_hash ($source->schema, $source->result_class, $hashref) if $inflate_data; + return $hashref; } =head2 mk_hash @@ -56,35 +74,77 @@ This does all the work of inflating the (pre)fetched data. =cut -sub mk_hash { - my ($me, $rest) = @_; +############## +# NOTE +# +# Generally people use this to gain as much speed as possible. If a new mk_hash is +# implemented, it should be benchmarked using the maint/benchmark_hashrefinflator.pl +# script (in addition to passing all tests of course :). Additional instructions are +# provided in the script itself. +# + +sub mk_hash { + if (ref $_[0] eq 'ARRAY') { # multi relationship + return [ map { 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 + { $_ => mk_hash( @{$_[1]->{$_}} ) } + ( $_[1] ? (keys %{$_[1]}) : () ) + }; + + # 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 $_; + } - # $me is the hashref of cols/data from the immediate resultsource - # $rest is a deep hashref of all the data from the prefetched - # related sources. + return undef; + } +} + +=head2 inflate_hash + +This walks through a hashref produced by L and inflates any data +for which there is a registered inflator in the C - # to avoid emtpy has_many rels contain one empty hashref - return undef if (not keys %$me); +=cut + +sub inflate_hash { + my ($schema, $rc, $data) = @_; - my $def; + foreach my $column (keys %{$data}) { - foreach (values %$me) { - if (defined $_) { - $def = 1; - last; + if (ref $data->{$column} eq 'HASH') { + inflate_hash ($schema, $schema->source ($rc)->related_class ($column), $data->{$column}); + } + elsif (ref $data->{$column} eq 'ARRAY') { + foreach my $rel (@{$data->{$column}}) { + inflate_hash ($schema, $schema->source ($rc)->related_class ($column), $rel); + } + } + else { + # "null is null is null" + next if not defined $data->{$column}; + + # cache the inflator coderef + unless (exists $inflator_cache{$rc}{$column}) { + $inflator_cache{$rc}{$column} = exists $schema->source ($rc)->_relationships->{$column} + ? undef # currently no way to inflate a column sharing a name with a rel + : $rc->column_info($column)->{_inflate_info}{inflate} + ; + } + + if ($inflator_cache{$rc}{$column}) { + $data->{$column} = $inflator_cache{$rc}{$column}->($data->{$column}); + } } } - return undef unless $def; - - return { %$me, - map { - ( $_ => - ref($rest->{$_}[0]) eq 'ARRAY' - ? [ grep defined, map mk_hash(@$_), @{$rest->{$_}} ] - : mk_hash( @{$rest->{$_}} ) - ) - } keys %$rest - }; } =head1 CAVEAT diff --git a/maint/benchmark_hashrefinflator.pl b/maint/benchmark_hashrefinflator.pl new file mode 100755 index 0000000..d8dd947 --- /dev/null +++ b/maint/benchmark_hashrefinflator.pl @@ -0,0 +1,108 @@ +#!/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/; + +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; +}; + + +my $results; +for my $b (@bench) { + die "No such subroutine '$b' defined!\n" if not __PACKAGE__->can ($b); + print "Timing $b... "; + + # switch the inflator + no warnings qw/redefine/; + no strict qw/refs/; + local *DBIx::Class::ResultClass::HashRefInflator::mk_hash = \&$b; + + $results->{$b} = timethis (-2, $test_sub); +} +cmpthese ($results); + +#----------------------------- +# mk_hash implementations +#----------------------------- + +# the (incomplete, fails a test) implementation before svn:4760 +sub old_mk_hash { + my ($me, $rest) = @_; + + # $me is the hashref of cols/data from the immediate resultsource + # $rest is a deep hashref of all the data from the prefetched + # related sources. + + # to avoid emtpy has_many rels contain one empty hashref + return undef if (not keys %$me); + + my $def; + + foreach (values %$me) { + if (defined $_) { + $def = 1; + last; + } + } + return undef unless $def; + + return { %$me, + map { + ( $_ => + ref($rest->{$_}[0]) eq 'ARRAY' + ? [ 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]}) : () ) + }; + + # 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 $_; + } + + return undef; + } +} diff --git a/t/68inflate_resultclass_hashrefinflator.t b/t/68inflate_resultclass_hashrefinflator.t index 221626a..a450c0e 100644 --- a/t/68inflate_resultclass_hashrefinflator.t +++ b/t/68inflate_resultclass_hashrefinflator.t @@ -3,6 +3,8 @@ use warnings; use Test::More qw(no_plan); use lib qw(t/lib); +use Scalar::Util qw/blessed/; +use DateTime; use DBICTest; use DBIx::Class::ResultClass::HashRefInflator; my $schema = DBICTest->init_schema(); @@ -79,9 +81,59 @@ $rs_hashrefinf->result_class('DBIx::Class::ResultClass::HashRefInflator'); my @dbic = $rs_dbic->all; my @hashrefinf = $rs_hashrefinf->all; -for my $index (0..scalar @hashrefinf) { +for my $index (0 .. $#hashrefinf) { my $dbic_obj = $dbic[$index]; my $datahashref = $hashrefinf[$index]; check_cols_of($dbic_obj, $datahashref); } + +# sometimes for ultra-mega-speed you want to fetch columns in esoteric ways +# check the inflator over a non-fetching join +$rs_dbic = $schema->resultset ('Artist')->search ({ 'me.artistid' => 1}, { + prefetch => { cds => 'tracks' }, + order_by => [qw/cds.cdid tracks.trackid/], +}); + +$rs_hashrefinf = $schema->resultset ('Artist')->search ({ 'me.artistid' => 1}, { + join => { cds => 'tracks' }, + select => [qw/name tracks.title tracks.cd /], + as => [qw/name cds.tracks.title cds.tracks.cd /], + order_by => [qw/cds.cdid tracks.trackid/], +}); +$rs_hashrefinf->result_class('DBIx::Class::ResultClass::HashRefInflator'); + +@dbic = map { $_->tracks->all } ($rs_dbic->first->cds->all); +@hashrefinf = $rs_hashrefinf->all; + +is (scalar @dbic, scalar @hashrefinf, 'Equal number of tracks fetched'); + +for my $index (0 .. $#hashrefinf) { + my $track = $dbic[$index]; + my $datahashref = $hashrefinf[$index]; + + is ($track->cd->artist->name, $datahashref->{name}, 'Brought back correct artist'); + for my $col (keys %{$datahashref->{cds}{tracks}}) { + is ($track->get_column ($col), $datahashref->{cds}{tracks}{$col}, "Correct track '$col'"); + } +} + +# Test the data inflator + +$schema->class('CD')->inflate_column( 'year', + { inflate => sub { DateTime->new( year => shift ) }, + deflate => sub { shift->year } } +); + +my $cd_rs = $schema->resultset("CD")->search ({cdid => 3}); +$cd_rs->result_class('DBIx::Class::ResultClass::HashRefInflator'); + +my $cd = $cd_rs->first; +ok ( (not blessed $cd->{year}), "Plain string returned for year"); +is ( $cd->{year}, '1997', "We are looking at the right year"); + +# try it again with inflation requested +local $DBIx::Class::ResultClass::HashRefInflator::inflate_data = 1; +my $cd2 = $cd_rs->first; +isa_ok ($cd2->{year}, 'DateTime', "Inflated object"); +is ($cd2->{year}, DateTime->new ( year => 1997 ), "Correct year was inflated");