File Coverage

blib/lib/Fey/Object/Iterator/FromSelect.pm
Criterion Covered Total %
statement 30 99 30.3
branch 0 20 0.0
condition n/a
subroutine 10 22 45.4
pod 2 3 66.6
total 42 144 29.1


line stmt bran cond sub pod time code
1             package Fey::Object::Iterator::FromSelect;
2              
3 13     13   2789318 use strict;
  13         24  
  13         450  
4 13     13   66 use warnings;
  13         24  
  13         424  
5 13     13   539 use namespace::autoclean;
  13         13395  
  13         87  
6              
7             our $VERSION = '0.47';
8              
9 13     13   2380 use Fey::Exceptions qw( param_error );
  13         26466  
  13         794  
10 13     13   521 use Fey::ORM::Types qw( ArrayRef HashRef Maybe Str );
  13         27  
  13         131  
11              
12 13     13   71022 use Devel::GlobalDestruction;
  13         28  
  13         157  
13 13     13   1225 use Moose;
  13         27  
  13         123  
14 13     13   86499 use MooseX::SemiAffordanceAccessor;
  13         14560  
  13         136  
15 13     13   51705 use MooseX::StrictConstructor;
  13         19439  
  13         121  
16 13     13   50092 use Try::Tiny;
  13         29  
  13         16479  
