[Bast-commits] r4760 - in DBIx-Class/0.08/trunk:
lib/DBIx/Class/ResultClass maint t
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Fri Aug 22 13:46:12 BST 2008
Author: ribasushi
Date: 2008-08-22 13:46:11 +0100 (Fri, 22 Aug 2008)
New Revision: 4760
Added:
DBIx-Class/0.08/trunk/maint/benchmark_hashrefinflator.pl
Modified:
DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultClass/HashRefInflator.pm
DBIx-Class/0.08/trunk/t/68inflate_resultclass_hashrefinflator.t
Log:
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
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultClass/HashRefInflator.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultClass/HashRefInflator.pm 2008-08-21 15:24:54 UTC (rev 4759)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/ResultClass/HashRefInflator.pm 2008-08-22 12:46:11 UTC (rev 4760)
@@ -3,6 +3,9 @@
use strict;
use warnings;
+our %inflator_cache;
+our $inflate_data;
+
=head1 NAME
DBIx::Class::ResultClass::HashRefInflator
@@ -36,6 +39,19 @@
=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 @@
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 @@
=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.
+#
- # $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.
+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]} : (),
- # to avoid emtpy has_many rels contain one empty hashref
- return undef if (not keys %$me);
+ # the second arg is a hash of arrays for each prefetched relation
+ map
+ { $_ => mk_hash( @{$_[1]->{$_}} ) }
+ ( $_[1] ? (keys %{$_[1]}) : () )
+ };
- my $def;
+ # 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 $_;
+ }
- foreach (values %$me) {
- if (defined $_) {
- $def = 1;
- last;
+ 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>
+
+=cut
+
+sub inflate_hash {
+ my ($schema, $rc, $data) = @_;
+
+ foreach my $column (keys %{$data}) {
+
+ 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
Added: DBIx-Class/0.08/trunk/maint/benchmark_hashrefinflator.pl
===================================================================
--- DBIx-Class/0.08/trunk/maint/benchmark_hashrefinflator.pl (rev 0)
+++ DBIx-Class/0.08/trunk/maint/benchmark_hashrefinflator.pl 2008-08-22 12:46:11 UTC (rev 4760)
@@ -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;
+ }
+}
Property changes on: DBIx-Class/0.08/trunk/maint/benchmark_hashrefinflator.pl
___________________________________________________________________
Name: svn:executable
+ *
Modified: DBIx-Class/0.08/trunk/t/68inflate_resultclass_hashrefinflator.t
===================================================================
--- DBIx-Class/0.08/trunk/t/68inflate_resultclass_hashrefinflator.t 2008-08-21 15:24:54 UTC (rev 4759)
+++ DBIx-Class/0.08/trunk/t/68inflate_resultclass_hashrefinflator.t 2008-08-22 12:46:11 UTC (rev 4760)
@@ -3,6 +3,8 @@
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 @@
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');
+
+ at dbic = map { $_->tracks->all } ($rs_dbic->first->cds->all);
+ at 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");
More information about the Bast-commits
mailing list