File Coverage

blib/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
pod n/a
total 291 300 97.0


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