Initial Commit

database/perl/vendor/lib/Test2/Workflow/BlockBase.pm

@@ -0,0 +1,159 @@
+package Test2::Workflow::BlockBase;
+use strict;
+use warnings;
+
+our $VERSION = '0.000139';
+
+use Test2::Util::HashBase qw/code frame _info _lines/;
+use Sub::Info qw/sub_info/;
+use List::Util qw/min max/;
+use Carp qw/croak/;
+
+use Test2::Util::Trace();
+
+BEGIN {
+    local ($@, $!, $SIG{__DIE__});
+
+    my $set_name = eval { require Sub::Util; Sub::Util->can('set_subname') }
+                || eval { require Sub::Name; Sub::Name->can('subname') };
+
+    *set_subname = $set_name ? sub {
+        my $self = shift;
+        my ($name) = @_;
+
+        $set_name->($name, $self->{+CODE});
+        delete $self->{+_INFO};
+
+        return 1;
+    } : sub { return 0 };
+}
+
+sub init {
+    my $self = shift;
+
+    croak "The 'code' attribute is required"
+        unless $self->{+CODE};
+
+    croak "The 'frame' attribute is required"
+        unless $self->{+FRAME};
+
+    $self->{+_LINES} = delete $self->{lines}
+        if $self->{lines};
+}
+
+sub file    { shift->info->{file} }
+sub lines   { shift->info->{lines} }
+sub package { shift->info->{package} }
+sub subname { shift->info->{name} }
+
+sub info {
+    my $self = shift;
+
+    unless ($self->{+_INFO}) {
+        my $info = sub_info($self->code);
+
+        my $frame     = $self->frame;
+        my $file      = $info->{file};
+        my $all_lines = $info->{all_lines};
+        my $pre_lines = $self->{+_LINES};
+        my $lines     = $info->{lines} ||= [];
+
+        if ($pre_lines && @$pre_lines) {
+            @$lines = @$pre_lines;
+        }
+        else {
+            @$lines = (
+                min(@$all_lines, $frame->[2]),
+                max(@$all_lines, $frame->[2]),
+            ) if $frame->[1] eq $file;
+        }
+
+        # Adjust for start
+        $lines->[0]-- if $lines->[0] != $lines->[1];
+
+        $self->{+_INFO} = $info;
+    }
+
+    return $self->{+_INFO};
+}
+
+sub trace {
+    my $self = shift;
+
+    my ($hub, %params) = @_;
+
+    croak "'hub' is required"
+        unless $hub;
+
+    return Test2::Util::Trace->new(
+        frame  => $self->frame,
+        detail => $self->debug,
+
+        buffered => $hub->buffered,
+        nested   => $hub->nested,
+        hid      => $hub->hid,
+        huuid    => $hub->uuid,
+
+        %params,
+    );
+}
+
+sub debug {
+    my $self = shift;
+    my $file = $self->file;
+    my $lines = $self->lines;
+
+    my $line_str = @$lines == 1 ? "around line $lines->[0]" : "around lines $lines->[0] -> $lines->[1]";
+    return "at $file $line_str.";
+}
+
+sub throw {
+    my $self = shift;
+    my ($msg) = @_;
+    die "$msg " . $self->debug . "\n";
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Workflow::BlockBase - Base class for all workflow blocks.
+
+=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
+
+Copyright 2018 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+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
+

database/perl/vendor/lib/Test2/Workflow/Build.pm

@@ -0,0 +1,165 @@
+package Test2::Workflow::Build;
+use strict;
+use warnings;
+
+our $VERSION = '0.000139';
+
+use Test2::Workflow::Task::Group;
+
+our @BUILD_FIELDS;
+
+BEGIN {
+    @BUILD_FIELDS = qw{
+        primary         variant
+        setup           teardown
+        variant_setup   variant_teardown
+        primary_setup   primary_teardown
+        stash
+    };
+}
+
+use base 'Test2::Workflow::Task';
+use Test2::Util::HashBase @BUILD_FIELDS, qw/events defaults stack_stop/;
+
+sub init {
+    my $self = shift;
+
+    {
+        local $Carp::CarpLevel = $Carp::CarpLevel + 1;
+        $self->SUPER::init();
+    }
+
+    $self->{$_} ||= [] for @BUILD_FIELDS;
+    $self->{+DEFAULTS} ||= {};
+}
+
+for my $field (@BUILD_FIELDS) {
+    my $code = sub {
+        my $self = shift;
+        push @{$self->{$field}} => @_;
+    };
+    no strict 'refs';
+    *{"add_$field"} = $code;
+}
+
+sub populated {
+    my $self = shift;
+    for my $field (@BUILD_FIELDS) {
+        return 1 if @{$self->{$field}};
+    }
+    return 0;
+}
+
+sub compile {
+    my $self = shift;
+
+    warn "Workflow build '$self->{+NAME}' is empty " . $self->debug . "\n"
+        unless $self->populated || $self->{+SKIP};
+
+    my ($primary_setup, $primary_teardown) = @_;
+    $primary_setup    ||= [];
+    $primary_teardown ||= [];
+
+    my $variant          = $self->{+VARIANT};
+    my $setup            = $self->{+SETUP};
+    my $teardown         = $self->{+TEARDOWN};
+    my $variant_setup    = $self->{+VARIANT_SETUP};
+    my $variant_teardown = $self->{+VARIANT_TEARDOWN};
+
+    $primary_setup = [@$primary_setup, @{$self->{+PRIMARY_SETUP}}];
+    $primary_teardown = [@{$self->{+PRIMARY_TEARDOWN}}, @$primary_teardown];
+
+    # Get primaries in order.
+    my $primary = [
+        map {
+            $_->isa(__PACKAGE__)
+                ? $_->compile($primary_setup, $primary_teardown)
+                : $_;
+        } @{$self->{+PRIMARY}},
+    ];
+
+    if (@$primary_setup || @$primary_teardown) {
+        $primary = [
+            map {
+                my $p = $_->clone;
+                $_->isa('Test2::Workflow::Task::Action') ? Test2::Workflow::Task::Group->new(
+                    before  => $primary_setup,
+                    primary => [ $p ],
+                    take    => $p,
+                    after   => $primary_teardown,
+                ) : $_;
+            } @$primary
+        ];
+    }
+
+    # Build variants
+    if (@$variant) {
+        $primary = [
+            map {
+                my $v = $_->clone;
+                Test2::Workflow::Task::Group->new(
+                    before  => $variant_setup,
+                    primary => $primary,
+                    after   => $variant_teardown,
+                    variant => $v,
+                    take    => $v,
+                );
+            } @$variant
+        ];
+    }
+
+    my %params = map { Test2::Workflow::Task::Group->can($_) ? ($_ => $self->{$_}) : () } keys %$self;
+    delete $params{$_} for @BUILD_FIELDS;
+
+    return Test2::Workflow::Task::Group->new(
+        %params,
+        before  => $setup,
+        after   => $teardown,
+        primary => $primary,
+    );
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Workflow::Build - Represents a build in progress.
+
+=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
+
+Copyright 2018 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+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
+

database/perl/vendor/lib/Test2/Workflow/Runner.pm

@@ -0,0 +1,496 @@
+package Test2::Workflow::Runner;
+use strict;
+use warnings;
+
+our $VERSION = '0.000139';
+
+use Test2::API();
+use Test2::Todo();
+use Test2::AsyncSubtest();
+
+use Test2::Util qw/get_tid CAN_REALLY_FORK/;
+
+use Scalar::Util qw/blessed/;
+use Time::HiRes qw/sleep/;
+use List::Util qw/shuffle min/;
+use Carp qw/confess/;
+
+use Test2::Util::HashBase qw{
+    stack no_fork no_threads max slots pid tid rand subtests filter
+};
+
+use overload(
+    'fallback' => 1,
+    '&{}' => sub {
+        my $self = shift;
+
+        sub {
+            @_ = ($self);
+            goto &run;
+        }
+    },
+);
+
+sub init {
+    my $self = shift;
+
+    $self->{+STACK}    = [];
+    $self->{+SUBTESTS} = [];
+
+    $self->{+PID} = $$;
+    $self->{+TID} = get_tid();
+
+    $self->{+NO_FORK} ||= $ENV{T2_WORKFLOW_NO_FORK} || !CAN_REALLY_FORK();
+
+    my $can_thread = Test2::AsyncSubtest->CAN_REALLY_THREAD();
+    my $should_thread = ($ENV{T2_WORKFLOW_USE_THREADS} || $ENV{T2_DO_THREAD_TESTS}) && !$ENV{T2_WORKFLOW_NO_THREADS};
+    $self->{+NO_THREADS} ||= !($can_thread && $should_thread);
+
+    $self->{+RAND} = 1 unless defined $self->{+RAND};
+
+    my @max = grep {defined $_} $self->{+MAX}, $ENV{T2_WORKFLOW_ASYNC};
+    my $max = @max ? min(@max) : 3;
+    $self->{+MAX} = $max;
+    $self->{+SLOTS} = [] if $max;
+
+    unless(defined($self->{+FILTER})) {
+        if (my $raw = $ENV{T2_WORKFLOW}) {
+            my ($file, $line, $name);
+            if ($raw =~ m/^(.*)\s+(\d+)$/) {
+                ($file, $line) = ($1, $2);
+            }
+            elsif($raw =~ m/^(\d+)$/) {
+                $line = $1;
+            }
+            else {
+                $name = $raw;
+            }
+
+            $self->{+FILTER} = {
+                file => $file,
+                line => $line,
+                name => $name,
+            };
+        }
+    }
+
+    if (my $task = delete $self->{task}) {
+        $self->push_task($task);
+    }
+}
+
+sub is_local {
+    my $self = shift;
+    return 0 unless $self->{+PID} == $$;
+    return 0 unless $self->{+TID} == get_tid();
+    return 1;
+}
+
+sub send_event {
+    my $self = shift;
+    my ($type, %params) = @_;
+
+    my $class;
+    if ($type =~ m/\+(.*)$/) {
+        $class = $1;
+    }
+    else {
+        $class = "Test2::Event::$type";
+    }
+
+    my $hub = Test2::API::test2_stack()->top();
+
+    my $e = $class->new(
+        trace => Test2::Util::Trace->new(
+            frame => [caller(0)],
+            buffered => $hub->buffered,
+            nested   => $hub->nested,
+            hid      => $hub->hid,
+            huuid    => $hub->uuid,
+            #cid      => $self->{+CID},
+            #uuid     => $self->{+UUID},
+        ),
+
+        %params,
+    );
+
+    $hub->send($e);
+}
+
+sub current_subtest {
+    my $self = shift;
+    my $stack = $self->{+STACK} or return undef;
+
+    for my $state (reverse @$stack) {
+        next unless $state->{subtest};
+        return $state->{subtest};
+    }
+
+    return undef;
+}
+
+sub run {
+    my $self = shift;
+
+    my $stack = $self->stack;
+
+    my $c = 0;
+    while (@$stack) {
+        $self->cull;
+
+        my $state  = $stack->[-1];
+        my $task   = $state->{task};
+
+        unless($state->{started}++) {
+            my $skip = $task->skip;
+
+            my $filter;
+            if (my $f = $self->{+FILTER}) {
+                my $in_var = grep { $_->{filter_satisfied} } @$stack;
+
+                $filter = $task->filter($f) unless $in_var;
+                $state->{filter_satisfied} = 1 if $filter->{satisfied};
+            }
+
+            $skip ||= $filter->{skip} if $filter;
+
+            if ($skip) {
+                $state->{ended}++;
+                $self->send_event(
+                    'Skip',
+                    reason         => $skip || $filter,
+                    name           => $task->name,
+                    pass           => 1,
+                    effective_pass => 1,
+                );
+                pop @$stack;
+                next;
+            }
+
+            if ($task->flat) {
+                my $st = $self->current_subtest;
+                my $hub = $st ? $st->hub : Test2::API::test2_stack->top;
+
+                $state->{todo} = Test2::Todo->new(reason => $task->todo, hub => $hub)
+                    if $task->todo;
+
+                $hub->send($_) for @{$task->events};
+            }
+            else {
+                my $st = Test2::AsyncSubtest->new(
+                    name  => $task->name,
+                    frame => $task->frame,
+                );
+                $state->{subtest} = $st;
+
+                $state->{todo} = Test2::Todo->new(reason => $task->todo, hub => $st->hub)
+                    if $task->todo;
+
+                for my $e (@{$task->events}) {
+                    my $hub = $st->hub;
+
+                    $e->trace->{buffered} = $hub->buffered;
+                    $e->trace->{nested}   = $hub->nested;
+                    $e->trace->{hid}      = $hub->hid;
+                    $e->trace->{huuid}    = $hub->uuid;
+
+                    $hub->send($e);
+                }
+
+                my $slot = $self->isolate($state);
+
+                # if we forked/threaded then this state has ended here.
+                if (defined($slot)) {
+                    push @{$self->{+SUBTESTS}} => [$st, $task] unless $st->finished;
+                    $state->{subtest} = undef;
+                    $state->{ended} = 1;
+                }
+            }
+        }
+
+        if ($state->{ended}) {
+            $state->{todo}->end() if $state->{todo};
+            $state->{subtest}->stop() if $state->{subtest};
+
+            return if $state->{in_thread};
+            if(my $guard = delete $state->{in_fork}) {
+                $state->{subtest}->detach;
+                $guard->dismiss;
+                exit 0;
+            }
+
+            pop @$stack;
+            next;
+        }
+
+        if($state->{subtest} && !$state->{subtest_started}++) {
+            push @{$self->{+SUBTESTS}} => [$state->{subtest}, $task];
+            $state->{subtest}->start();
+        }
+
+        if ($task->isa('Test2::Workflow::Task::Action')) {
+            $state->{PID} = $$;
+            my $ok = eval { $task->code->($self); 1 };
+
+            unless ($state->{PID} == $$) {
+                print STDERR "Task '" . $task->name . "' started in pid $state->{PID}, but ended in pid $$, did you forget to exit after forking?\n";
+                exit 255;
+            }
+
+            $task->exception($@) unless $ok;
+            $state->{ended} = 1;
+
+            next;
+        }
+
+        if (!$state->{stage} || $state->{stage} eq 'BEFORE') {
+            $state->{before}  = (defined $state->{before}) ? $state->{before} : 0;
+
+            if (my $add = $task->before->[$state->{before}++]) {
+                if ($add->around) {
+                    $state->{PID} = $$;
+                    my $ok = eval { $add->code->($self); 1 };
+                    my $err = $@;
+                    my $complete = $state->{stage} && $state->{stage} eq 'AFTER';
+
+                    unless ($state->{PID} == $$) {
+                        print STDERR "Task '" . $task->name . "' started in pid $state->{PID}, but ended in pid $$, did you forget to exit after forking?\n";
+                        exit 255;
+                    }
+
+                    unless($ok && $complete) {
+                        $state->{ended} = 1;
+                        $state->{stage} = 'AFTER';
+                        $task->exception($ok ? "'around' task failed to continue into the workflow chain.\n" : $err);
+                    }
+                }
+                else {
+                    $self->push_task($add);
+                }
+            }
+            else {
+                $state->{stage} = 'VARIANT';
+            }
+        }
+        elsif ($state->{stage} eq 'VARIANT') {
+            if (my $v = $task->variant) {
+                $self->push_task($v);
+            }
+            $state->{stage} = 'PRIMARY';
+        }
+        elsif ($state->{stage} eq 'PRIMARY') {
+            unless (defined $state->{order}) {
+                my $rand = defined($task->rand) ? $task->rand : $self->rand;
+                $state->{order} = [0 .. scalar(@{$task->primary}) - 1];
+                @{$state->{order}} = shuffle(@{$state->{order}})
+                    if $rand;
+            }
+            my $num = shift @{$state->{order}};
+            if (defined $num) {
+                $self->push_task($task->primary->[$num]);
+            }
+            else {
+                $state->{stage} = 'AFTER';
+            }
+        }
+        elsif ($state->{stage} eq 'AFTER') {
+            $state->{after}  = (defined $state->{after}) ? $state->{after} : 0;
+            if (my $add = $task->after->[$state->{after}++]) {
+                return if $add->around;
+                $self->push_task($add);
+            }
+            else {
+                $state->{ended} = 1;
+            }
+        }
+    }
+
+    $self->finish;
+}
+
+sub push_task {
+    my $self = shift;
+    my ($task) = @_;
+
+    confess "No Task!" unless $task;
+    confess "Bad Task ($task)!" unless blessed($task) && $task->isa('Test2::Workflow::Task');
+
+    if ($task->isa('Test2::Workflow::Build')) {
+        confess "Can only push a Build instance when initializing the stack"
+            if @{$self->{+STACK}};
+        $task = $task->compile();
+    }
+
+    push @{$self->{+STACK}} => {
+        task => $task,
+        name => $task->name,
+    };
+}
+
+sub add_mock {
+    my $self = shift;
+    my ($mock) = @_;
+    my $stack = $self->{+STACK};
+
+    confess "Nothing on the stack!"
+        unless $stack && @$stack;
+
+    my ($state) = grep { !$_->{task}->scaffold} reverse @$stack;
+    push @{$state->{mocks}} => $mock;
+}
+
+sub isolate {
+    my $self = shift;
+    my ($state) = @_;
+
+    return if $state->{task}->skip;
+
+    my $iso   = $state->{task}->iso;
+    my $async = $state->{task}->async;
+
+    # No need to isolate
+    return undef unless $iso || $async;
+
+    # Cannot isolate
+    unless($self->{+MAX} && $self->is_local) {
+        # async does not NEED to be isolated
+        return undef unless $iso;
+    }
+
+    # Wait for a slot, if max is set to 0 then we will not find a slot, instead
+    # we use '0'.  We need to return a defined value to let the stack know that
+    # the task has ended.
+    my $slot = 0;
+    while($self->{+MAX} && $self->is_local) {
+        $self->cull;
+        for my $s (1 .. $self->{+MAX}) {
+            my $st = $self->{+SLOTS}->[$s];
+            next if $st && !$st->finished;
+            $self->{+SLOTS}->[$s] = undef;
+            $slot = $s;
+            last;
+        }
+        last if $slot;
+        sleep(0.02);
+    }
+
+    my $st = $state->{subtest}
+        or confess "Cannot isolate a task without a subtest";
+
+    if (!$self->no_fork) {
+        my $out = $st->fork;
+        if (blessed($out)) {
+            $state->{in_fork} = $out;
+
+            # drop back out to complete the task.
+            return undef;
+        }
+        else {
+            $self->send_event(
+                'Note',
+                message => "Forked PID $out to run: " . $state->{task}->name,
+            );
+            $state->{pid} = $out;
+        }
+    }
+    elsif (!$self->no_threads) {
+        $state->{in_thread} = 1;
+        my $thr = $st->run_thread(\&run, $self);
+        $state->{thread} = $thr;
+        delete $state->{in_thread};
+        $self->send_event(
+            'Note',
+            message => "Started Thread-ID " . $thr->tid . " to run: " . $state->{task}->name,
+        );
+    }
+    else {
+        $st->finish(skip => "No isolation method available");
+        return 0;
+    }
+
+    if($slot) {
+        $self->{+SLOTS}->[$slot] = $st;
+    }
+    else {
+        $st->finish;
+    }
+
+    return $slot;
+}
+
+sub cull {
+    my $self = shift;
+
+    my $subtests = delete $self->{+SUBTESTS} || return;
+    my @new;
+
+    # Cull subtests in reverse order, Nested subtests end before their parents.
+    for my $set (reverse @$subtests) {
+        my ($st, $task) = @$set;
+        next if $st->finished;
+        if (!$st->active && $st->ready) {
+            $st->finish();
+            next;
+        }
+
+        # Use unshift to preserve order.
+        unshift @new => $set;
+    }
+
+    $self->{+SUBTESTS} = \@new;
+
+    return;
+}
+
+sub finish {
+    my $self = shift;
+    while(@{$self->{+SUBTESTS}}) {
+        $self->cull;
+        sleep(0.02) if @{$self->{+SUBTESTS}};
+    }
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Workflow::Runner - Runs the workflows.
+
+=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
+
+Copyright 2018 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+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
+

database/perl/vendor/lib/Test2/Workflow/Task.pm

@@ -0,0 +1,182 @@
+package Test2::Workflow::Task;
+use strict;
+use warnings;
+
+our $VERSION = '0.000139';
+
+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<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
+
+Copyright 2018 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+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
+

database/perl/vendor/lib/Test2/Workflow/Task/Action.pm

@@ -0,0 +1,53 @@
+package Test2::Workflow::Task::Action;
+use strict;
+use warnings;
+
+our $VERSION = '0.000139';
+
+use base 'Test2::Workflow::Task';
+use Test2::Util::HashBase qw/around/;
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Workflow::Task::Action - Encapsulation of an action.
+
+=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
+
+Copyright 2018 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+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
+

database/perl/vendor/lib/Test2/Workflow/Task/Group.pm

@@ -0,0 +1,111 @@
+package Test2::Workflow::Task::Group;
+use strict;
+use warnings;
+
+our $VERSION = '0.000139';
+
+use Carp qw/croak/;
+
+use Test2::Workflow::Task::Action;
+
+use base 'Test2::Workflow::Task';
+use Test2::Util::HashBase qw/before after primary rand variant/;
+
+sub init {
+    my $self = shift;
+
+    if (my $take = delete $self->{take}) {
+        $self->{$_} = delete $take->{$_} for ISO, ASYNC, TODO, SKIP;
+        $self->{$_} = $take->{$_} for FLAT, SCAFFOLD, NAME, CODE, FRAME;
+        $take->{+FLAT}     = 1;
+        $take->{+SCAFFOLD} = 1;
+    }
+
+    {
+        local $Carp::CarpLevel = $Carp::CarpLevel + 1;
+        $self->SUPER::init();
+    }
+
+    $self->{+BEFORE}  ||= [];
+    $self->{+AFTER}   ||= [];
+    $self->{+PRIMARY} ||= [];
+}
+
+sub filter {
+    my $self = shift;
+    my ($filter) = @_;
+
+    return if $self->{+IS_ROOT};
+
+    my $result = $self->SUPER::filter($filter);
+
+    my $child_ok = 0;
+    for my $c (@{$self->{+PRIMARY}}) {
+        next if $c->{+SCAFFOLD};
+        # A child matches the filter, so we should not be filtered, but also
+        # should not satisfy the filter.
+        my $res = $c->filter($filter);
+
+        # A child satisfies the filter
+        $child_ok++ if !$res || $res->{satisfied};
+        last if $child_ok;
+    }
+
+    # If the filter says we are ok
+    unless($result) {
+        # If we are a variant then allow everything under us to be run
+        return {satisfied => 1} if $self->{+VARIANT} || !$child_ok;
+
+        # Normal group
+        return;
+    }
+
+    return if $child_ok;
+
+    return $result;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test2::Workflow::Task::Group - Encapsulation of a group (describe).
+
+=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
+
+Copyright 2018 Chad Granum E<lt>exodist7@gmail.comE<gt>.
+
+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
+