diff --git a/Changes b/Changes index a9fc61a..fdce0dc 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,7 @@ Revision history for {{$dist->name}} {{$NEXT}} + - Add ::ResultClass::Tee 2.031000 2015-07-25 01:20:40-07:00 America/Los_Angeles - Add ::ResultSet::Bare (Closes GH#53) diff --git a/cpanfile b/cpanfile index 1763b03..540521c 100644 --- a/cpanfile +++ b/cpanfile @@ -12,6 +12,7 @@ requires 'Module::Runtime'; requires 'Try::Tiny'; requires 'Safe::Isa'; requires 'Text::Brew'; +requires 'Moo' => 2; on test => sub { requires 'Test::More' => 0.94; diff --git a/lib/DBIx/Class/Helper/ResultClass/Tee.pm b/lib/DBIx/Class/Helper/ResultClass/Tee.pm new file mode 100644 index 0000000..09d510f --- /dev/null +++ b/lib/DBIx/Class/Helper/ResultClass/Tee.pm @@ -0,0 +1,66 @@ +package DBIx::Class::Helper::ResultClass::Tee; + +# ABSTRACT: Inflate to multiple result classes at the same time + +use utf8; + +use Moo; +use Module::Runtime 'use_module'; +use Scalar::Util 'blessed'; + +has inner_classes => ( + is => 'ro', + required => 1, + coerce => sub { + [ map { + s/^::/DBIx::Class::ResultClass::/; + s/::HRI$/::HashRefInflator/; + $_ + } @{$_[0]} ] + }, +); + +sub inflate_result { + my ($self, @rest) = @_; + + die "..." unless blessed($self); + + [ map scalar use_module($_)->inflate_result(@rest), @{$self->inner_classes} ] +} + +1; + +__END__ + +=pod + +=head1 SYNOPSIS + + my ($hashref, $obj) = $rs->search(undef, { + result_class => DBIx::Class::Helper::ResultClass::Tee->new( + inner_classes => [ '::HRI', 'MyApp::Schema::Result::User'], + ), + })->first->@*; + +(If you've never seen C<< ->@* >> before, check out +L, added in Perl v5.20!) + +=head1 DESCRIPTION + +This result class has one obvious use case: when you have prefetched data and +L is the simplest way to access all +the data, but you still want to use some of the methods on your existing result +class. + +The other important I of this module is that it is an example of +how to make a "parameterized" result class. It's almost a secret that +L supports using objects to inflate results. This is an incredibly +powerful feature that can be used to make consistent interfaces to do all kinds +of things. + +Once when I was at Micro Technology Services, Inc. I used it to efficiently do a +"reverse synthetic, LIKE-ish join". The "relationship" was basically +C<< foreign.name =~ self.name >>, which cannot actually be done if you want to +go from within the database, but if you are able to load the entire foreign +table into memory this can be done on-demand, and cached within the result class +for (in our case) the duration of a request. diff --git a/t/ResultClass/Tee.t b/t/ResultClass/Tee.t new file mode 100755 index 0000000..061ed3b --- /dev/null +++ b/t/ResultClass/Tee.t @@ -0,0 +1,31 @@ +#!perl + +use strict; +use warnings; + +use lib 't/lib'; +use Test::More; +use Test::Deep; + +use TestSchema; + +use DBIx::Class::Helper::ResultClass::Tee; + +my $schema = TestSchema->deploy_or_connect(); +$schema->prepopulate; + +my $rs = $schema->resultset('Gnarly')->search(undef, { + result_class => DBIx::Class::Helper::ResultClass::Tee->new( + inner_classes => ['::HRI', 'TestSchema::Result::Gnarly'], + ) +}); + +my $arr = $rs->first; + +cmp_deeply($arr->[0], superhashof({ + name => "frew", +}), '::HRI'); + +is($arr->[1]->name, 'frew', 'TestSchema::Result::Gnarly'); + +done_testing;