Generic.pm

Generic.pm

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

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

our $VERSION = '1.302023';

BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use Test2::Util::HashBase;

my @FIELDS = qw{
    causes_fail increments_count diagnostics no_display callback terminate
    global sets_plan summary
};
my %DEFAULTS = (
    causes_fail      => 0,
    increments_count => 0,
    diagnostics      => 0,
    no_display       => 0,
);

sub init {
    my $self = shift;

    for my $field (@FIELDS) {
        my $val = defined $self->{$field} ? delete $self->{$field} : $DEFAULTS{$field};
        next unless defined $val;

        my $set = "set_$field";
        $self->$set($val);
    }
}

for my $field (@FIELDS) {
    no strict 'refs';
    my $stash = \%{__PACKAGE__ . "::"};

    *$field = sub { exists $_[0]->{$field} ? $_[0]->{$field} : () }
        unless defined $stash->{$field}
            && defined *{$stash->{$field}}{CODE};

    *{"set_$field"} = sub { $_[0]->{$field} = $_[1] }
        unless defined $stash->{"set_$field"}
            && defined *{$stash->{"set_$field"}}{CODE};
}

sub summary {
    my $self = shift;
    return $self->{summary} if defined $self->{summary};
    $self->SUPER::summary();
}

sub set_callback {
    my $self = shift;
    my ($cb) = @_;

    croak "callback must be a code reference"
        unless $cb && ref($cb) && reftype($cb) eq 'CODE';

    $self->{callback} = $cb;
}

sub set_terminate {
    my $self = shift;
    my ($exit) = @_;

    if(!defined $exit) {
        delete $self->{terminate};
        return undef;
    }
    
    croak "terminate must be a positive integer"
       unless $exit =~ m/^\d+$/;

    $self->{terminate} = $exit;
}

sub sets_plan {
    my $self = shift;
    return unless $self->{sets_plan};
    return @{$self->{sets_plan}};
}

sub set_sets_plan {
    my $self = shift;
    my ($plan) = @_;

    if(!defined $plan) {
        delete $self->{sets_plan};
        return undef;
    }
    
    croak "'sets_plan' must be an array reference"
        unless reftype($plan) eq 'ARRAY';

    $self->{sets_plan} = $plan;
}

1;