File Coverage

blib/lib/Class/DBI/Iterator.pm
Criterion Covered Total %
statement 45 45 100.0
branch 7 8 87.5
condition 8 12 66.7
subroutine 13 13 100.0
pod 0 11 0.0
total 73 89 82.0


line stmt bran cond sub pod time code
1             package Class::DBI::Iterator;
2              
3             =head1 NAME
4            
5             Class::DBI::Iterator - Iterate over Class::DBI search results
6            
7             =head1 SYNOPSIS
8            
9             my $it = My::Class->search(foo => 'bar');
10            
11             my $results = $it->count;
12            
13             my $first_result = $it->first;
14             while ($it->next) { ... }
15            
16             my @slice = $it->slice(10,19);
17             my $slice = $it->slice(10,19);
18            
19             $it->reset;
20            
21             $it->delete_all;
22            
23             =head1 DESCRIPTION
24            
25             Any Class::DBI search (including a has_many method) which returns multiple
26             objects can be made to return an iterator instead simply by executing
27             the search in scalar context.
28            
29             Then, rather than having to fetch all the results at the same time, you
30             can fetch them one at a time, potentially saving a considerable amount
31             of processing time and memory.
32            
33             =head1 CAVEAT
34            
35             Note that there is no provision for the data changing (or even being
36             deleted) in the database inbetween performing the search and retrieving
37             the next result.
38            
39             =cut
40              
41 8     8   106 use strict;
  8         73  
  8         164  
42             use overload
43 8         143 '0+'     => 'count',
44 8     8   130 fallback => 1;
  8         72  
45              
46             sub new {
47 30     30 0 321 my ($me, $them, $data, @mapper) = @_;
48 30   66     2190 bless {
49             _class  => $them,
50             _data   => $data,
51             _mapper => [@mapper],
52             _place  => 0,
53             },
54             ref $me || $me;
55             }
56              
57             sub set_mapping_method {
58 1     1 0 11 my ($self, @mapper) = @_;
59 1         13 $self->{_mapper} = [@mapper];
60 1         13 $self;
61             }
62              
63 65     65 0 1080 sub class { shift->{_class} }
64 19     19 0 168 sub data { @{ shift->{_data} } }
  19         344  
65 65     65 0 851 sub mapper { @{ shift->{_mapper} } }
  65         853  
66              
67             sub count {
68 19     19 0 288 my $self = shift;
69 19   66     354 $self->{_count} ||= scalar $self->data;
70             }
71              
72             sub next {
73 76     76 0 1102 my $self = shift;
74 76 100       1164 my $use = $self->{_data}->[ $self->{_place}++ ] or return;
75 64         830 my @obj = ($self->class->construct($use));
76 64         960 foreach my $meth ($self->mapper) {
77 4         59 @obj = map $_->$meth(), @obj;
78             }
79 64 50       753 warn "Discarding extra inflated objects" if @obj > 1;
80 64         880 return $obj[0];
81             }
82              
83             sub first {
84 14     14 0 174 my $self = shift;
85 14         191 $self->reset;
86 14         221 return $self->next;
87             }
88              
89             sub slice {
90 5     5 0 50 my ($self, $start, $end) = @_;
91 5   66     57 $end ||= $start;
92 5         49 $self->{_place} = $start;
93 5         44 my @return;
94 5         59 while ($self->{_place} <= $end) {
95 11   66     263 push @return, $self->next || last;
96             }
97 5 100       145 return @return if wantarray;
98              
99 1         14 my $slice = $self->new($self->class, \@return, $self->mapper,);
100 1         14 return $slice;
101             }
102              
103             sub delete_all {
104 5     5 0 49 my $self = shift;
105 5 100       154 my $count = $self->count or return;
106 3         44 $self->first->delete;    # to reset counter
107 3         47 while (my $obj = $self->next) {
108 4         600 $obj->delete;
109             }
110 3         34 $self->{_data} = [];
111 3         66 1;
112             }
113              
114 17     17 0 227 sub reset { shift->{_place} = 0 }
115              
116             1;
117