File Coverage

blib/lib/Venus/Gather.pm
Criterion Covered Total %
statement 122 128 95.3
branch 39 52 75.0
condition 12 18 66.6
subroutine 31 31 100.0
pod 13 14 92.8
total 217 243 89.3


line stmt bran cond sub pod time code
1             package Venus::Gather;
2              
3 1     1   66 use 5.018;
  1         5  
4              
5 1     1   5 use strict;
  1         3  
  1         35  
6 1     1   6 use warnings;
  1         1  
  1         31  
7              
8 1     1   4 use Venus::Class 'attr', 'base', 'with';
  1         2  
  1         9  
9              
10             base 'Venus::Kind::Utility';
11              
12             with 'Venus::Role::Valuable';
13             with 'Venus::Role::Buildable';
14             with 'Venus::Role::Accessible';
15              
16 1     1   8 use Scalar::Util ();
  1         2  
  1         1642  
17              
18             # ATTRIBUTES
19              
20             attr 'on_none';
21             attr 'on_only';
22             attr 'on_then';
23             attr 'on_when';
24              
25             # BUILDERS
26              
27             sub build_self {
28 34     34 0 62 my ($self, $data) = @_;
29              
30 34 50   5   72 $self->on_none(sub{}) if !$self->on_none;
31 34 50   31   88 $self->on_only(sub{1}) if !$self->on_only;
  31         57  
32 34 50       85 $self->on_then([]) if !$self->on_then;
33 34 50       80 $self->on_when([]) if !$self->on_when;
34              
35 34         63 return $self;
36             }
37              
38             # METHODS
39              
40             sub clear {
41 1     1 1 3 my ($self) = @_;
42              
43 1     1   7 $self->on_none(sub{});
44 1     1   7 $self->on_only(sub{1});
  1         4  
45 1         4 $self->on_then([]);
46 1         4 $self->on_when([]);
47              
48 1         14 return $self;
49             }
50              
51             sub data {
52 2     2 1 5 my ($self, $data) = @_;
53              
54 2         10 while(my($key, $value) = each(%$data)) {
55 11         16 $self->just($key)->then($value);
56             }
57              
58 2         35 return $self;
59             }
60              
61             sub expr {
62 12     12 1 25 my ($self, $topic) = @_;
63              
64             $self->when(sub{
65 63     63   77 my $value = $_[0];
66              
67 63 50       96 if (!defined $value) {
68 0         0 return false;
69             }
70 63 50 33     119 if (Scalar::Util::blessed($value) && !overload::Overloaded($value)) {
71 0         0 return false;
72             }
73 63 50 33     167 if (!Scalar::Util::blessed($value) && ref($value)) {
74 0         0 return false;
75             }
76 63 100 100     346 if (ref($topic) eq 'Regexp' && "$value" =~ qr/$topic/) {
    100          
77 24         51 return true;
78             }
79             elsif ("$value" eq "$topic") {
80 1         4 return true;
81             }
82             else {
83 38         71 return false;
84             }
85 12         51 });
86              
87 12         38 return $self;
88             }
89              
90             sub just {
91 58     58 1 125 my ($self, $topic) = @_;
92              
93             $self->when(sub{
94 344     344   371 my $value = $_[0];
95              
96 344 50       479 if (!defined $value) {
97 0         0 return false;
98             }
99 344 50 66     696 if (Scalar::Util::blessed($value) && !overload::Overloaded($value)) {
100 0         0 return false;
101             }
102 344 50 66     1678 if (!Scalar::Util::blessed($value) && ref($value)) {
103 0         0 return false;
104             }
105 344 100       565 if ("$value" eq "$topic") {
106 34         64 return true;
107             }
108             else {
109 310         462 return false;
110             }
111 58         230 });
112              
113 58         192 return $self;
114             }
115              
116             sub none {
117 6     6 1 15 my ($self, $code) = @_;
118              
119 6 100   1   47 $self->on_none(UNIVERSAL::isa($code, 'CODE') ? $code : sub{$code});
  1         10  
120              
121 6         72 return $self;
122             }
123              
124             sub only {
125 2     2 1 5 my ($self, $code) = @_;
126              
127 2         7 $self->on_only($code);
128              
129 2         31 return $self;
130             }
131              
132             sub result {
133 31     31 1 63 my ($self, $data) = @_;
134              
135 31 100       86 $self->value(ref $data eq 'ARRAY' ? $data : [$data]) if $data;
    100          
136              
137 31         74 my $value = $self->value;
138 31         49 my $result = [];
139 31         43 my $matched = 0;
140              
141 31         50 local $_ = $value;
142 31 50       59 return wantarray ? ($result, $matched) : $result if !$self->on_only->($value);
    100          
143              
144 30         55 for my $item (@$value) {
145 231         277 local $_ = $item;
146 231         275 for (my $i = 0; $i < @{$self->on_when}; $i++) {
  606         922  
147 435 100       635 if ($self->on_when->[$i]->($item)) {
148 60         131 push @$result, $self->on_then->[$i]->($item);
149 60         75 $matched++;
150 60         103 last;
151             }
152             }
153             }
154              
155 30 100       54 if (!@$result) {
156 9         16 local $_ = $value;
157 9         14 my @return = ($self->on_none->($value));
158             push @$result,
159 9 100 100     42 ((@return == 1 && ref($return[0]) eq 'ARRAY') ? @{$return[0]} : @return);
  1         4  
160             }
161              
162 30 100       181 return wantarray ? ($result, $matched) : $result;
163             }
164              
165             sub skip {
166 1     1 1 3 my ($self) = @_;
167              
168 1     4   6 $self->then(sub{return ()});
  4         6  
169              
170 1         14 return $self;
171             }
172              
173             sub take {
174 3     3 1 8 my ($self) = @_;
175              
176 3     14   11 $self->then(sub{return (@_)});
  14         27  
177              
178 3         42 return $self;
179             }
180              
181             sub test {
182 2     2 1 4 my ($self) = @_;
183              
184 2         3 my $matched = 0;
185              
186 2         6 my $value = $self->value;
187              
188 2         4 local $_ = $value;
189 2 50       6 return $matched if !$self->on_only->($value);
190              
191 2         5 for my $item (@$value) {
192 20         21 local $_ = $item;
193 20         25 for (my $i = 0; $i < @{$self->on_when}; $i++) {
  57         82  
194 39 100       60 if ($self->on_when->[$i]->($item)) {
195 2         3 $matched++;
196 2         5 last;
197             }
198             }
199             }
200              
201 2         10 return $matched;
202             }
203              
204             sub then {
205 78     78 1 98 my ($self, $code) = @_;
206              
207 78         92 my $next = $#{$self->on_when};
  78         137  
208              
209 78 100   35   300 $self->on_then->[$next] = UNIVERSAL::isa($code, 'CODE') ? $code : sub{$code};
  35         52  
210              
211 78         846 return $self;
212             }
213              
214             sub when {
215 77     77 1 137 my ($self, $code, @args) = @_;
216              
217 77 50       90 my $next = (@{$self->on_when}-$#{$self->on_then}) > 1 ? -1 : @{$self->on_when};
  77         127  
  77         119  
  77         122  
218              
219             $self->on_when->[$next] = sub {
220 474     474   1564 (local $_ = $_[0])->$code(@args);
221 77         260 };
222              
223 77         159 return $self;
224             }
225              
226             sub where {
227 6     6 1 11 my ($self) = @_;
228              
229 6         9 my $where = $self->new;
230              
231 6     5   25 $self->then(sub{@{scalar($where->result(@_))}});
  5         6  
  5         11  
232              
233 6         103 return $where;
234             }
235              
236             1;
237              
238              
239              
240             =head1 NAME
241              
242             Venus::Gather - Gather Class
243              
244             =cut
245              
246             =head1 ABSTRACT
247              
248             Gather Class for Perl 5
249              
250             =cut
251              
252             =head1 SYNOPSIS
253              
254             package main;
255              
256             use Venus::Gather;
257              
258             my $gather = Venus::Gather->new([
259             "one",
260             "two",
261             "three",
262             "four",
263             "five",
264             "six",
265             "seven",
266             "eight",
267             "nine",
268             "zero",
269             ]);
270              
271             $gather->when(sub{$_ eq 1})->then(sub{"one"});
272             $gather->when(sub{$_ eq 2})->then(sub{"two"});
273              
274             $gather->none(sub{"?"});
275              
276             my $result = $gather->result;
277              
278             # ["?"]
279              
280             =cut
281              
282             =head1 DESCRIPTION
283              
284             This package provides an object-oriented interface for complex pattern matching
285             operations on collections of data, e.g. array references. See L
286             for operating on scalar values.
287              
288             =cut
289              
290             =head1 ATTRIBUTES
291              
292             This package has the following attributes:
293              
294             =cut
295              
296             =head2 on_none
297              
298             on_none(CodeRef)
299              
300             This attribute is read-write, accepts C<(CodeRef)> values, is optional, and defaults to C.
301              
302             =cut
303              
304             =head2 on_only
305              
306             on_only(CodeRef)
307              
308             This attribute is read-write, accepts C<(CodeRef)> values, is optional, and defaults to C.
309              
310             =cut
311              
312             =head2 on_then
313              
314             on_then(ArrayRef[CodeRef])
315              
316             This attribute is read-write, accepts C<(ArrayRef[CodeRef])> values, is optional, and defaults to C<[]>.
317              
318             =cut
319              
320             =head2 on_when
321              
322             on_when(ArrayRef[CodeRef])
323              
324             This attribute is read-write, accepts C<(ArrayRef[CodeRef])> values, is optional, and defaults to C<[]>.
325              
326             =cut
327              
328             =head1 INHERITS
329              
330             This package inherits behaviors from:
331              
332             L
333              
334             =cut
335              
336             =head1 INTEGRATES
337              
338             This package integrates behaviors from:
339              
340             L
341              
342             L
343              
344             L
345              
346             =cut
347              
348             =head1 METHODS
349              
350             This package provides the following methods:
351              
352             =cut
353              
354             =head2 clear
355              
356             clear() (Gather)
357              
358             The clear method resets all gather conditions and returns the invocant.
359              
360             I>
361              
362             =over 4
363              
364             =item clear example 1
365              
366             # given: synopsis
367              
368             package main;
369              
370             my $clear = $gather->clear;
371              
372             # bless(..., "Venus::Gather")
373              
374             =back
375              
376             =cut
377              
378             =head2 data
379              
380             data(HashRef $data) (Gather)
381              
382             The data method takes a hashref (i.e. lookup table) and creates gather
383             conditions and actions based on the keys and values found.
384              
385             I>
386              
387             =over 4
388              
389             =item data example 1
390              
391             package main;
392              
393             use Venus::Gather;
394              
395             my $gather = Venus::Gather->new([
396             "one",
397             "two",
398             "three",
399             "four",
400             "five",
401             "six",
402             "seven",
403             "eight",
404             "nine",
405             "zero",
406             ]);
407              
408             $gather->data({
409             "one" => 1,
410             "two" => 2,
411             "three" => 3,
412             "four" => 4,
413             "five" => 5,
414             "six" => 6,
415             "seven" => 7,
416             "eight" => 8,
417             "nine" => 9,
418             "zero" => 0,
419             });
420              
421             my $result = $gather->none('?')->result;
422              
423             # [1..9, 0]
424              
425             =back
426              
427             =over 4
428              
429             =item data example 2
430              
431             package main;
432              
433             use Venus::Gather;
434              
435             my $gather = Venus::Gather->new([
436             "one",
437             "two",
438             "three",
439             "four",
440             "five",
441             "six",
442             "seven",
443             "eight",
444             "nine",
445             "zero",
446             ]);
447              
448             $gather->data({
449             "zero" => 0,
450             });
451              
452             my $result = $gather->none('?')->result;
453              
454             # [0]
455              
456             =back
457              
458             =cut
459              
460             =head2 expr
461              
462             expr(Str | RegexpRef $expr) (Gather)
463              
464             The expr method registers a L condition that check if the match value is
465             an exact string match of the C<$topic> if the topic is a string, or that it
466             matches against the topic if the topic is a regular expression.
467              
468             I>
469              
470             =over 4
471              
472             =item expr example 1
473              
474             package main;
475              
476             use Venus::Gather;
477              
478             my $gather = Venus::Gather->new([
479             "one",
480             "two",
481             "three",
482             "four",
483             "five",
484             "six",
485             "seven",
486             "eight",
487             "nine",
488             "zero",
489             ]);
490              
491             $gather->expr('one')->then(sub{[split //]});
492              
493             my $result = $gather->result;
494              
495             # [["o", "n", "e"]]
496              
497             =back
498              
499             =over 4
500              
501             =item expr example 2
502              
503             package main;
504              
505             use Venus::Gather;
506              
507             my $gather = Venus::Gather->new([
508             "one",
509             "two",
510             "three",
511             "four",
512             "five",
513             "six",
514             "seven",
515             "eight",
516             "nine",
517             "zero",
518             ]);
519              
520             $gather->expr(qr/^o/)->then(sub{[split //]});
521              
522             my $result = $gather->result;
523              
524             # [["o", "n", "e"]]
525              
526             =back
527              
528             =cut
529              
530             =head2 just
531              
532             just(Str $topic) (Gather)
533              
534             The just method registers a L condition that check if the match value is
535             an exact string match of the C<$topic> provided.
536              
537             I>
538              
539             =over 4
540              
541             =item just example 1
542              
543             package main;
544              
545             use Venus::Gather;
546              
547             my $gather = Venus::Gather->new([
548             "one",
549             "two",
550             "three",
551             "four",
552             "five",
553             "six",
554             "seven",
555             "eight",
556             "nine",
557             "zero",
558             ]);
559              
560             $gather->just('one')->then(1);
561             $gather->just('two')->then(2);
562             $gather->just('three')->then(3);
563              
564             my $result = $gather->result;
565              
566             # [1,2,3]
567              
568             =back
569              
570             =over 4
571              
572             =item just example 2
573              
574             package main;
575              
576             use Venus::Gather;
577             use Venus::String;
578              
579             my $gather = Venus::Gather->new([
580             Venus::String->new("one"),
581             Venus::String->new("two"),
582             Venus::String->new("three"),
583             Venus::String->new("four"),
584             Venus::String->new("five"),
585             Venus::String->new("six"),
586             Venus::String->new("seven"),
587             Venus::String->new("eight"),
588             Venus::String->new("nine"),
589             Venus::String->new("zero"),
590             ]);
591              
592             $gather->just('one')->then(1);
593             $gather->just('two')->then(2);
594             $gather->just('three')->then(3);
595              
596             my $result = $gather->result;
597              
598             # [1,2,3]
599              
600             =back
601              
602             =over 4
603              
604             =item just example 3
605              
606             package main;
607              
608             use Venus::Gather;
609             use Venus::String;
610              
611             my $gather = Venus::Gather->new([
612             Venus::String->new("one"),
613             Venus::String->new("two"),
614             Venus::String->new("three"),
615             Venus::String->new("four"),
616             Venus::String->new("five"),
617             Venus::String->new("six"),
618             Venus::String->new("seven"),
619             Venus::String->new("eight"),
620             Venus::String->new("nine"),
621             Venus::String->new("zero"),
622             ]);
623              
624             $gather->just('one')->then(1);
625             $gather->just('six')->then(6);
626              
627             my $result = $gather->result;
628              
629             # [1,6]
630              
631             =back
632              
633             =cut
634              
635             =head2 none
636              
637             none(Any | CodeRef $code) (Gather)
638              
639             The none method registers a special condition that returns a result only when
640             no other conditions have been matched.
641              
642             I>
643              
644             =over 4
645              
646             =item none example 1
647              
648             package main;
649              
650             use Venus::Gather;
651              
652             my $gather = Venus::Gather->new([
653             "one",
654             "two",
655             "three",
656             "four",
657             "five",
658             "six",
659             "seven",
660             "eight",
661             "nine",
662             "zero",
663             ]);
664              
665             $gather->just('ten')->then(10);
666              
667             $gather->none('none');
668              
669             my $result = $gather->result;
670              
671             # ["none"]
672              
673             =back
674              
675             =over 4
676              
677             =item none example 2
678              
679             package main;
680              
681             use Venus::Gather;
682              
683             my $gather = Venus::Gather->new([
684             "one",
685             "two",
686             "three",
687             "four",
688             "five",
689             "six",
690             "seven",
691             "eight",
692             "nine",
693             "zero",
694             ]);
695              
696             $gather->just('ten')->then(10);
697              
698             $gather->none(sub{[map "no $_", @$_]});
699              
700             my $result = $gather->result;
701              
702             # [
703             # "no one",
704             # "no two",
705             # "no three",
706             # "no four",
707             # "no five",
708             # "no six",
709             # "no seven",
710             # "no eight",
711             # "no nine",
712             # "no zero",
713             # ]
714              
715             =back
716              
717             =cut
718              
719             =head2 only
720              
721             only(CodeRef $code) (Gather)
722              
723             The only method registers a special condition that only allows matching on the
724             value only if the code provided returns truthy.
725              
726             I>
727              
728             =over 4
729              
730             =item only example 1
731              
732             package main;
733              
734             use Venus::Gather;
735              
736             my $gather = Venus::Gather->new([
737             "one",
738             "two",
739             "three",
740             "four",
741             "five",
742             "six",
743             "seven",
744             "eight",
745             "nine",
746             "zero",
747             ]);
748              
749             $gather->only(sub{grep /^[A-Z]/, @$_});
750              
751             $gather->just('one')->then(1);
752              
753             my $result = $gather->result;
754              
755             # []
756              
757             =back
758              
759             =over 4
760              
761             =item only example 2
762              
763             package main;
764              
765             use Venus::Gather;
766              
767             my $gather = Venus::Gather->new([
768             "one",
769             "two",
770             "three",
771             "four",
772             "five",
773             "six",
774             "seven",
775             "eight",
776             "nine",
777             "zero",
778             ]);
779              
780             $gather->only(sub{grep /e$/, @$_});
781              
782             $gather->expr(qr/e$/)->take;
783              
784             my $result = $gather->result;
785              
786             # [
787             # "one",
788             # "three",
789             # "five",
790             # "nine",
791             # ]
792              
793             =back
794              
795             =cut
796              
797             =head2 result
798              
799             result(Any $data) (Any)
800              
801             The result method evaluates the registered conditions and returns the result of
802             the action (i.e. the L code) or the special L condition if there
803             were no matches. In list context, this method returns both the result and
804             whether or not a condition matched. Optionally, when passed an argument this
805             method assign the argument as the value/topic and then perform the operation.
806              
807             I>
808              
809             =over 4
810              
811             =item result example 1
812              
813             package main;
814              
815             use Venus::Gather;
816              
817             my $gather = Venus::Gather->new([
818             "one",
819             "two",
820             "three",
821             "four",
822             "five",
823             "six",
824             "seven",
825             "eight",
826             "nine",
827             "zero",
828             ]);
829              
830             $gather->just('one')->then(1);
831             $gather->just('six')->then(6);
832              
833             my $result = $gather->result;
834              
835             # [1,6]
836              
837             =back
838              
839             =over 4
840              
841             =item result example 2
842              
843             package main;
844              
845             use Venus::Gather;
846              
847             my $gather = Venus::Gather->new([
848             "one",
849             "two",
850             "three",
851             "four",
852             "five",
853             "six",
854             "seven",
855             "eight",
856             "nine",
857             "zero",
858             ]);
859              
860             $gather->just('one')->then(1);
861             $gather->just('six')->then(6);
862              
863             my ($result, $gathered) = $gather->result;
864              
865             # ([1,6], 2)
866              
867             =back
868              
869             =over 4
870              
871             =item result example 3
872              
873             package main;
874              
875             use Venus::Gather;
876              
877             my $gather = Venus::Gather->new([
878             "one",
879             "two",
880             "three",
881             "four",
882             "five",
883             "six",
884             "seven",
885             "eight",
886             "nine",
887             "zero",
888             ]);
889              
890             $gather->just('One')->then(1);
891             $gather->just('Six')->then(6);
892              
893             my ($result, $gathered) = $gather->result;
894              
895             # ([], 0)
896              
897             =back
898              
899             =over 4
900              
901             =item result example 4
902              
903             package main;
904              
905             use Venus::Gather;
906              
907             my $gather = Venus::Gather->new([
908             "one",
909             "two",
910             "three",
911             "four",
912             "five",
913             "six",
914             "seven",
915             "eight",
916             "nine",
917             "zero",
918             ]);
919              
920             $gather->just(1)->then(1);
921             $gather->just(6)->then(6);
922              
923             my $result = $gather->result([1..9, 0]);
924              
925             # [1,6]
926              
927             =back
928              
929             =over 4
930              
931             =item result example 5
932              
933             package main;
934              
935             use Venus::Gather;
936              
937             my $gather = Venus::Gather->new([
938             "one",
939             "two",
940             "three",
941             "four",
942             "five",
943             "six",
944             "seven",
945             "eight",
946             "nine",
947             "zero",
948             ]);
949              
950             $gather->just('one')->then(1);
951             $gather->just('six')->then(6);
952              
953             my $result = $gather->result([10..20]);
954              
955             # []
956              
957             =back
958              
959             =cut
960              
961             =head2 skip
962              
963             skip() (Gather)
964              
965             The skip method registers a L condition which ignores (i.e. skips) the
966             matched line item.
967              
968             I>
969              
970             =over 4
971              
972             =item skip example 1
973              
974             package main;
975              
976             use Venus::Gather;
977              
978             my $gather = Venus::Gather->new([
979             "one",
980             "two",
981             "three",
982             "four",
983             "five",
984             "six",
985             "seven",
986             "eight",
987             "nine",
988             "zero",
989             ]);
990              
991             $gather->expr(qr/e$/)->skip;
992              
993             $gather->expr(qr/.*/)->take;
994              
995             my $result = $gather->result;
996              
997             # ["two", "four", "six", "seven", "eight", "zero"]
998              
999             =back
1000              
1001             =cut
1002              
1003             =head2 take
1004              
1005             take() (Gather)
1006              
1007             The take method registers a L condition which returns (i.e. takes) the
1008             matched line item as-is.
1009              
1010             I>
1011              
1012             =over 4
1013              
1014             =item take example 1
1015              
1016             package main;
1017              
1018             use Venus::Gather;
1019              
1020             my $gather = Venus::Gather->new([
1021             "one",
1022             "two",
1023             "three",
1024             "four",
1025             "five",
1026             "six",
1027             "seven",
1028             "eight",
1029             "nine",
1030             "zero",
1031             ]);
1032              
1033             $gather->expr(qr/e$/)->take;
1034              
1035             my $result = $gather->result;
1036              
1037             # ["one", "three", "five", "nine"]
1038              
1039             =back
1040              
1041             =cut
1042              
1043             =head2 then
1044              
1045             then(Any | CodeRef $code) (Gather)
1046              
1047             The then method registers an action to be executed if the corresponding gather
1048             condition returns truthy.
1049              
1050             I>
1051              
1052             =over 4
1053              
1054             =item then example 1
1055              
1056             package main;
1057              
1058             use Venus::Gather;
1059              
1060             my $gather = Venus::Gather->new([
1061             "one",
1062             "two",
1063             "three",
1064             "four",
1065             "five",
1066             "six",
1067             "seven",
1068             "eight",
1069             "nine",
1070             "zero",
1071             ]);
1072              
1073             $gather->just('one');
1074             $gather->then(1);
1075              
1076             $gather->just('two');
1077             $gather->then(2);
1078              
1079             my $result = $gather->result;
1080              
1081             # [1,2]
1082              
1083             =back
1084              
1085             =over 4
1086              
1087             =item then example 2
1088              
1089             package main;
1090              
1091             use Venus::Gather;
1092              
1093             my $gather = Venus::Gather->new([
1094             "one",
1095             "two",
1096             "three",
1097             "four",
1098             "five",
1099             "six",
1100             "seven",
1101             "eight",
1102             "nine",
1103             "zero",
1104             ]);
1105              
1106             $gather->just('one');
1107             $gather->then(1);
1108              
1109             $gather->just('two');
1110             $gather->then(2);
1111             $gather->then(0);
1112              
1113             my $result = $gather->result;
1114              
1115             # [1,0]
1116              
1117             =back
1118              
1119             =cut
1120              
1121             =head2 when
1122              
1123             when(Str | CodeRef $code, Any @args) (Gather)
1124              
1125             The when method registers a match condition that will be passed the match value
1126             during evaluation. If the match condition returns truthy the corresponding
1127             action will be used to return a result. If the match value is an object, this
1128             method can take a method name and arguments which will be used as a match
1129             condition.
1130              
1131             I>
1132              
1133             =over 4
1134              
1135             =item when example 1
1136              
1137             package main;
1138              
1139             use Venus::Gather;
1140              
1141             my $gather = Venus::Gather->new([
1142             "one",
1143             "two",
1144             "three",
1145             "four",
1146             "five",
1147             "six",
1148             "seven",
1149             "eight",
1150             "nine",
1151             "zero",
1152             ]);
1153              
1154             $gather->when(sub{$_ eq 'one'});
1155             $gather->then(1);
1156              
1157             $gather->when(sub{$_ eq 'two'});
1158             $gather->then(2);
1159              
1160             $gather->when(sub{$_ eq 'six'});
1161             $gather->then(6);
1162              
1163             my $result = $gather->result;
1164              
1165             # [1,2,6]
1166              
1167             =back
1168              
1169             =cut
1170              
1171             =head2 where
1172              
1173             where() (Gather)
1174              
1175             The where method registers an action as a sub-match operation, to be executed
1176             if the corresponding match condition returns truthy. This method returns the
1177             sub-match object.
1178              
1179             I>
1180              
1181             =over 4
1182              
1183             =item where example 1
1184              
1185             package main;
1186              
1187             use Venus::Gather;
1188              
1189             my $gather = Venus::Gather->new;
1190              
1191             my $subgather1 = $gather->expr(qr/^p([a-z]+)ch/)->where;
1192              
1193             $subgather1->just('peach')->then('peach-123');
1194             $subgather1->just('patch')->then('patch-456');
1195             $subgather1->just('punch')->then('punch-789');
1196              
1197             my $subgather2 = $gather->expr(qr/^m([a-z]+)ch/)->where;
1198              
1199             $subgather2->just('merch')->then('merch-123');
1200             $subgather2->just('march')->then('march-456');
1201             $subgather2->just('mouch')->then('mouch-789');
1202              
1203             my $result = $gather->result(['peach', 'preach']);
1204              
1205             # ["peach-123"]
1206              
1207             =back
1208              
1209             =over 4
1210              
1211             =item where example 2
1212              
1213             package main;
1214              
1215             use Venus::Gather;
1216              
1217             my $gather = Venus::Gather->new;
1218              
1219             my $subgather1 = $gather->expr(qr/^p([a-z]+)ch/)->where;
1220              
1221             $subgather1->just('peach')->then('peach-123');
1222             $subgather1->just('patch')->then('patch-456');
1223             $subgather1->just('punch')->then('punch-789');
1224              
1225             my $subgather2 = $gather->expr(qr/^m([a-z]+)ch/)->where;
1226              
1227             $subgather2->just('merch')->then('merch-123');
1228             $subgather2->just('march')->then('march-456');
1229             $subgather2->just('mouch')->then('mouch-789');
1230              
1231             my $result = $gather->result(['march', 'merch']);
1232              
1233             # ["march-456", "merch-123"]
1234              
1235             =back
1236              
1237             =over 4
1238              
1239             =item where example 3
1240              
1241             package main;
1242              
1243             use Venus::Gather;
1244              
1245             my $gather = Venus::Gather->new;
1246              
1247             my $subgather1 = $gather->expr(qr/^p([a-z]+)ch/)->where;
1248              
1249             $subgather1->just('peach')->then('peach-123');
1250             $subgather1->just('patch')->then('patch-456');
1251             $subgather1->just('punch')->then('punch-789');
1252              
1253             my $subgather2 = $gather->expr(qr/^m([a-z]+)ch/)->where;
1254              
1255             $subgather2->just('merch')->then('merch-123');
1256             $subgather2->just('march')->then('march-456');
1257             $subgather2->just('mouch')->then('mouch-789');
1258              
1259             my $result = $gather->result(['pirch']);
1260              
1261             # []
1262              
1263             =back
1264              
1265             =cut
1266              
1267             =head1 AUTHORS
1268              
1269             Awncorp, C
1270              
1271             =cut
1272              
1273             =head1 LICENSE
1274              
1275             Copyright (C) 2000, Al Newkirk.
1276              
1277             This program is free software, you can redistribute it and/or modify it under
1278             the terms of the Apache license version 2.0.
1279              
1280             =cut