File Coverage

blib/lib/Brick/Selectors.pm
Criterion Covered Total %
statement 12 18 66.6
branch 0 6 0.0
condition n/a
subroutine 4 10 40.0
pod n/a
total 16 34 47.0


line stmt bran cond sub pod time code
1             package Brick::Selectors;
2 5     5   30 use strict;
  5         8  
  5         194  
3              
4 5     5   24 use base qw(Exporter);
  5         9  
  5         571  
5 5     5   31 use vars qw($VERSION);
  5         7  
  5         319  
6              
7             $VERSION = '0.905';
8              
9             package Brick::Bucket;
10 5     5   25 use strict;
  5         7  
  5         940  
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 0 0   0     sub{ $_[0]->{field} % 2 ? 0 : 1 };
  0     0      
96             }
97              
98             =item _is_odd_number
99              
100             Returns an anonymous subroutine that returns true if it's argument is
101             odd, and return the empty list otherwise.
102              
103             The anonymous subroutine takes a hash reference as an argument and
104             tests the value with the key C.
105              
106             =cut
107              
108             sub _is_odd_number {
109 0 0   0     sub{ $_[0]->{field} % 2 ? 1 : 0 };
  0     0      
110             }
111              
112             =item _is_tuesday
113              
114             Returns an anonymous subroutine that returns true if the system time
115             indicates it's Tuesday, and return the empty list otherwise.
116              
117             =cut
118              
119             sub _is_tuesday {
120 0 0   0     sub { (localtime)[6] == 2 ? 1 : 0 };
  0     0      
121             }
122              
123             =back
124              
125             =head2 Selector factories
126              
127              
128              
129             =cut
130              
131             =pod
132              
133             sub __normalize_var_name
134             {
135             my $field = shift;
136              
137             $field =~ s/\W/_/g;
138              
139             return $field;
140             }
141              
142             =over 4
143              
144             =item __field_has_string_value( FIELD, VALUE )
145              
146             =cut
147              
148             sub __field_has_string_value
149             {
150             my( $bucket, $setup ) = @_;
151              
152              
153             my $sub = sub {
154             $_[0]->{ $setup->{field} } == $setup->{value} ? 1 : ();
155             };
156              
157              
158             $bucket->__field_has_value( $setup, $sub );
159             }
160              
161             =item __field_has_numeric_value( FIELD, VALUE )
162              
163             =cut
164              
165             sub __field_has_numeric_value
166             {
167             my( $bucket, $setup ) = @_;
168              
169              
170             my $sub = sub {
171             $_[0]->{ $setup->{field} } == $setup->{value} ? 1 : ();
172             };
173              
174              
175             $bucket->__field_has_value( $setup, $sub );
176             }
177              
178             sub __field_has_value
179             {
180             my( $bucket, $setup, $sub ) = @_;
181              
182             my $sub_field = __normalize_var_name( $setup->{field} );
183             my $sub_value = __normalize_var_name( $setup->{value} );
184              
185             my $bucket_class = Brick->bucket_class;
186              
187             my $method_name = "_${sub_field}_is_${sub_value}";
188              
189              
190             {
191             no strict 'refs';
192             *{$method_name} = $sub;
193             }
194              
195              
196             $bucket->add_to_bucket(
197             {
198             name => $method_name,
199             description => "Field [$$setup{field}] has value [$$setup{value}]",
200             code => $sub,
201             }
202             );
203              
204             }
205              
206             =cut
207              
208             =back
209              
210             =head1 TO DO
211              
212             TBA
213              
214             =head1 SEE ALSO
215              
216             L
217              
218             There are selectors in the examples in C.
219              
220             =head1 SOURCE AVAILABILITY
221              
222             This source is in Github:
223              
224             https://github.com/briandfoy/brick
225              
226             =head1 AUTHOR
227              
228             brian d foy, C<< >>
229              
230             =head1 COPYRIGHT
231              
232             Copyright © 2007-2026, brian d foy . All rights reserved.
233              
234             You may redistribute this under the terms of the Artistic License 2.0.
235              
236             =cut
237              
238             1;