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

#####################################################################
## AUTHOR: Mary Ehlers, [e-mail]
## ABSTRACT: Base role for pipeline segments
#####################################################################

package Piper::Role::Segment;

use v5.10;
use strict;
use warnings;

use Types::Standard qw(Bool CodeRef HashRef InstanceOf);
use Types::Common::Numeric qw(PositiveInt PositiveOrZeroNum);
use Types::Common::String qw(NonEmptySimpleStr);

use Moo::Role;

our $VERSION = '0.03'; # from Piper-0.03.tar.gz

#pod =head1 DESCRIPTION
#pod
#pod This role contains attributes and methods that apply to each pipeline segment, both individual process handlers (L) and pipelines (L).
#pod
#pod =head1 REQUIRES
#pod
#pod =head2 init
#pod
#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.
#pod
#pod =cut

requires 'init';

around init => sub {
    my ($orig, $self, @args) = @_;
    state $call = 0;
    $call++;
    # The first time this is called (per Piper object)
    #   will be from the main (or top-level) pipeline
    #   segment
    my $main = $call == 1 ? 1 : 0;

    my $instance = $self->$orig();

    if ($main) {
        # Set the args in the main instance
        $instance->_set_args(\@args);

        # Reset $call so any other Piper objects can
        #   determine their main segment
        $call = 0;
    }

    return $instance;
};

#pod =head1 ATTRIBUTES
#pod
#pod =head2 allow
#pod
#pod An optional coderef used to subset the items which are I to be processed by the segment.
#pod
#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.
#pod
#pod Each item is localized to C<$_>, and is also passed in as the first argument.  These example C subroutines are equivalent:
#pod
#pod     # This segment only accepts digit inputs
#pod     sub { /^\d+$/ }
#pod     sub { $_ =~ /^\d+$/ }
#pod     sub { $_[0] =~ /^\d+$/ }
#pod
#pod =cut

has allow => (
    is => 'ro',
    isa => CodeRef,
    # Closure to enable sub to use $_ instead of $_[0],
    #   though $_[0] will also work
    coerce => sub {
        my $orig = shift;
        CodeRef->assert_valid($orig);
        return sub {
            my $item = shift;
            local $_ = $item;
            $orig->($item);
        };
    },
    predicate => 1,
);

#pod =head2 batch_size
#pod
#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.
#pod
#pod =cut

has batch_size => (
    is => 'rw',
    isa => PositiveInt,
    required => 0,
    predicate => 1,
    clearer => 1,
);

#pod =head2 config
#pod
#pod A L object defining component classes and global defaults.
#pod
#pod This attribute is set according to the import options provided to S>.
#pod
#pod =cut

has config => (
    is => 'lazy',
    isa => InstanceOf['Piper::Config'],
    builder => sub { require Piper::Config; return Piper::Config->new() },
);

#pod =head2 debug
#pod
#pod Debug level for this segment.
#pod
#pod =cut

has debug => (
    is => 'rw',
    isa => PositiveOrZeroNum,
    required => 0,
    predicate => 1,
    clearer => 1,
);

#pod =head2 enabled
#pod
#pod Boolean indicating that the segment is enabled and can accept items for processing.  Defaults to true.
#pod
#pod =cut

has enabled => (
    is => 'rw',
    isa => Bool,
    coerce => sub { $_[0] ? 1 : 0 },
    required => 0,
    predicate => 1,
    clearer => 1,
);

#pod =head2 id
#pod
#pod A globally unique ID for the segment.  This is primarily useful for debugging only.
#pod
#pod =cut

has id => (
    is => 'ro',
    isa => NonEmptySimpleStr,
    builder => sub {
        my ($self) = @_;
        state $id = {};
        my $base = ref $self;
        $id->{$base}++;
        return "$base$id->{$base}";
    },
);

#pod =head2 label
#pod
#pod A label for this segment.  If no label is provided, the segment's id will be used.
#pod
#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).
#pod
#pod =cut

has label => (
    is => 'rwp',
    isa => NonEmptySimpleStr,
    lazy => 1,
    builder => sub {
        my $self = shift;
        return $self->id;
    },
);

#pod =head2 verbose
#pod
#pod Verbosity level for this segment.
#pod
#pod =cut

has verbose => (
    is => 'rw',
    isa => PositiveOrZeroNum,
    required => 0,
    predicate => 1,
    clearer => 1,
);

#pod =head1 METHODS
#pod
#pod =head2 clear_batch_size
#pod
#pod Clears any assigned C for the segment.
#pod
#pod =head2 clear_debug
#pod
#pod Clears any assigned C level for the segment.
#pod
#pod =head2 clear_enabled
#pod
#pod Clears any assigned C setting for the segment.
#pod
#pod =head2 clear_verbose
#pod
#pod Clears any assigned C level for the segment.
#pod
#pod =head2 has_allow
#pod
#pod A boolean indicating whether or not an C attribute exists for this segment.
#pod
#pod =head2 has_batch_size
#pod
#pod A boolean indicating whether the segment has an assigned C.
#pod
#pod =head2 has_debug
#pod
#pod A boolean indicating whether the segment has an assigned C level.
#pod
#pod =head2 has_enabled
#pod
#pod A boolean indicating whether the segment has an assigned C setting.
#pod
#pod =head2 has_verbose
#pod
#pod A boolean indicating whether the segment has an assigned C level.
#pod
#pod =cut

1;

__END__