package Test2::Workflow::Task;
use strict;
use warnings;
our $VERSION = '0.000163';
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;
}
1;
__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.
=head1 MAINTAINERS
=over 4
=item Chad Granum Eexodist@cpan.orgE
=back
=head1 AUTHORS
=over 4
=item Chad Granum Eexodist@cpan.orgE
=back
=head1 COPYRIGHT
Copyright 2018 Chad Granum Eexodist7@gmail.comE.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
See F
=cut