File Coverage

blib/lib/Class/DBI/Frozen/301/Iterator.pm
Criterion Covered Total %
statement 6 45 13.3
branch 0 8 0.0
condition 0 10 0.0
subroutine 2 13 15.3
pod 0 11 0.0
total 8 87 9.2


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 24     24   147 use strict;
  24         47  
  24         4008  
42             use overload
43 24         216 '0+' => 'count',
44 24     24   148 fallback => 1;
  24         182  
45              
46             sub new {
47 0     0 0   my ($me, $them, $data, @mapper) = @_;
48 0   0       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 0     0 0   my ($self, @mapper) = @_;
59 0           $self->{_mapper} = [@mapper];
60 0           $self;
61             }
62              
63 0     0 0   sub class { shift->{_class} }
64 0     0 0   sub data { @{ shift->{_data} } }
  0            
65 0     0 0   sub mapper { @{ shift->{_mapper} } }
  0            
66              
67             sub count {
68 0     0 0   my $self = shift;
69 0   0       $self->{_count} ||= scalar $self->data;
70             }
71              
72             sub next {
73 0     0 0   my $self = shift;
74 0 0         my $use = $self->{_data}->[ $self->{_place}++ ] or return;
75 0           my @obj = ($self->class->construct($use));
76 0           foreach my $meth ($self->mapper) {
77 0           @obj = map $_->$meth(), @obj;
78             }
79 0 0         warn "Discarding extra inflated objects" if @obj > 1;
80 0           return $obj[0];
81             }
82              
83             sub first {
84 0     0 0   my $self = shift;
85 0           $self->reset;
86 0           return $self->next;
87             }
88              
89             sub slice {
90 0     0 0   my ($self, $start, $end) = @_;
91 0   0       $end ||= $start;
92 0           $self->{_place} = $start;
93 0           my @return;
94 0           while ($self->{_place} <= $end) {
95 0   0       push @return, $self->next || last;
96             }
97 0 0         return @return if wantarray;
98              
99 0           my $slice = $self->new($self->class, \@return, $self->mapper,);
100 0           return $slice;
101             }
102              
103             sub delete_all {
104 0     0 0   my $self = shift;
105 0 0         my $count = $self->count or return;
106 0           $self->first->delete; # to reset counter
107 0           while (my $obj = $self->next) {
108 0           $obj->delete;
109             }
110 0           $self->{_data} = [];
111 0           1;
112             }
113              
114 0     0 0   sub reset { shift->{_place} = 0 }
115              
116             1;