Multiple HashRefInflator improvements:
Peter Rabbitson [Fri, 22 Aug 2008 12:46:11 +0000 (12:46 +0000)]
- 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

lib/DBIx/Class/ResultClass/HashRefInflator.pm
maint/benchmark_hashrefinflator.pl [new file with mode: 0755]
t/68inflate_resultclass_hashrefinflator.t

index fc0ee37..fb35d13 100644 (file)
@@ -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<mk_hash> to interrogate the processed columns and apply any
+inflation methods declared via L<DBIx::Class::InflateColumn/inflate_column>.
+
+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<mk_hash>.
 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<mk_hash> and inflates any data 
+for which there is a registered inflator in the C<column_info>
 
-    # 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 (executable)
index 0000000..d8dd947
--- /dev/null
@@ -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;
+    }
+}
index 221626a..a450c0e 100644 (file)
@@ -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");