File Coverage

blib/lib/Validation/Class/Listing.pm
Criterion Covered Total %
statement 48 94 51.0
branch 9 22 40.9
condition 2 7 28.5
subroutine 13 30 43.3
pod 21 21 100.0
total 93 174 53.4


line stmt bran cond sub pod time code
1             # ABSTRACT: Generic Container Class for an Array Reference
2              
3             package Validation::Class::Listing;
4              
5 109     109   658 use strict;
  109         202  
  109         2862  
6 109     109   474 use warnings;
  109         200  
  109         2828  
7              
8 109     109   515 use Validation::Class::Util '!has', '!hold';
  109         188  
  109         565  
9 109     109   554 use List::MoreUtils 'uniq';
  109         204  
  109         972  
10              
11             our $VERSION = '7.900058'; # VERSION
12              
13              
14              
15             sub new {
16              
17 2636     2636 1 4021 my $class = shift;
18              
19 2636 100       5719 $class = ref $class if ref $class;
20              
21 2636 100       6792 my $arguments = isa_arrayref($_[0]) ? $_[0] : [@_];
22              
23 2636         5523 my $self = bless [], $class;
24              
25 2636         7008 $self->add($arguments);
26              
27 2636         8052 return $self;
28              
29             }
30              
31              
32             sub add {
33              
34 578     578 1 909 my $self = shift;
35              
36 578 100       1385 my $arguments = isa_arrayref($_[0]) ? $_[0] : [@_];
37              
38 578         951 push @{$self}, @{$arguments};
  578         1140  
  578         1009  
39              
40 578         1195 return $self;
41              
42             }
43              
44              
45             sub clear {
46              
47 1696     1696 1 2705 my ($self) = @_;
48              
49 1696         3450 foreach my $pair ($self->pairs) {
50 278         900 $self->delete($pair->{index});
51             }
52              
53 1696         3455 return $self->new;
54              
55             }
56              
57              
58             sub count {
59              
60 1271     1271 1 2245 my ($self) = @_;
61              
62 1271         2303 return scalar($self->list);
63              
64             }
65              
66              
67             sub delete {
68              
69 278     278 1 510 my ($self, $index) = @_;
70              
71 278         566 return delete $self->[$index];
72              
73             }
74              
75              
76             sub defined {
77              
78 0     0 1 0 my ($self, $index) = @_;
79              
80 0         0 return defined $self->[$index];
81              
82             }
83              
84              
85             sub each {
86              
87 0     0 1 0 my ($self, $code) = @_;
88              
89 0   0 0   0 $code ||= sub {};
90              
91 0         0 my $i=0;
92              
93 0         0 foreach my $value ($self->list) {
94              
95 0         0 $code->($i, $value); $i++;
  0         0  
96              
97             }
98              
99 0         0 return $self;
100              
101             }
102              
103              
104             sub first {
105              
106 0     0 1 0 my ($self) = @_;
107              
108 0         0 return $self->[0];
109              
110             }
111              
112              
113             sub get {
114              
115 0     0 1 0 my ($self, $index) = @_;
116              
117 0         0 return $self->[$index];
118              
119             }
120              
121              
122             sub grep {
123              
124 0     0 1 0 my ($self, $pattern) = @_;
125              
126 0 0       0 $pattern = qr/$pattern/ unless "REGEXP" eq uc ref $pattern;
127              
128 0         0 return $self->new(grep { $_ =~ $pattern } ($self->list));
  0         0  
129              
130             }
131              
132              
133             sub has {
134              
135 0     0 1 0 my ($self, $index) = @_;
136              
137 0 0       0 return $self->defined($index) ? 1 : 0;
138              
139             }
140              
141              
142             sub iterator {
143              
144 0     0 1 0 my ($self, $function, @arguments) = @_;
145              
146             $function = 'list'
147 0 0       0 unless grep { $function eq $_ } ('sort', 'rsort', 'nsort', 'rnsort');
  0         0  
148              
149 0         0 my @keys = ($self->$function(@arguments));
150              
151 0 0       0 @keys = $keys[0]->list if $keys[0] eq ref $self;
152              
153 0         0 my $i = 0;
154              
155             return sub {
156              
157 0 0   0   0 return unless defined $keys[$i];
158              
159 0         0 return $keys[$i++];
160              
161             }
162              
163 0         0 }
164              
165              
166             sub join {
167              
168 36     36 1 92 my ($self, $delimiter) = @_;
169              
170 36         85 return join($delimiter, ($self->list));
171              
172             }
173              
174              
175             sub last {
176              
177 0     0 1 0 my ($self) = @_;
178              
179 0         0 return $self->[-1];
180              
181             }
182              
183              
184             sub list {
185              
186 6355     6355 1 8977 my ($self) = @_;
187              
188 6355         7310 return (@{$self});
  6355         17033  
189              
190             }
191              
192              
193             sub nsort {
194              
195 0     0 1 0 my ($self) = @_;
196              
197 0     0   0 my $code = sub { $_[0] <=> $_[1] };
  0         0  
198              
199 0         0 return $self->sort($code);
200              
201             }
202              
203              
204             sub pairs {
205              
206 1696     1696 1 2834 my ($self, $function, @arguments) = @_;
207              
208 1696   50     6143 $function ||= 'list';
209              
210 1696         3589 my @values = ($self->$function(@arguments));
211              
212 1696 100       4512 return () unless @values;
213              
214 167 50 33     775 @values = $values[0]->list if ref $values[0] && ref $values[0] eq ref $self;
215              
216 167         492 my $i=0;
217              
218 167         399 my @pairs = map {{ index => $i++, value => $_ }} (@values);
  278         998  
219              
220 167         585 return (@pairs);
221              
222             }
223              
224              
225             sub rnsort {
226              
227 0     0 1 0 my ($self) = @_;
228              
229 0     0   0 my $code = sub { $_[1] <=> $_[0] };
  0         0  
230              
231 0         0 return $self->sort($code);
232              
233             }
234              
235              
236             sub rsort {
237              
238 0     0 1 0 my ($self) = @_;
239              
240 0     0   0 my $code = sub { $_[1] cmp $_[0] };
  0         0  
241              
242 0         0 return $self->sort($code);
243              
244             }
245              
246              
247             sub sort {
248              
249 0     0 1 0 my ($self, $code) = @_;
250              
251             return "CODE" eq ref $code ?
252 0 0       0 sort { $a->$code($b) } ($self->keys) : sort { $a cmp $b } ($self->list);
  0         0  
  0         0  
253              
254             }
255              
256              
257             sub unique {
258              
259 2697     2697 1 4242 my ($self) = @_;
260              
261 2697         4712 return uniq ($self->list);
262              
263             }
264              
265             1;
266              
267             __END__