File Coverage

blib/lib/Test2/Event.pm

Criterion	Covered	Total	%
statement	189	200	94.5
branch	87	106	82.0
condition	39	48	81.2
subroutine	39	41	95.1
pod	20	23	86.9
total	374	418	89.4

package Test2::Event;
use strict;
use warnings;

our $VERSION = '1.302180';

use Scalar::Util qw/blessed reftype/;
use Carp qw/croak/;

use Test2::Util::HashBase qw/trace -amnesty uuid -_eid -hubs/;
use Test2::Util::ExternalMeta qw/meta get_meta set_meta delete_meta/;
use Test2::Util qw/pkg_to_file gen_uid/;

use Test2::EventFacet::About();
use Test2::EventFacet::Amnesty();
use Test2::EventFacet::Assert();
use Test2::EventFacet::Control();
use Test2::EventFacet::Error();
use Test2::EventFacet::Info();
use Test2::EventFacet::Meta();
use Test2::EventFacet::Parent();
use Test2::EventFacet::Plan();
use Test2::EventFacet::Trace();
use Test2::EventFacet::Hub();

# Legacy tools will expect this to be loaded now
require Test2::Util::Trace;

my %LOADED_FACETS = (
    'about'   => 'Test2::EventFacet::About',
    'amnesty' => 'Test2::EventFacet::Amnesty',
    'assert'  => 'Test2::EventFacet::Assert',
    'control' => 'Test2::EventFacet::Control',
    'errors'  => 'Test2::EventFacet::Error',
    'info'    => 'Test2::EventFacet::Info',
    'meta'    => 'Test2::EventFacet::Meta',
    'parent'  => 'Test2::EventFacet::Parent',
    'plan'    => 'Test2::EventFacet::Plan',
    'trace'   => 'Test2::EventFacet::Trace',
    'hubs'    => 'Test2::EventFacet::Hub',
);

sub FACET_TYPES { sort values %LOADED_FACETS }

sub load_facet {
    my $class = shift;
    my ($facet) = @_;

    return $LOADED_FACETS{$facet} if exists $LOADED_FACETS{$facet};

    my @check = ($facet);
    if ('s' eq substr($facet, -1, 1)) {
        push @check => substr($facet, 0, -1);
    }
    else {
        push @check => $facet . 's';
    }

    my $found;
    for my $check (@check) {
        my $mod  = "Test2::EventFacet::" . ucfirst($facet);
        my $file = pkg_to_file($mod);
        next unless eval { require $file; 1 };
        $found = $mod;
        last;
    }

    return undef unless $found;
    $LOADED_FACETS{$facet} = $found;
}

sub causes_fail      { 0 }
sub increments_count { 0 }
sub diagnostics      { 0 }
sub no_display       { 0 }
sub subtest_id       { undef }

sub callback { }

sub terminate { () }
sub global    { () }
sub sets_plan { () }

sub summary { ref($_[0]) }

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

    my $tracea = $self->trace  or return undef;
    my $traceb = $event->trace or return undef;

    my $uuida = $tracea->uuid;
    my $uuidb = $traceb->uuid;
    if ($uuida && $uuidb) {
        return 1 if $uuida eq $uuidb;
        return 0;
    }

    my $siga = $tracea->signature or return undef;
    my $sigb = $traceb->signature or return undef;

    return 1 if $siga eq $sigb;
    return 0;
}

sub add_hub {
    my $self = shift;
    unshift @{$self->{+HUBS}} => @_;
}

sub add_amnesty {
    my $self = shift;

    for my $am (@_) {
        $am = {%$am} if ref($am) ne 'ARRAY';
        $am = Test2::EventFacet::Amnesty->new($am);

        push @{$self->{+AMNESTY}} => $am;
    }
}

sub eid { $_[0]->{+_EID} ||= gen_uid() }

sub common_facet_data {
    my $self = shift;

    my %out;

    $out{about} = {package => ref($self) || undef};
    if (my $uuid = $self->uuid) {
        $out{about}->{uuid} = $uuid;
    }

    $out{about}->{eid} = $self->{+_EID} || $self->eid;

    if (my $trace = $self->trace) {
        $out{trace} = { %$trace };
    }

    if (my $hubs = $self->hubs) {
        $out{hubs} = $hubs;
    }

    $out{amnesty} = [map {{ %{$_} }} @{$self->{+AMNESTY}}]
        if $self->{+AMNESTY};

    if (my $meta = $self->meta_facet_data) {
        $out{meta} = $meta;
    }

    return \%out;
}

