<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Test2::Workflow::BlockBase;
use strict;
use warnings;

our $VERSION = '0.000162';

use Test2::Util::HashBase qw/code frame _info _lines/;
use Test2::Util::Sub 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-&gt;can('set_subname') }
                || eval { require Sub::Name; Sub::Name-&gt;can('subname') };

    *set_subname = $set_name ? sub {
        my $self = shift;
        my ($name) = @_;

        $set_name-&gt;($name, $self-&gt;{+CODE});
        delete $self-&gt;{+_INFO};

        return 1;
    } : sub { return 0 };
}

sub init {
    my $self = shift;

    croak "The 'code' attribute is required"
        unless $self-&gt;{+CODE};

    croak "The 'frame' attribute is required"
        unless $self-&gt;{+FRAME};

    $self-&gt;{+_LINES} = delete $self-&gt;{lines}
        if $self-&gt;{lines};
}

sub file    { shift-&gt;info-&gt;{file} }
sub lines   { shift-&gt;info-&gt;{lines} }
sub package { shift-&gt;info-&gt;{package} }
sub subname { shift-&gt;info-&gt;{name} }

sub info {
    my $self = shift;

    unless ($self-&gt;{+_INFO}) {
        my $info = sub_info($self-&gt;code);

        my $frame     = $self-&gt;frame;
        my $file      = $info-&gt;{file};
        my $all_lines = $info-&gt;{all_lines};
        my $pre_lines = $self-&gt;{+_LINES};
        my $lines     = $info-&gt;{lines} ||= [];

        if ($pre_lines &amp;&amp; @$pre_lines) {
            @$lines = @$pre_lines;
        }
        else {
            @$lines = (
                min(@$all_lines, $frame-&gt;[2]),
                max(@$all_lines, $frame-&gt;[2]),
            ) if $frame-&gt;[1] eq $file;
        }

        # Adjust for start
        $lines-&gt;[0]-- if $lines-&gt;[0] != $lines-&gt;[1];

        $self-&gt;{+_INFO} = $info;
    }

    return $self-&gt;{+_INFO};
}

sub trace {
    my $self = shift;

    my ($hub, %params) = @_;

    croak "'hub' is required"
        unless $hub;

    return Test2::Util::Trace-&gt;new(
        frame  =&gt; $self-&gt;frame,
        detail =&gt; $self-&gt;debug,

        buffered =&gt; $hub-&gt;buffered,
        nested   =&gt; $hub-&gt;nested,
        hid      =&gt; $hub-&gt;hid,
        huuid    =&gt; $hub-&gt;uuid,

        %params,
    );
}

sub debug {
    my $self = shift;
    my $file = $self-&gt;file;
    my $lines = $self-&gt;lines;

    my $line_str = @$lines == 1 ? "around line $lines-&gt;[0]" : "around lines $lines-&gt;[0] -&gt; $lines-&gt;[1]";
    return "at $file $line_str.";
}

sub throw {
    my $self = shift;
    my ($msg) = @_;
    die "$msg " . $self-&gt;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&lt;https://github.com/Test-More/Test2-Suite/&gt;.

=head1 MAINTAINERS

=over 4

=item Chad Granum E&lt;lt&gt;exodist@cpan.orgE&lt;gt&gt;

=back

=head1 AUTHORS

=over 4

=item Chad Granum E&lt;lt&gt;exodist@cpan.orgE&lt;gt&gt;

=back

=head1 COPYRIGHT

Copyright 2018 Chad Granum E&lt;lt&gt;exodist7@gmail.comE&lt;gt&gt;.

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

See F&lt;http://dev.perl.org/licenses/&gt;

=cut

</pre></body></html>