File Coverage

blib/lib/Syntax/Keyword/Junction/None.pm
Criterion Covered Total %
statement 80 80 100.0
branch 50 50 100.0
condition n/a
subroutine 19 19 100.0
pod 0 15 0.0
total 149 164 90.8


line stmt bran cond sub pod time code
1             package Syntax::Keyword::Junction::None;
2 12     12   223714 use strict;
  12         25  
  12         473  
3 12     12   64 use warnings;
  12         25  
  12         885  
4              
5             our $VERSION = '0.003009';
6              
7 12     12   90 use parent 'Syntax::Keyword::Junction::Base';
  12         22  
  12         76  
8              
9             BEGIN {
10 12     12   13932 if (Syntax::Keyword::Junction::Base::_WANT_SMARTMATCH) {
11             eval '#line '.(__LINE__+1).' "' . __FILE__.qq["\n] . <<'END_CODE' or die $@;
12             no if Syntax::Keyword::Junction::Base::_SMARTMATCH_WARNING_CATEGORY,
13             warnings => Syntax::Keyword::Junction::Base::_SMARTMATCH_WARNING_CATEGORY;
14              
15             sub match {
16             my ( $self, $other, $is_rhs ) = @_;
17              
18             if ($is_rhs) {
19             for (@$self) {
20             return if $other ~~ $_;
21             }
22              
23             return 1;
24             }
25              
26             for (@$self) {
27             return if $_ ~~ $other;
28             }
29              
30             return 1;
31             }
32              
33             1;
34             END_CODE
35             }
36             }
37              
38             sub num_eq {
39 13 100   13 0 53 return regex_eq(@_) if ref( $_[1] ) eq 'Regexp';
40              
41 9         25 my ( $self, $test ) = @_;
42              
43 9         23 for (@$self) {
44 19 100       65 return if $_ == $test;
45             }
46              
47 6         31 return 1;
48             }
49              
50             sub num_ne {
51 8 100   8 0 29 return regex_ne(@_) if ref( $_[1] ) eq 'Regexp';
52              
53 2         6 my ( $self, $test ) = @_;
54              
55 2         6 for (@$self) {
56 3 100       14 return if $_ != $test;
57             }
58              
59 1         6 return 1;
60             }
61              
62             sub num_ge {
63 13     13 0 35 my ( $self, $test, $switch ) = @_;
64              
65 13 100       45 return num_le( $self, $test ) if $switch;
66              
67 8         18 for (@$self) {
68 18 100       61 return if $_ >= $test;
69             }
70              
71 3         17 return 1;
72             }
73              
74             sub num_gt {
75 13     13 0 25 my ( $self, $test, $switch ) = @_;
76              
77 13 100       42 return num_lt( $self, $test ) if $switch;
78              
79 9         19 for (@$self) {
80 21 100       61 return if $_ > $test;
81             }
82              
83 4         18 return 1;
84             }
85              
86             sub num_le {
87 12     12 0 25 my ( $self, $test, $switch ) = @_;
88              
89 12 100       37 return num_ge( $self, $test ) if $switch;
90              
91 8         17 for (@$self) {
92 16 100       54 return if $_ <= $test;
93             }
94              
95 4         35 return 1;
96             }
97              
98             sub num_lt {
99 13     13 0 26 my ( $self, $test, $switch ) = @_;
100              
101 13 100       39 return num_gt( $self, $test ) if $switch;
102              
103 8         21 for (@$self) {
104 16 100       52 return if $_ < $test;
105             }
106              
107 4         21 return 1;
108             }
109              
110             sub str_eq {
111 3     3 0 5 my ( $self, $test ) = @_;
112              
113 3         6 for (@$self) {
114 4 100       33 return if $_ eq $test;
115             }
116              
117 1         5 return 1;
118             }
119              
120             sub str_ne {
121 3     3 0 6 my ( $self, $test ) = @_;
122              
123 3         7 for (@$self) {
124 4 100       16 return if $_ ne $test;
125             }
126              
127 1         7 return 1;
128             }
129              
130             sub str_ge {
131 9     9 0 36 my ( $self, $test, $switch ) = @_;
132              
133 9 100       25 return str_le( $self, $test ) if $switch;
134              
135 6         10 for (@$self) {
136 8 100       27 return if $_ ge $test;
137             }
138              
139 2         10 return 1;
140             }
141              
142             sub str_gt {
143 10     10 0 22 my ( $self, $test, $switch ) = @_;
144              
145 10 100       23 return str_lt( $self, $test ) if $switch;
146              
147 7         11 for (@$self) {
148 12 100       34 return if $_ gt $test;
149             }
150              
151 3         12 return 1;
152             }
153              
154             sub str_le {
155 9     9 0 18 my ( $self, $test, $switch ) = @_;
156              
157 9 100       22 return str_ge( $self, $test ) if $switch;
158              
159 6         30 for (@$self) {
160 8 100       28 return if $_ le $test;
161             }
162              
163 2         8 return 1;
164             }
165              
166             sub str_lt {
167 9     9 0 45 my ( $self, $test, $switch ) = @_;
168              
169 9 100       21 return str_gt( $self, $test ) if $switch;
170              
171 6         11 for (@$self) {
172 8 100       27 return if $_ lt $test;
173             }
174              
175 2         9 return 1;
176             }
177              
178             sub regex_eq {
179 4     4 0 8 my ( $self, $test, $switch ) = @_;
180              
181 4         7 for (@$self) {
182 11 100       55 return if $_ =~ $test;
183             }
184              
185 2         7 return 1;
186             }
187              
188             sub regex_ne {
189 6     6 0 10 my ( $self, $test, $switch ) = @_;
190              
191 6         13 for (@$self) {
192 14 100       54 return if $_ !~ $test;
193             }
194              
195 4         13 return 1;
196             }
197              
198             sub bool {
199 2     2 0 150 my ($self) = @_;
200              
201 2         6 for (@$self) {
202 6 100       19 return if $_;
203             }
204              
205 1         5 return 1;
206             }
207              
208             1;
209              
210             __END__
211              
212             =pod
213              
214             =encoding UTF-8
215              
216             =for :stopwords Arthur Axel "fREW" Schmidt Carl Franks
217              
218             =head1 BUGS
219              
220             Please report any bugs or feature requests on the bugtracker website
221             L<https://github.com/haarg/Syntax-Keyword-Junction/issues>
222              
223             When submitting a bug or request, please include a test-file or a
224             patch to an existing test-file that illustrates the bug or desired
225             feature.
226              
227             =head1 AUTHORS
228              
229             =over 4
230              
231             =item *
232              
233             Arthur Axel "fREW" Schmidt <frioux+cpan@gmail.com>
234              
235             =item *
236              
237             Carl Franks
238              
239             =back
240              
241             =head1 COPYRIGHT AND LICENSE
242              
243             This software is copyright (c) 2024 by Arthur Axel "fREW" Schmidt.
244              
245             This is free software; you can redistribute it and/or modify it under
246             the same terms as the Perl 5 programming language system itself.
247              
248             =cut