sub meta_facet_data {
    my $self = shift;

    my $key = Test2::Util::ExternalMeta::META_KEY();

    my $hash = $self->{$key} or return undef;
    return {%$hash};
}

sub facet_data {
    my $self = shift;

    my $out = $self->common_facet_data;

    $out->{about}->{details}    = $self->summary    || undef;
    $out->{about}->{no_display} = $self->no_display || undef;

    # Might be undef, we want to preserve that
    my $terminate = $self->terminate;
    $out->{control} = {
        global    => $self->global    || 0,
        terminate => $terminate,
        has_callback => $self->can('callback') == \&callback ? 0 : 1,
    };

    $out->{assert} = {
        no_debug => 1,                     # Legacy behavior
        pass     => $self->causes_fail ? 0 : 1,
        details  => $self->summary,
    } if $self->increments_count;

    $out->{parent} = {hid => $self->subtest_id} if $self->subtest_id;

    if (my @plan = $self->sets_plan) {
        $out->{plan} = {};

        $out->{plan}->{count}   = $plan[0] if defined $plan[0];
        $out->{plan}->{details} = $plan[2] if defined $plan[2];

        if ($plan[1]) {
            $out->{plan}->{skip} = 1 if $plan[1] eq 'SKIP';
            $out->{plan}->{none} = 1 if $plan[1] eq 'NO PLAN';
        }

        $out->{control}->{terminate} ||= 0 if $out->{plan}->{skip};
    }

    if ($self->causes_fail && !$out->{assert}) {
        $out->{errors} = [
            {
                tag     => 'FAIL',
                fail    => 1,
                details => $self->summary,
            }
        ];
    }

    my %IGNORE = (trace => 1, about => 1, control => 1);
    my $do_info = !grep { !$IGNORE{$_} } keys %$out;

    if ($do_info && !$self->no_display && $self->diagnostics) {
        $out->{info} = [
            {
                tag     => 'DIAG',
                debug   => 1,
                details => $self->summary,
            }
        ];
    }

    return $out;
}

sub facets {
    my $self = shift;
    my %out;

    my $data = $self->facet_data;
    my @errors = $self->validate_facet_data($data);
    die join "\n" => @errors if @errors;

    for my $facet (keys %$data) {
        my $class = $self->load_facet($facet);
        my $val = $data->{$facet};

        unless($class) {
            $out{$facet} = $val;
            next;
        }

        my $is_list = reftype($val) eq 'ARRAY' ? 1 : 0;
        if ($is_list) {
            $out{$facet} = [map { $class->new($_) } @$val];
        }
        else {
            $out{$facet} = $class->new($val);
        }
    }

    return \%out;
}

sub validate_facet_data {
    my $class_or_self = shift;
    my ($f, %params);

    $f = shift if @_ && (reftype($_[0]) || '') eq 'HASH';
    %params = @_;

    $f ||= $class_or_self->facet_data if blessed($class_or_self);
    croak "No facet data" unless $f;

    my @errors;

    for my $k (sort keys %$f) {
        my $fclass = $class_or_self->load_facet($k);

        push @errors => "Could not find a facet class for facet '$k'"
            if $params{require_facet_class} && !$fclass;

        next unless $fclass;

        my $v = $f->{$k};
        next unless defined($v); # undef is always fine

        my $is_list = $fclass->is_list();
        my $got_list = reftype($v) eq 'ARRAY' ? 1 : 0;

        push @errors => "Facet '$k' should be a list, but got a single item ($v)"
            if $is_list && !$got_list;

        push @errors => "Facet '$k' should not be a list, but got a a list ($v)"
            if $got_list && !$is_list;
    }

    return @errors;
}

sub nested {
    my $self = shift;

    Carp::cluck("Use of Test2::Event->nested() is deprecated, use Test2::Event->trace->nested instead")
        if $ENV{AUTHOR_TESTING};

    if (my $hubs = $self->{+HUBS}) {
        return $hubs->[0]->{nested} if @$hubs;
    }

    my $trace = $self->{+TRACE} or return undef;
    return $trace->{nested};
}

sub in_subtest {
    my $self = shift;

    Carp::cluck("Use of Test2::Event->in_subtest() is deprecated, use Test2::Event->trace->hid instead")
        if $ENV{AUTHOR_TESTING};

    my $hubs = $self->{+HUBS};
    if ($hubs && @$hubs) {
        return undef unless $hubs->[0]->{nested};
        return $hubs->[0]->{hid}
    }

    my $trace = $self->{+TRACE} or return undef;
    return undef unless $trace->{nested};
    return $trace->{hid};
}

1;

__END__