line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Brick::Selectors; |
2
|
5
|
|
|
5
|
|
29
|
use strict; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
148
|
|
3
|
|
|
|
|
|
|
|
4
|
5
|
|
|
5
|
|
22
|
use base qw(Exporter); |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
417
|
|
5
|
5
|
|
|
5
|
|
24
|
use vars qw($VERSION); |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
231
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
$VERSION = '0.902'; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
package Brick::Bucket; |
10
|
5
|
|
|
5
|
|
26
|
use strict; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
688
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=encoding utf8 |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 NAME |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
Brick::Selectors - Connect the input data to the closures in the pool |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 SYNOPSIS |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
use Brick::Selectors; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 DESCRIPTION |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
Selectors test a condition, but they don't fail if the test doesn't |
25
|
|
|
|
|
|
|
work. Instead of die-ing, they return C<0>. Composers can |
26
|
|
|
|
|
|
|
use selectors to decide if they want to continue with the rest of the |
27
|
|
|
|
|
|
|
composition or simply skip it and try something else. This requires |
28
|
|
|
|
|
|
|
something like C or |
29
|
|
|
|
|
|
|
C that are designed to |
30
|
|
|
|
|
|
|
handle selectors. |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
The basic use goes like this. I'll make up the completely fake situation |
33
|
|
|
|
|
|
|
where I have to validate a number from user input. If it's odd, It has |
34
|
|
|
|
|
|
|
to be greater than 11 and prime. If it's even, it has to be less than |
35
|
|
|
|
|
|
|
20 and it has to be a tuesday. Here's the tree of decisions: |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
some value |
38
|
|
|
|
|
|
|
/ \ |
39
|
|
|
|
|
|
|
/ \ |
40
|
|
|
|
|
|
|
odd even |
41
|
|
|
|
|
|
|
/ | | \ |
42
|
|
|
|
|
|
|
_is_prime -------+ | | +----- _is_tueday |
43
|
|
|
|
|
|
|
| | |
44
|
|
|
|
|
|
|
/ \ |
45
|
|
|
|
|
|
|
/ \ |
46
|
|
|
|
|
|
|
> 11 < 20 |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
Now, I have to compose subroutines that will do the right thing. The |
50
|
|
|
|
|
|
|
first step is to decide which side of the tree to process. I'll make |
51
|
|
|
|
|
|
|
some selectors. These won't die if they don't pass: |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
my $even_selector = $bucket->_is_even_number; |
54
|
|
|
|
|
|
|
my $odd_selector = $bucket->_is_even_number; |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
I put the selectors together with the subroutines that should run if |
57
|
|
|
|
|
|
|
that selector is true. The selector tells C<__compose_pass_or_stop> |
58
|
|
|
|
|
|
|
to skip the rest of the subroutines without die-ing. The branch |
59
|
|
|
|
|
|
|
effectively turns into a null operation. |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
my $even_branch = $brick->__compose_pass_or_stop( |
62
|
|
|
|
|
|
|
$even_selector, |
63
|
|
|
|
|
|
|
$brick->_is_tuesday, |
64
|
|
|
|
|
|
|
); |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
my $odd_branch = $brick->__compose_pass_or_stop( |
67
|
|
|
|
|
|
|
$odd_selector, |
68
|
|
|
|
|
|
|
$brick->_is_prime( { field => 'number_field_name' } ), |
69
|
|
|
|
|
|
|
); |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
I put the branches together, perhaps with C<__compose_pass_or_skip>. When |
72
|
|
|
|
|
|
|
the first branch runs, if the value isn't even then the selector stops |
73
|
|
|
|
|
|
|
the subroutine in C<$even_branch> and control skips to C<$odd_branch>. |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
my $tester = $brick->__compose_pass_or_skip( |
76
|
|
|
|
|
|
|
$even_branch, |
77
|
|
|
|
|
|
|
$odd_branch, |
78
|
|
|
|
|
|
|
); |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=head2 Sample selectors |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=over 4 |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=item _is_even_number |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
Returns an anonymous subroutine that returns true it's argument is an |
87
|
|
|
|
|
|
|
even number, and return the empty list otherwise. |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
The anonymous subroutine takes a hash reference as an argument and |
90
|
|
|
|
|
|
|
tests the value with the key C. |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=cut |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
sub _is_even_number |
95
|
|
|
|
|
|
|
{ |
96
|
0
|
0
|
|
0
|
|
|
sub{ $_[0]->{field} % 2 ? 0 : 1 }; |
|
0
|
|
|
0
|
|
|
|
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=item _is_odd_number |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
Returns an anonymous subroutine that returns true if it's argument is |
102
|
|
|
|
|
|
|
odd, and return the empty list otherwise. |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
The anonymous subroutine takes a hash reference as an argument and |
105
|
|
|
|
|
|
|
tests the value with the key C. |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=cut |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
sub _is_odd_number |
110
|
|
|
|
|
|
|
{ |
111
|
0
|
0
|
|
0
|
|
|
sub{ $_[0]->{field} % 2 ? 1 : 0 }; |
|
0
|
|
|
0
|
|
|
|
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=item _is_tuesday |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
Returns an anonymous subroutine that returns true if the system time |
117
|
|
|
|
|
|
|
indicates it's Tuesday, and return the empty list otherwise. |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=cut |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub _is_tuesday |
122
|
|
|
|
|
|
|
{ |
123
|
0
|
0
|
|
0
|
|
|
sub { (localtime)[6] == 2 ? 1 : 0 }; |
|
0
|
|
|
0
|
|
|
|
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=back |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=head2 Selector factories |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=cut |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=pod |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
sub __normalize_var_name |
137
|
|
|
|
|
|
|
{ |
138
|
|
|
|
|
|
|
my $field = shift; |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
$field =~ s/\W/_/g; |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
return $field; |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=over 4 |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=item __field_has_string_value( FIELD, VALUE ) |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
=cut |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
sub __field_has_string_value |
152
|
|
|
|
|
|
|
{ |
153
|
|
|
|
|
|
|
my( $bucket, $setup ) = @_; |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
my $sub = sub { |
157
|
|
|
|
|
|
|
$_[0]->{ $setup->{field} } == $setup->{value} ? 1 : (); |
158
|
|
|
|
|
|
|
}; |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
$bucket->__field_has_value( $setup, $sub ); |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=item __field_has_numeric_value( FIELD, VALUE ) |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=cut |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
sub __field_has_numeric_value |
169
|
|
|
|
|
|
|
{ |
170
|
|
|
|
|
|
|
my( $bucket, $setup ) = @_; |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
my $sub = sub { |
174
|
|
|
|
|
|
|
$_[0]->{ $setup->{field} } == $setup->{value} ? 1 : (); |
175
|
|
|
|
|
|
|
}; |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
$bucket->__field_has_value( $setup, $sub ); |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
sub __field_has_value |
182
|
|
|
|
|
|
|
{ |
183
|
|
|
|
|
|
|
my( $bucket, $setup, $sub ) = @_; |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
my $sub_field = __normalize_var_name( $setup->{field} ); |
186
|
|
|
|
|
|
|
my $sub_value = __normalize_var_name( $setup->{value} ); |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
my $bucket_class = Brick->bucket_class; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
my $method_name = "_${sub_field}_is_${sub_value}"; |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
{ |
194
|
|
|
|
|
|
|
no strict 'refs'; |
195
|
|
|
|
|
|
|
*{$method_name} = $sub; |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
$bucket->add_to_bucket( |
200
|
|
|
|
|
|
|
{ |
201
|
|
|
|
|
|
|
name => $method_name, |
202
|
|
|
|
|
|
|
description => "Field [$$setup{field}] has value [$$setup{value}]", |
203
|
|
|
|
|
|
|
code => $sub, |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
); |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
=cut |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=back |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=head1 TO DO |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
TBA |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=head1 SEE ALSO |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
L |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
There are selectors in the examples in C. |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
=head1 SOURCE AVAILABILITY |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
This source is in Github: |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
https://github.com/briandfoy/brick |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=head1 AUTHOR |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
brian d foy, C<< >> |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
=head1 COPYRIGHT |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
Copyright © 2007-2022, brian d foy . All rights reserved. |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
You may redistribute this under the terms of the Artistic License 2.0. |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
=cut |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
1; |