Gecko [ edgpens.lpkmn.gov.my ]

Name	Size	Permission
Task	[ DIR ]	drwxrwxrwx
.mad-root	0 B	-rw-rw-rw-
BlockBase.pm	3.08 KB	-rw-rw-rw-
Build.pm	3.6 KB	-rw-rw-rw-
Runner.pm	12.56 KB	-rw-rw-rw-
Task.pm	3.81 KB	-rw-rw-rw-

Code Editor : Task.pm

package Test2::Workflow::Task;
use strict;
use warnings;

our $VERSION = '0.000130';

use Test2::API();
use Test2::Event::Exception();

use List::Util qw/min max/;
use Scalar::Util qw/blessed/;
use Carp qw/croak/;
our @CARP_NOT = qw/Test2::Util::HashBase/;

use base 'Test2::Workflow::BlockBase';
use Test2::Util::HashBase qw/name flat async iso todo skip scaffold events is_root/;

for my $attr (FLAT, ISO, ASYNC, TODO, SKIP, SCAFFOLD) {
    my $old = __PACKAGE__->can("set_$attr");
    my $new = sub {
        my $self = shift;
        my $out = $self->$old(@_);
        $self->verify_scaffold;
        return $out;
    };

no strict 'refs';
    no warnings 'redefine';
    *{"set_$attr"} = $new;
}

sub init {
    my $self = shift;

$self->{+EVENTS} ||= [];

{
        local $Carp::CarpLevel = $Carp::CarpLevel + 1;
        $self->SUPER::init();
    }

$self->throw("the 'name' attribute is required")
        unless $self->{+NAME};

$self->throw("the 'flat' attribute cannot be combined with 'iso' or 'async'")
        if $self->{+FLAT} && ($self->{+ISO} || $self->{+ASYNC});

$self->set_subname($self->package . "::<$self->{+NAME}>");

$self->verify_scaffold;
}

sub clone {
    my $self = shift;
    return bless {%$self}, blessed($self);
}

sub verify_scaffold {
    my $self = shift;

return unless $self->{+SCAFFOLD};

croak "The 'flat' attribute must be true for scaffolding"
        if defined($self->{+FLAT}) && !$self->{+FLAT};

$self->{+FLAT} = 1;

for my $attr (ISO, ASYNC, TODO, SKIP) {
        croak "The '$attr' attribute cannot be used on scaffolding"
            if $self->{$attr};
    }
}

sub exception {
    my $self = shift;
    my ($err) = @_;

my $hub = Test2::API::test2_stack->top;

my $trace = $self->trace($hub);

$hub->send(
        Test2::Event::Exception->new(
            trace => $trace,
            error => $err,
        ),
    );
}

sub filter {
    my $self = shift;
    my ($filter) = @_;

return unless $filter;
    return if $self->{+IS_ROOT};
    return if $self->{+SCAFFOLD};

if (my $name = $filter->{name}) {
        my $ok = 0;
        unless(ref($name)) {
            $ok ||= $self->{+NAME} eq $name;
            $ok ||= $self->subname eq $name;
        }
        if (ref($name) eq 'Regexp') {
            $ok ||= $self->{+NAME} =~ $name;
            $ok ||= $self->subname =~ $name;
        }
        elsif ($name =~ m{^/}) {
            my $pattern = eval "qr$name" or die "'$name' does not appear to be a valid pattern";
            $ok ||= $self->{+NAME} =~ $pattern;
            $ok ||= $self->subname =~ $pattern;
        }

return {skip => "Does not match name filter '$name'"}
            unless $ok;
    }

if (my $file = $filter->{file}) {
        return {skip => "Does not match file filter '$file'"}
            unless $self->file eq $file;
    }

if (my $line = $filter->{line}) {
        my $lines = $self->lines;

return {skip => "Does not match line filter '$line' (no lines)"}
            unless $lines && @$lines;

my $min = min(@$lines);
        my $max = max(@$lines);

return {skip => "Does not match line filter '$min <= $line <= $max'"}
            unless $min <= $line && $max >= $line;
    }

return;
}

__END__

=pod

=encoding UTF-8

=head1 NAME

Test2::Workflow::Task - Encapsulation of a Task

=head1 SOURCE

The source code repository for Test2-Workflow can be found at
F<https://github.com/Test-More/Test2-Suite/>.

=head1 MAINTAINERS

=over 4

=item Chad Granum E<lt>exodist@cpan.orgE<gt>

=back

=head1 AUTHORS

=over 4

=item Chad Granum E<lt>exodist@cpan.orgE<gt>

=back

=head1 COPYRIGHT

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

See F<http://dev.perl.org/licenses/>

=cut

${this.title}

Code Editor : Task.pm