File Coverage

lib/List/Objects/WithUtils/Array/Junction.pm
Criterion Covered Total %
statement 157 162 96.9
branch 98 100 98.0
condition n/a
subroutine 36 38 94.7
total 291 300 97.0


line stmt bran cond sub code
1         package List::Objects::WithUtils::Array::Junction;
2          
3         { package
4             List::Objects::WithUtils::Array::Junction::Base;
5 93     93   use strictures 1;
  93        
  93        
6 93     93   use parent 'List::Objects::WithUtils::Array';
  93        
  93        
7           use overload
8             '==' => 'num_eq',
9             '!=' => 'num_ne',
10             '>=' => 'num_ge',
11             '>' => 'num_gt',
12             '<=' => 'num_le',
13             '<' => 'num_lt',
14             'eq' => 'str_eq',
15             'ne' => 'str_ne',
16             'ge' => 'str_ge',
17             'gt' => 'str_gt',
18             'le' => 'str_le',
19             'lt' => 'str_lt',
20             'bool' => 'bool',
21 0     0     '""' => sub { shift },
22 93     93   ;
  93        
  93        
23         }
24         { package
25             List::Objects::WithUtils::Array::Junction::All;
26 93     93   use strict; use warnings;
  93     93  
  93        
  93        
  93        
  93        
27           our @ISA = 'List::Objects::WithUtils::Array::Junction::Base';
28          
29           sub num_eq {
30 9 100   9     return regex_eq(@_) if ref $_[1] eq 'Regexp';
31 5           for (@{ $_[0] })
  5        
32 9 100           { return unless $_ == $_[1] }
33             1
34 3         }
35          
36           sub num_ne {
37 9 100   9     return regex_ne(@_) if ref $_[1] eq 'Regexp';
38 5           for (@{ $_[0] })
  5        
39 11 100           { return unless $_ != $_[1] }
40             1
41 3         }
42          
43           sub num_ge {
44 9 100   9     return num_le( @_[0, 1] ) if $_[2];
45 6           for (@{ $_[0] })
  6        
46 14 100           { return unless $_ >= $_[1] }
47             1
48 4         }
49          
50           sub num_gt {
51 8 100   8     return num_lt( @_[0, 1] ) if $_[2];
52 6           for (@{ $_[0] })
  6        
53 12 100           { return unless $_ > $_[1] }
54             1
55 3         }
56          
57           sub num_le {
58 9 100   9     return num_ge( @_[0, 1] ) if $_[2];
59 6           for (@{ $_[0] })
  6        
60 14 100           { return unless $_ <= $_[1] }
61             1
62 4         }
63          
64           sub num_lt {
65 8 100   8     return num_gt( @_[0, 1] ) if $_[2];
66 5           for (@{ $_[0] })
  5        
67 11 100           { return unless $_ < $_[1] }
68             1
69 2         }
70          
71           sub str_eq {
72 2     2     for (@{ $_[0] })
  2        
73 4 100           { return unless $_ eq $_[1] }
74             1
75 1         }
76          
77           sub str_ne {
78 2     2     for (@{ $_[0] })
  2        
79 3 100           { return unless $_ ne $_[1] }
80             1
81 1         }
82          
83           sub str_ge {
84 9 100   9     return str_le( @_[0, 1] ) if $_[2];
85 6           for (@{ $_[0] })
  6        
86 10 100           { return unless $_ ge $_[1] }
87             1
88 4         }
89          
90           sub str_gt {
91 9 100   9     return str_lt( @_[0, 1] ) if $_[2];
92 6           for (@{ $_[0] })
  6        
93 8 100           { return unless $_ gt $_[1] }
94             1
95 2         }
96          
97           sub str_le {
98 9 100   9     return str_ge( @_[0, 1] ) if $_[2];
99 6           for (@{ $_[0] })
  6        
100 10 100           { return unless $_ le $_[1] }
101             1
102 4         }
103          
104           sub str_lt {
105 9 100   9     return str_gt( @_[0, 1] ) if $_[2];
106 6           for (@{ $_[0] })
  6        
107 8 100           { return unless $_ lt $_[1] }
108             1
109 2         }
110          
111           sub regex_eq {
112 4     4     for (@{ $_[0] })
  4        
113 8 100           { return unless $_ =~ $_[1] }
114             1
115 2         }
116          
117           sub regex_ne {
118 4     4     for (@{ $_[0] })
  4        
119 10 100           { return unless $_ !~ $_[1] }
120             1
121 2         }
122          
123           sub bool {
124 4     4     for (@{ $_[0] })
  4        
125 7 100           { return unless $_ }
126             1
127 1         }
128          
129         }
130          
131         { package
132             List::Objects::WithUtils::Array::Junction::Any;
133 93     93   use strict; use warnings;
  93     93  
  93        
  93        
  93        
  93        
134           our @ISA = 'List::Objects::WithUtils::Array::Junction::Base';
135          
136           sub num_eq {
137 6 100   6     return regex_eq(@_) if ref $_[1] eq 'Regexp';
138 4           for (@{ $_[0] })
  4        
139 7 100           { return 1 if $_ == $_[1] }
140             ()
141 1         }
142          
143           sub num_ne {
144 4 100   4     return regex_eq(@_) if ref $_[1] eq 'Regexp';
145 3           for (@{ $_[0] })
  3        
146 5 100           { return 1 if $_ != $_[1] }
147             ()
148 1         }
149          
150           sub num_ge {
151 9 100   9     return num_le( @_[0, 1] ) if $_[2];
152 6           for (@{ $_[0] })
  6        
153 14 100           { return 1 if $_ >= $_[1] }
154             ()
155 2         }
156          
157           sub num_gt {
158 10 100   10     return num_lt( @_[0, 1] ) if $_[2];
159 7           for (@{ $_[0] })
  7        
160 16 100           { return 1 if $_ > $_[1] }
161             ()
162 2         }
163          
164           sub num_le {
165 9 100   9     return num_ge( @_[0, 1] ) if $_[2];
166 6           for (@{ $_[0] })
  6        
167 10 100           { return 1 if $_ <= $_[1] }
168             ()
169 2         }
170          
171           sub num_lt {
172 9 100   9     return num_gt( @_[0, 1] ) if $_[2];
173 6           for (@{ $_[0] })
  6        
174 10 100           { return 1 if $_ < $_[1] }
175             ()
176 2         }
177          
178           sub str_eq {
179 2     2     for (@{ $_[0] })
  2        
180 3 100           { return 1 if $_ eq $_[1] }
181             ()
182 1         }
183          
184           sub str_ne {
185 2     2     for (@{ $_[0] })
  2        
186 4 100           { return 1 if $_ ne $_[1] }
187             ()
188 1         }
189          
190           sub str_ge {
191 9 100   9     return str_le( @_[0, 1] ) if $_[2];
192 6           for (@{ $_[0] })
  6        
193 8 100           { return 1 if $_ ge $_[1] }
194             ()
195 2         }
196          
197           sub str_gt {
198 10 100   10     return str_lt( @_[0, 1] ) if $_[2];
199 6           for (@{ $_[0] })
  6        
200 9 100           { return 1 if $_ gt $_[1] }
201             ()
202 2         }
203          
204           sub str_le {
205 9 100   9     return str_ge( @_[0, 1] ) if $_[2];
206 6           for (@{ $_[0] })
  6        
207 8 100           { return 1 if $_ le $_[1] }
208             ()
209 2         }
210          
211           sub str_lt {
212 10 100   10     return str_gt( @_[0, 1] ) if $_[2];
213 7           for (@{ $_[0] })
  7        
214 12 100           { return 1 if $_ lt $_[1] }
215             ()
216 3         }
217          
218           sub regex_eq {
219 3     3     for (@{ $_[0] })
  3        
220 5 100           { return 1 if $_ =~ $_[1] }
221             ()
222 1         }
223          
224           sub regex_ne {
225 0     0     for (@{ $_[0] })
  0        
226 0 0           { return 1 if $_ !~ $_[1] }
227             ()
228 0         }
229          
230           sub bool {
231 3     3     for (@{ $_[0] })
  3        
232 5 100           { return 1 if $_ }
233             ()
234 1         }
235         }
236          
237         1;
238          
239         =pod
240        
241         =for Pod::Coverage new
242        
243         =head1 NAME
244        
245         List::Objects::WithUtils::Array::Junction - Lightweight junction classes
246        
247         =head1 SYNOPSIS
248        
249         # See List::Objects::WithUtils::Role::Array::WithJunctions
250        
251         =head1 DESCRIPTION
252        
253         These are light-weight junction objects covering most of the functionality
254         provided by L<Syntax::Keyword::Junction>. They provide the objects created by
255         the C<all_items> and C<any_items> methods defined by
256         L<List::Objects::WithUtils::Role::Array::WithJunctions>.
257        
258         Only the junction types used by L<List::Objects::WithUtils> ('any' and 'all')
259         are implemented; nothing is exported. The C<~~> smart-match operator is not
260         supported. See L<Syntax::Keyword::Junction> if you were looking for a
261         stand-alone implementation with more features.
262        
263         The junction objects produced are subclasses of
264         L<List::Objects::WithUtils::Array>.
265        
266         See L<List::Objects::WithUtils::Role::Array::WithJunctions> for usage details.
267        
268         =head2 Motivation
269        
270         My original goal was to get L<Sub::Exporter> out of the
271         L<List::Objects::WithUtils> dependency tree; that one came along with
272         L<Syntax::Keyword::Junction>.
273        
274         L<Perl6::Junction> would have done that for me. Unfortunately, that comes with
275         some unresolved RT bugs right now that are reasonably annoying (especially
276         warnings under perl-5.18.x).
277        
278         =head1 AUTHOR
279        
280         This code is originally derived from L<Perl6::Junction> by way of
281         L<Syntax::Keyword::Junction>; the original author is Carl Franks, based on the
282         Perl6 design documentation.
283        
284         Adapted to L<List::Objects::WithUtils> by Jon Portnoy <avenj@cobaltirc.org>
285