File Coverage

blib/lib/Data/Transpose/Iterator/Base.pm
Criterion Covered Total %
statement 30 45 66.6
branch 6 12 50.0
condition n/a
subroutine 8 9 88.8
pod 4 5 80.0
total 48 71 67.6


line stmt bran cond sub pod time code
1             package Data::Transpose::Iterator::Base;
2              
3 13     13   30186 use strict;
  13         24  
  13         490  
4 13     13   1283 use warnings;
  13         25  
  13         310  
5              
6 13     13   879 use Moo;
  13         15663  
  13         65  
7              
8             =head1 NAME
9              
10             Data::Transpose::Iterator::Base - Iterator for Data::Transpose.
11              
12             This iterator provides basic methods for iteration, like number
13             of records (count) and getting next record (next).
14              
15             =head1 SYNOPSIS
16              
17             $cart = [{isbn => '978-0-2016-1622-4',
18             title => 'The Pragmatic Programmer',
19             quantity => 1},
20             {isbn => '978-1-4302-1833-3',
21             title => 'Pro Git',
22             quantity => 1},
23             ];
24              
25             $iter = new Data::Transpose::Iterator::Base(records => $cart);
26              
27             print "Count: ", $iter->count, "\n";
28              
29             while ($record = $iter->next) {
30             print "Title: ", $record->title(), "\n";
31             }
32              
33             $iter->reset;
34              
35             $iter->seed({isbn => '978-0-9779201-5-0',
36             title => 'Modern Perl',
37             quantity => 10});
38              
39             =cut
40              
41             sub BUILDARGS {
42 63     63 0 30079 my ( $class, @args ) = @_;
43              
44 63 100       222 if (@args == 1) {
45 2         45 return {records => $args[0]};
46             }
47             else {
48 61         1338 return {@args};
49             }
50             }
51              
52             =head1 ATTRIBUTES
53              
54             =head2 records
55              
56             Creates a Data::Transpose::Iterator::Base object. The elements of the
57             iterator are hash references. They can be passed to the constructor
58             as array or array reference.
59              
60             =cut
61              
62             has records => (
63             is => 'rw',
64             trigger => 1,
65             );
66              
67             =head2 count
68              
69             Number of elements (if supported).
70              
71             =cut
72              
73             has count => (
74             is => 'rwp',
75             lazy => 1,
76             default => sub {return 0;},
77             );
78              
79             =head2 index
80              
81             Current position (starting from 0).
82              
83             =cut
84              
85             has index => (
86             is => 'rwp',
87             lazy => 1,
88             default => sub {return 0;},
89             );
90              
91             =head1 METHODS
92              
93             =head2 next
94              
95             Returns next record or undef.
96              
97             =cut
98              
99             sub next {
100 160     160 1 6014 my ($self) = @_;
101 160         3444 my $index = $self->index;
102              
103 160 50       7383 if ($index <= $self->count) {
104 160         1356 $self->_set_index($index + 1);
105 160         3271 return $self->records->[$index];
106             }
107              
108 0         0 return;
109             };
110              
111              
112             =head2 reset
113              
114             Resets iterator.
115              
116             =cut
117              
118             # Reset method - rewind index of iterator
119             sub reset {
120 191     191 1 295 my ($self) = @_;
121              
122 191         444 $self->_set_index(0);
123              
124 191         3052 return $self;
125             }
126              
127             =head2 seed
128              
129             Seeds iterator.
130              
131             =cut
132              
133             sub seed {
134 3     3 1 2075 my ($self, @args) = @_;
135              
136 3 100       14 if (ref($args[0]) eq 'ARRAY') {
137 1         26 $self->records($args[0]);
138             }
139             else {
140 2         59 $self->records(\@args);
141             }
142              
143 3         72 return $self->count;
144             }
145              
146             =head2 sort
147              
148             Sorts records of the iterator.
149              
150             Parameters are:
151              
152             =over 4
153              
154             =item $sort
155              
156             Field used for sorting.
157              
158             =item $unique
159              
160             Whether results should be unique (optional).
161              
162             =back
163              
164             =cut
165              
166             sub sort {
167 0     0 1 0 my ($self, $sort, $unique) = @_;
168 0         0 my (@data, @tmp);
169              
170 0         0 @data = sort {lc($a->{$sort}) cmp lc($b->{$sort})} @{$self->records};
  0         0  
  0         0  
171              
172 0 0       0 if ($unique) {
173 0         0 my $sort_value = '';
174              
175 0         0 for my $record (@data) {
176 0 0       0 next if $record->{$sort} eq $sort_value;
177 0         0 $sort_value = $record->{$sort};
178 0         0 push (@tmp, $record);
179             }
180              
181 0         0 $self->records(\@tmp);
182             }
183             else {
184 0         0 $self->records(\@data);
185             }
186             }
187              
188             sub _trigger_records {
189 123     123   6868 my ($self, $records) = @_;
190              
191 123 50       365 if (ref($records) eq 'ARRAY') {
192 123         429 $self->_set_count(scalar @$records);
193             }
194             else {
195 0         0 die "Arguments for records should be an arrayref.\n";
196             }
197              
198 123         386 $self->reset;
199             };
200              
201             =head1 AUTHOR
202              
203             Stefan Hornburg (Racke),
204              
205             =head1 LICENSE AND COPYRIGHT
206              
207             Copyright 2010-2016 Stefan Hornburg (Racke) .
208              
209             This program is free software; you can redistribute it and/or modify it
210             under the terms of either: the GNU General Public License as published
211             by the Free Software Foundation; or the Artistic License.
212              
213             See http://dev.perl.org/licenses/ for more information.
214              
215             =cut
216              
217             1;