File Coverage

blib/lib/Piper/Role/Segment.pm
Criterion Covered Total %
statement 29 29 100.0
branch n/a
condition n/a
subroutine 10 10 100.0
pod n/a
total 39 39 100.0


line stmt bran cond sub pod time code
1             #####################################################################
2             ## AUTHOR: Mary Ehlers, regina.verbae@gmail.com
3             ## ABSTRACT: Base role for pipeline segments
4             #####################################################################
5              
6             package Piper::Role::Segment;
7              
8 4     4   28360 use v5.10;
  4         11  
9 4     4   15 use strict;
  4         5  
  4         61  
10 4     4   12 use warnings;
  4         4  
  4         95  
11              
12 4     4   18 use Types::Standard qw(Bool CodeRef HashRef InstanceOf);
  4         4  
  4         32  
13 4     4   3982 use Types::Common::Numeric qw(PositiveInt PositiveOrZeroNum);
  4         32940  
  4         28  
14 4     4   3356 use Types::Common::String qw(NonEmptySimpleStr);
  4         121525  
  4         133  
15              
16 4     4   1688 use Moo::Role;
  4         4  
  4         35  
17              
18             our $VERSION = '0.03'; # from Piper-0.03.tar.gz
19              
20             #pod =head1 DESCRIPTION
21             #pod
22             #pod This role contains attributes and methods that apply to each pipeline segment, both individual process handlers (L) and pipelines (L).
23             #pod
24             #pod =head1 REQUIRES
25             #pod
26             #pod =head2 init
27             #pod
28             #pod This role requires the definition of an C method which initializes the segment as a pipeline instance and prepares it for data processing. The method must return the created pipeline instance.
29             #pod
30             #pod =cut
31              
32             requires 'init';
33              
34             around init => sub {
35             my ($orig, $self, @args) = @_;
36             state $call = 0;
37             $call++;
38             # The first time this is called (per Piper object)
39             # will be from the main (or top-level) pipeline
40             # segment
41             my $main = $call == 1 ? 1 : 0;
42              
43             my $instance = $self->$orig();
44              
45             if ($main) {
46             # Set the args in the main instance
47             $instance->_set_args(\@args);
48              
49             # Reset $call so any other Piper objects can
50             # determine their main segment
51             $call = 0;
52             }
53              
54             return $instance;
55             };
56              
57             #pod =head1 ATTRIBUTES
58             #pod
59             #pod =head2 allow
60             #pod
61             #pod An optional coderef used to subset the items which are I to be processed by the segment.
62             #pod
63             #pod The coderef runs on each item attempting to queue to the segment. If it returns true, the item is queued. Otherwise, the item skips the segment and proceeds to the next adjacent segment.
64             #pod
65             #pod Each item is localized to C<$_>, and is also passed in as the first argument. These example C subroutines are equivalent:
66             #pod
67             #pod # This segment only accepts digit inputs
68             #pod sub { /^\d+$/ }
69             #pod sub { $_ =~ /^\d+$/ }
70             #pod sub { $_[0] =~ /^\d+$/ }
71             #pod
72             #pod =cut
73              
74             has allow => (
75             is => 'ro',
76             isa => CodeRef,
77             # Closure to enable sub to use $_ instead of $_[0],
78             # though $_[0] will also work
79             coerce => sub {
80             my $orig = shift;
81             CodeRef->assert_valid($orig);
82             return sub {
83             my $item = shift;
84             local $_ = $item;
85             $orig->($item);
86             };
87             },
88             predicate => 1,
89             );
90              
91             #pod =head2 batch_size
92             #pod
93             #pod The number of items to process at a time for the segment. Once initialized, a segment inherits the C of its parent(s) if not provided.
94             #pod
95             #pod =cut
96              
97             has batch_size => (
98             is => 'rw',
99             isa => PositiveInt,
100             required => 0,
101             predicate => 1,
102             clearer => 1,
103             );
104              
105             #pod =head2 config
106             #pod
107             #pod A L object defining component classes and global defaults.
108             #pod
109             #pod This attribute is set according to the import options provided to S>.
110             #pod
111             #pod =cut
112              
113             has config => (
114             is => 'lazy',
115             isa => InstanceOf['Piper::Config'],
116 17     17   7226 builder => sub { require Piper::Config; return Piper::Config->new() },
  17         241  
117             );
118              
119             #pod =head2 debug
120             #pod
121             #pod Debug level for this segment.
122             #pod
123             #pod =cut
124              
125             has debug => (
126             is => 'rw',
127             isa => PositiveOrZeroNum,
128             required => 0,
129             predicate => 1,
130             clearer => 1,
131             );
132              
133             #pod =head2 enabled
134             #pod
135             #pod Boolean indicating that the segment is enabled and can accept items for processing. Defaults to true.
136             #pod
137             #pod =cut
138              
139             has enabled => (
140             is => 'rw',
141             isa => Bool,
142             coerce => sub { $_[0] ? 1 : 0 },
143             required => 0,
144             predicate => 1,
145             clearer => 1,
146             );
147              
148             #pod =head2 id
149             #pod
150             #pod A globally unique ID for the segment. This is primarily useful for debugging only.
151             #pod
152             #pod =cut
153              
154             has id => (
155             is => 'ro',
156             isa => NonEmptySimpleStr,
157             builder => sub {
158 109     109   8715 my ($self) = @_;
159 109         115 state $id = {};
160 109         121 my $base = ref $self;
161 109         132 $id->{$base}++;
162 109         1528 return "$base$id->{$base}";
163             },
164             );
165              
166             #pod =head2 label
167             #pod
168             #pod A label for this segment. If no label is provided, the segment's id will be used.
169             #pod
170             #pod Labels are necessary if any handlers wish to use the C or C methods (described in L or L documentation). Otherwise, labels are primarily useful for logging and/or debugging (see L).
171             #pod
172             #pod =cut
173              
174             has label => (
175             is => 'rwp',
176             isa => NonEmptySimpleStr,
177             lazy => 1,
178             builder => sub {
179 5     5   10117 my $self = shift;
180 5         80 return $self->id;
181             },
182             );
183              
184             #pod =head2 verbose
185             #pod
186             #pod Verbosity level for this segment.
187             #pod
188             #pod =cut
189              
190             has verbose => (
191             is => 'rw',
192             isa => PositiveOrZeroNum,
193             required => 0,
194             predicate => 1,
195             clearer => 1,
196             );
197              
198             #pod =head1 METHODS
199             #pod
200             #pod =head2 clear_batch_size
201             #pod
202             #pod Clears any assigned C for the segment.
203             #pod
204             #pod =head2 clear_debug
205             #pod
206             #pod Clears any assigned C level for the segment.
207             #pod
208             #pod =head2 clear_enabled
209             #pod
210             #pod Clears any assigned C setting for the segment.
211             #pod
212             #pod =head2 clear_verbose
213             #pod
214             #pod Clears any assigned C level for the segment.
215             #pod
216             #pod =head2 has_allow
217             #pod
218             #pod A boolean indicating whether or not an C attribute exists for this segment.
219             #pod
220             #pod =head2 has_batch_size
221             #pod
222             #pod A boolean indicating whether the segment has an assigned C.
223             #pod
224             #pod =head2 has_debug
225             #pod
226             #pod A boolean indicating whether the segment has an assigned C level.
227             #pod
228             #pod =head2 has_enabled
229             #pod
230             #pod A boolean indicating whether the segment has an assigned C setting.
231             #pod
232             #pod =head2 has_verbose
233             #pod
234             #pod A boolean indicating whether the segment has an assigned C level.
235             #pod
236             #pod =cut
237              
238             1;
239              
240             __END__