17              
18             with 'Fey::ORM::Role::Iterator';
19              
20             has dbh => (
21             is => 'ro',
22             isa => 'DBI::db',
23             required => 1,
24             );
25              
26             has select => (
27             is => 'ro',
28             does => 'Fey::Role::SQL::ReturnsData',
29             required => 1,
30             );
31              
32             has bind_params => (
33             is => 'ro',
34             isa => ArrayRef,
35             lazy => 1,
36             default => sub { [ $_[0]->select()->bind_params() ] },
37             );
38              
39             has _sth => (
40             is => 'ro',
41             isa => 'DBI::st',
42             writer => '_set_sth',
43             predicate => '_has_sth',
44             clearer => '_clear_sth',
45             init_arg => undef,
46             lazy => 1,
47             builder => '_build_sth',
48             );
49              
50             has attribute_map => (
51             is => 'ro',
52             isa => HashRef [ HashRef [Str] ],
53             default => sub { return {} },
54             );
55              
56             has _class_attributes_by_position => (
57             is => 'ro',
58             isa => HashRef [ HashRef [Str] ],
59             init_arg => undef,
60             lazy => 1,
61             builder => '_build_class_attributes_by_position',
62             );
63              
64             has raw_row => (
65             is => 'rw',
66             isa => Maybe [ArrayRef],
67             init_arg => undef,
68             writer => '_set_raw_row',
69             );
70              
71             sub BUILD {
72 0     0 0   my $self = shift;
73              
74 0           $self->_validate_attribute_map();
75             }
76              
77             sub _validate_attribute_map {
78 0     0     my $self = shift;
79              
80 0           my $map = $self->attribute_map();
81              
82 0 0         return unless keys %{$map};
  0            
83              
84 0           my %valid_classes = map { $_ => 1 } @{ $self->classes() };
  0            
  0            
85              
86 0           for my $class ( map { $_->{class} } values %{$map} ) {
  0            
  0            
87             die
88             "Cannot include a class in attribute_map ($class) unless it also in classes"
89 0 0         unless $valid_classes{$class};
90             }
91             }
92              
93             ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
94             sub _get_next_result {
95 0     0     my $self = shift;
96              
97 0           my $sth = $self->_sth();
98              
99 0           my $row = $sth->fetchrow_arrayref();
100              
101 0           $self->_set_raw_row($row);
102              
103 0 0         return unless $row;
104              
105 0           my $map = $self->_class_attributes_by_position();
106              
107 0           my @result;
108 0           for my $class ( @{ $self->classes() } ) {
  0            
109 0           my %attr = map { $map->{$class}{$_} => $row->[$_] }
110 0           keys %{ $map->{$class} };
  0            
111 0           $attr{_from_query} = 1;
112              
113 0           push @result, $self->_new_object( $class, \%attr );
114             }
115              
116 0           return \@result;
117             }
118              
119             sub _new_object {
120 0     0     my $self = shift;
121 0           my $class = shift;
122 0           my $attr = shift;
123              
124             # FIXME - This eval is kind of a band-aid. It is possible (especially with
125             # DBD::Mock) for %attr to contain bogus data (wrong types). However, it's
126             # also possible for %attr to contain undefs for non-NULLable columns when
127             # iterating over the results of a select, especially outer joins.
128             #
129             # In the outer join case, we do want to ignore object construction errors,
130             # but otherwise we don't.
131             #
132             # Fortunately, bogus data is unlikely, unless the caller explicitly
133             # provides a bad attribute_map, or a valid attribute_map and a crazy
134             # query. It also can happen pretty easily with DBD::Mock.
135 0 0   0     try { $class->new($attr) } || undef;
  0            
136             }
137              
138             sub _build_sth {
139 0     0     my $self = shift;
140              
141 0           my $sth = $self->dbh()->prepare( $self->select()->sql( $self->dbh() ) );
142              
143 0           $sth->execute( @{ $self->bind_params() } );
  0            
144              
145 0           return $sth;
146             }
147              
148             sub _has_explicit_attribute_map {
149 0     0     my $self = shift;
150              
151 0           return keys %{ $self->attribute_map() };
  0            
152             }
153              
154             sub _build_class_attributes_by_position {
155 0     0     my $self = shift;
156              
157 0 0         return $self->_remap_explicit_attribute_map()
158             if $self->_has_explicit_attribute_map;
159              
160 0           my $x = 0;
161 0           my %map;
162              
163 0           for my $s ( $self->select()->select_clause_elements() ) {
164 0 0         if ( $s->can('table') ) {
165 0           my $class = Fey::Meta::Class::Table->ClassForTable( $s->table() );
166              
167 0 0         $map{$class}{$x}
168             = $s->can('alias_name') ? $s->alias_name() : $s->name();
169             }
170              
171 0           $x++;
172             }
173              
174 0           return \%map;
175             }
176              
177             sub _remap_explicit_attribute_map {
178 0     0     my $self = shift;
179              
180 0           my $explicit_map = $self->attribute_map();
181              
182 0           my %map;
183 0           for my $pos ( keys %{$explicit_map} ) {
  0            
184             $map{ $explicit_map->{$pos}{class} }{$pos}
185 0           = $explicit_map->{$pos}{attribute};
186             }
187              
188 0           return \%map;
189             }
190              
191             ## no critic (Subroutines::ProhibitBuiltinHomonyms)
192             sub reset {
193 0     0 1   my $self = shift;
194              
195 0           $self->_finish_handle();
196 0           $self->_clear_sth();
197 0           $self->_reset_index();
198              
199 0           return;
200             }
201             ## use critic
202              
203             sub DEMOLISH {
204 0     0 1   my $self = shift;
205              
206 0           $self->_finish_handle();
207             }
208              
209             sub _finish_handle {
210 0     0     my $self = shift;
211              
212             # We really don't care about cleanly finishing statement handles
213             # in this case, and this code just doesn't work so well in that
214             # case anyway.
215 0 0         return if in_global_destruction();
216              
217 0 0         return unless $self->_has_sth();
218              
219 0 0         $self->_sth()->finish() if $self->_sth()->{Active};
220             }
221              
222             __PACKAGE__->meta()->make_immutable();
223              
224             1;
225              
226             # ABSTRACT: Wraps a DBI statement handle to construct objects from the results
227              
228             __END__
229              
230             =pod
231              
232             =head1 NAME
233              
234             Fey::Object::Iterator::FromSelect - Wraps a DBI statement handle to construct objects from the results
235              
236             =head1 VERSION
237              
238             version 0.47
239              
240             =head1 SYNOPSIS
241              
242             use Fey::Object::Iterator::FromSelect;
243              
244             my $iter = Fey::Object::Iterator::FromSelect->new(
245             classes => 'MyApp::User',
246             select => $select,
247             dbh => $dbh,
248             bind_params => \@bind,
249             );
250              
251             print $iter->index(); # 0
252              
253             while ( my $user = $iter->next() ) {
254             print $iter->index(); # 1, 2, 3, ...
255             print $user->username();
256             }
257              
258             $iter->reset();
259              
260             =head1 DESCRIPTION
261              
262             This class implements an iterator on top of a DBI statement
263             handle. Each call to C<next()> returns one or more objects based on
264             the data returned by the statement handle.
265              
266             =head1 METHODS
267              
268             This class provides the following methods:
269              
270             =head2 Fey::Object::Iterator::FromSelect->new(...)
271              
272             This method constructs a new iterator. It accepts the following
273             parameters:
274              
275             =over 4
276              
277             =item * classes
278              
279             This can be a single class name, or an array reference of class
280             names. These should be classes associated with the tables from which
281             data is being C<SELECT>ed. The iterator will return an object of each
282             class in order when C<< $iterator->next() >> is called.
283              
284             This can be any class, not just a class which uses
285             L<Fey::ORM::Table>. However, the iterator methods below which return hashes
286             only work when all the classes have a C<Table()> method.
287              
288             =item * dbh
289              
290             A connected DBI handle
291              
292             =item * select
293              
294             This can be any object which does the L<Fey::Role::SQL::ReturnsData>
295             role. Usually this will be a L<Fey::SQL::Select> object. This object should be
296             a query which returns the data that this iterator will iterate over.
297              
298             =item * bind_params
299              
300             This should be an array reference of one or more bind params for the
301             C<SELECT>.
302              
303             This is an optional parameter. If it not passed, then the bind
304             parameters will be obtained by calling the C<bind_params()> method on
305             the "select" parameter.
306              
307             =item * attribute_map
308              
309             This lets you explicitly map an element of the C<SELECT> clause to a
310             specific class's attribute.
311              
312             See L<ATTRIBUTE MAPPING> for more details.
313              
314             =back
315              
316             =head2 $iterator->index()
317              
318             This returns the current index value of the iterator. When the object
319             is first constructed, this index is 0, and it is incremented once for
320             each row fetched by calling C<< $iterator->next() >>.
321              
322             =head2 $iterator->next()
323              
324             This returns the next set of objects, based on data retrieved by the
325             query. In list context this returns all the objects. In scalar context
326             it returns the first object.
327              
328             It is possible that one or more of the objects it returns will be
329             undefined, though this should really only happen with an outer
330             join. The statement handle will be executed the first time this method
331             is called.
332              
333             If the statement handle is exhausted, this method returns false.
334              
335             =head2 $iterator->remaining()
336              
337             This returns all of the I<remaining> sets of objects. If the iterator
338             is for a single class, it returns a list of objects of that class. If
339             it is for multiple objects, it returns a list of array references.
340              
341             =head2 $iterator->all()
342              
343             This returns all of the sets of objects. If necessary, it will call
344             C<< $iterator->reset() >> first. If the iterator is for a single
345             class, it returns a list of objects of that class. If it is for
346             multiple objects, it returns a list of array references.
347              
348             =head2 $iterator->next_as_hash()
349              
350             Returns the next set of objects as a hash. The keys are the names of
351             the object's associated table.
352              
353             If the statement handle is exhausted, this method returns false.
354              
355             This method will throw an exception unless all of the iterator's classes have
356             a C<Table()> method.
357              
358             =head2 $iterator->remaining_as_hashes()
359              
360             This returns all of the I<remaining> sets of objects as a list of hash
361             references. Each hash ref is keyed on the table name of the associated
362             object's class.
363              
364             This method will throw an exception unless all of the iterator's classes have
365             a C<Table()> method.
366              
367             =head2 $iterator->all_as_hashes()
368              
369             This returns all of the sets of objects as a list of hash
370             references. If necessary, it will call C<< $iterator->reset() >>
371             first. Each hash ref is keyed on the table name of the associated
372             object's class.
373              
374             This method will throw an exception unless all of the iterator's classes have
375             a C<Table()> method.
376              
377             =head2 $iterator->reset()
378              
379             Resets the iterator so that the next call to C<< $iterator->next() >>
380             returns the first objects. Internally this means that the statement
381             handle will be executed again. It's possible that data will have
382             changed in the DBMS since then, meaning that the iterator will return
383             different objects after a reset.
384              
385             =head2 $iterator->raw_row()
386              
387             Returns an array reference containing the I<raw> data returned by the query on
388             the most recent call to C<< $iterator->next() >>. Once the iterator is
389             exhausted, this method returns C<undef>.
390              
391             =head2 $iterator->DEMOLISH()
392              
393             This method will call C<< $sth->finish() >> on its C<DBI> statement
394             handle if necessary.
395              
396             =head1 ATTRIBUTE MAPPING
397              
398             This class tries to automatically map each element of the C<SELECT>
399             clause to a class's attribute. You can also provide your own explicit
400             mappings as needed.
401              
402             In the absence of an explicit mapping, it checks to see if the element
403             has a C<table()> method. If it does, it calls C<<
404             Fey::Meta::Class::Table->ClassForTable >> in order to get a class name
405             for the table. Then it uses the value of C<name()> (for column
406             objects) or C<alias_name()> (for column alias objects) as the name of
407             the attribute to be passed to the class's constructor.
408              
409             If the class is not listed in the iterator's "classes" attribute, then
410             it will simply be ignored.
411              
412             If the element does not have a C<table()> method or an explicit
413             mapping, it is ignored.
414              
415             This default works for most queries, where you're just selecting some
416             or all of the columns from one or more tables.
417              
418             In more exotic cases, you can specify an explicit mapping. The mapping
419             maps a C<SELECT> clause element to a specify class's attribute. The
420             map would look something like this:
421              
422             Fey::Object::Iterator::FromSelect->new
423             ( classes => [ 'User', 'Message' ],
424             dbh => $dbh,
425             select => $select,
426             attribute_map => { 0 => { class => 'User',
427             attribute => 'user_id',
428             },
429             1 => { class => 'User',
430             attribute => 'username',
431             },
432             3 => { class => 'Message',
433             attribute => 'message_id',
434             },
435             },
436             );
437              
438             The keys in the mapping are positions in the list of C<SELECT> clause
439             elements. The numbers start from zero (0) just like a Perl array. The values
440             are themselves a hash reference specifying a "class" and "attribute" of that
441             class.
442              
443             This explicit mapping is useful for more "exotic" queries. For example:
444              
445             SELECT Message.user_id, COUNT(message_id) AS message_count
446             FROM Message
447             ORDER BY message_count DESC
448             GROUP BY user_id
449             LIMIT 10
450              
451             This query selects to the top 10 most frequent message posters from a
452             C<Message> table. Assuming our C<User> class has a C<message_count>
453             attribute, we'd like to create a list of C<User> objects from this
454             query.
455              
456             Fey::Object::Iterator::FromSelect->new
457             ( classes => [ 'User', 'Message' ],
458             dbh => $dbh,
459             select => $select,
460             attribute_map => { 0 => { class => 'User',
461             attribute => 'user_id',
462             },
463             1 => { class => 'User',
464             attribute => 'message_count',
465             },
466             );
467              
468             Explicit mappings to classes not listed in the "classes" attribute
469             cause an error at object construction time.
470              
471             =head1 ROLES
472              
473             This class does the L<Fey::ORM::Role::Iterator> role.
474              
475             =head1 AUTHOR
476              
477             Dave Rolsky <autarch@urth.org>
478              
479             =head1 COPYRIGHT AND LICENSE
480              
481             This software is copyright (c) 2011 - 2015 by Dave Rolsky.
482              
483             This is free software; you can redistribute it and/or modify it under
484             the same terms as the Perl 5 programming language system itself.
485              
486             =cut