File Coverage

blib/lib/Syntax/Keyword/Junction/Any.pm
Criterion Covered Total %
statement 89 92 96.7
branch 54 58 93.1
condition n/a
subroutine 21 21 100.0
pod 0 16 0.0
total 164 187 87.7


line stmt bran cond sub pod time code
1             package Syntax::Keyword::Junction::Any;
2              
3 10     10   59 use strict;
  10         19  
  10         402  
4 10     10   54 use warnings;
  10         18  
  10         638  
5              
6             our $VERSION = '0.003008'; # VERSION
7              
8 10     10   56 use parent 'Syntax::Keyword::Junction::Base';
  10         20  
  10         74  
9              
10             BEGIN {
11 10 50   10   1067 if ($] >= 5.010001) {
12 10 100   10 0 1210 eval q|
  10 50   3   60  
  10 0       23  
  10         228  
  3         7  
  3         8  
  3         6  
  7         134  
  1         37  
  0         0  
  0         0  
  0         0  
13             sub match {
14             no if $] > 5.017010, warnings => 'experimental::smartmatch';
15             my ( $self, $other, $is_rhs ) = @_;
16              
17             if ($is_rhs) {
18             for (@$self) {
19             return 1 if $other ~~ $_;
20             }
21              
22             return;
23             }
24              
25             for (@$self) {
26             return 1 if $_ ~~ $other;
27             }
28              
29             return;
30             }
31             |
32             }
33             }
34              
35             sub num_eq {
36 18 100   18 0 87 return regex_eq(@_) if ref( $_[1] ) eq 'Regexp';
37              
38 13         30 my ( $self, $test ) = @_;
39              
40 13         35 for (@$self) {
41 21 100       320 return 1 if $_ == $test;
42             }
43              
44 3         17 return;
45             }
46              
47             sub num_ne {
48 6 100   6 0 32 return regex_ne(@_) if ref( $_[1] ) eq 'Regexp';
49              
50 3         8 my ( $self, $test ) = @_;
51              
52 3         9 for (@$self) {
53 5 100       25 return 1 if $_ != $test;
54             }
55              
56 1         6 return;
57             }
58              
59             sub num_ge {
60 10     10 0 29 my ( $self, $test, $switch ) = @_;
61              
62 10 100       35 return num_le( $self, $test ) if $switch;
63              
64 7         21 for (@$self) {
65 17 100       127 return 1 if $_ >= $test;
66             }
67              
68 2         13 return;
69             }
70              
71             sub num_gt {
72 12     12 0 22 my ( $self, $test, $switch ) = @_;
73              
74 12 100       39 return num_lt( $self, $test ) if $switch;
75              
76 6         47 for (@$self) {
77 13 100       58 return 1 if $_ > $test;
78             }
79              
80 2         11 return;
81             }
82              
83             sub num_le {
84 9     9 0 21 my ( $self, $test, $switch ) = @_;
85              
86 9 100       50 return num_ge( $self, $test ) if $switch;
87              
88 6         17 for (@$self) {
89 10 100       42 return 1 if $_ <= $test;
90             }
91              
92 2         21 return;
93             }
94              
95             sub num_lt {
96 12     12 0 23 my ( $self, $test, $switch ) = @_;
97              
98 12 100       36 return num_gt( $self, $test ) if $switch;
99              
100 9         25 for (@$self) {
101 15 100       56 return 1 if $_ < $test;
102             }
103              
104 2         10 return;
105             }
106              
107             sub str_eq {
108 3     3 0 8 my ( $self, $test ) = @_;
109              
110 3         8 for (@$self) {
111 4 100       20 return 1 if $_ eq $test;
112             }
113              
114 1         6 return;
115             }
116              
117             sub str_ne {
118 2     2 0 5 my ( $self, $test ) = @_;
119              
120 2         5 for (@$self) {
121 4 100       29 return 1 if $_ ne $test;
122             }
123              
124 1         6 return;
125             }
126              
127             sub str_ge {
128 9     9 0 18 my ( $self, $test, $switch ) = @_;
129              
130 9 100       30 return str_le( $self, $test ) if $switch;
131              
132 6         14 for (@$self) {
133 8 100       39 return 1 if $_ ge $test;
134             }
135              
136 2         11 return;
137             }
138              
139             sub str_gt {
140 10     10 0 22 my ( $self, $test, $switch ) = @_;
141              
142 10 100       33 return str_lt( $self, $test ) if $switch;
143              
144 6         17 for (@$self) {
145 9 100       69 return 1 if $_ gt $test;
146             }
147              
148 2         18 return;
149             }
150              
151             sub str_le {
152 9     9 0 21 my ( $self, $test, $switch ) = @_;
153              
154 9 100       25 return str_ge( $self, $test ) if $switch;
155              
156 6         13 for (@$self) {
157 8 100       130 return 1 if $_ le $test;
158             }
159              
160 2         18 return;
161             }
162              
163             sub str_lt {
164 10     10 0 20 my ( $self, $test, $switch ) = @_;
165              
166 10 100       29 return str_gt( $self, $test ) if $switch;
167              
168 7         16 for (@$self) {
169 12 100       49 return 1 if $_ lt $test;
170             }
171              
172 3         16 return;
173             }
174              
175             sub regex_eq {
176 5     5 0 10 my ( $self, $test, $switch ) = @_;
177              
178 5         13 for (@$self) {
179 11 100       64 return 1 if $_ =~ $test;
180             }
181              
182 3         16 return;
183             }
184              
185             sub regex_ne {
186 3     3 0 6 my ( $self, $test, $switch ) = @_;
187              
188 3         7 for (@$self) {
189 9 100       65 return 1 if $_ !~ $test;
190             }
191              
192 1         6 return;
193             }
194              
195             sub bool {
196 3     3 0 35 my ($self) = @_;
197              
198 3         9 for (@$self) {
199 5 100       19 return 1 if $_;
200             }
201              
202 1         6 return;
203             }
204              
205             1;
206              
207             __END__