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 108     108   539 use strict;
  108         201  
  108         4480  
6 108     108   528 use warnings;
  108         195  
  108         3105  
7              
8 108     108   540 use Validation::Class::Util '!has', '!hold';
  108         186  
  108         711  
9 108     108   563 use List::MoreUtils 'uniq';
  108         181  
  108         1105  
10              
11             our $VERSION = '7.900057'; # VERSION
12              
13              
14              
15             sub new {
16              
17 2588     2588 1 4040 my $class = shift;
18              
19 2588 100       6736 $class = ref $class if ref $class;
20              
21 2588 100       8985 my $arguments = isa_arrayref($_[0]) ? $_[0] : [@_];
22              
23 2588         6427 my $self = bless [], $class;
24              
25 2588         8221 $self->add($arguments);
26              
27 2588         11081 return $self;
28              
29             }
30              
31              
32             sub add {
33              
34 569     569 1 914 my $self = shift;
35              
36 569 100       1878 my $arguments = isa_arrayref($_[0]) ? $_[0] : [@_];
37              
38 569         1083 push @{$self}, @{$arguments};
  569         1338  
  569         991  
39              
40 569         1375 return $self;
41              
42             }
43              
44              
45             sub clear {
46              
47 1682     1682 1 2571 my ($self) = @_;
48              
49 1682         4380 foreach my $pair ($self->pairs) {
50 281         999 $self->delete($pair->{index});
51             }
52              
53 1682         4245 return $self->new;
54              
55             }
56              
57              
58             sub count {
59              
60 1263     1263 1 1872 my ($self) = @_;
61              
62 1263         2727 return scalar($self->list);
63              
64             }
65              
66              
67             sub delete {
68              
69 281     281 1 469 my ($self, $index) = @_;
70              
71 281         684 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 81 my ($self, $delimiter) = @_;
169              
170 36         248 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 6285     6285 1 8483 my ($self) = @_;
187              
188 6285         7285 return (@{$self});
  6285         22320  
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 1682     1682 1 2840 my ($self, $function, @arguments) = @_;
207              
208 1682   50     6346 $function ||= 'list';
209              
210 1682         4137 my @values = ($self->$function(@arguments));
211              
212 1682 100       6274 return () unless @values;
213              
214 170 50 33     659 @values = $values[0]->list if ref $values[0] && ref $values[0] eq ref $self;
215              
216 170         294 my $i=0;
217              
218 170         358 my @pairs = map {{ index => $i++, value => $_ }} (@values);
  281         1129  
219              
220 170         604 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 2654     2654 1 3764 my ($self) = @_;
260              
261 2654         5653 return uniq ($self->list);
262              
263             }
264              
265             1;
266              
267             __END__