package Test2::Workflow::BlockBase;
use strict;
use warnings;
our $VERSION = '0.000163';
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->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.
=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