package Test2::Event::Generic;
use strict;
use warnings;
use Carp qw/croak/;
use Scalar::Util qw/reftype/;
our $VERSION = '1.302183';
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 facet_data
};
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';
*$field = sub { exists $_[0]->{$field} ? $_[0]->{$field} : () }
unless exists &{$field};
*{"set_$field"} = sub { $_[0]->{$field} = $_[1] }
unless exists &{"set_$field"};
}
sub can {
my $self = shift;
my ($name) = @_;
return $self->SUPER::can($name) unless $name eq 'callback';
return $self->{callback} || \&Test2::Event::callback;
}
sub facet_data {
my $self = shift;
return $self->{facet_data} || $self->SUPER::facet_data();
}
sub summary {
my $self = shift;
return $self->{summary} if defined $self->{summary};
$self->SUPER::summary();
}
sub sets_plan {
my $self = shift;
return unless $self->{sets_plan};
return @{$self->{sets_plan}};
}
sub callback {
my $self = shift;
my $cb = $self->{callback} || return;
$self->$cb(@_);
}
sub set_global {
my $self = shift;
my ($bool) = @_;
if(!defined $bool) {
delete $self->{global};
return undef;
}
$self->{global} = $bool;
}
sub set_callback {
my $self = shift;
my ($cb) = @_;
if(!defined $cb) {
delete $self->{callback};
return undef;
}
croak "callback must be a code reference"
unless 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 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 ref($plan) && reftype($plan) eq 'ARRAY';
$self->{sets_plan} = $plan;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Test2::Event::Generic - Generic event type.
=head1 DESCRIPTION
This is a generic event that lets you customize all fields in the event API.
This is useful if you have need for a custom event that does not make sense as
a published reusable event subclass.
=head1 SYNOPSIS
use Test2::API qw/context/;
sub send_custom_fail {
my $ctx = shift;
$ctx->send_event('Generic', causes_fail => 1, summary => 'The sky is falling');
$ctx->release;
}
send_custom_fail();
=head1 METHODS
=over 4
=item $e->facet_data($data)
=item $data = $e->facet_data
Get or set the facet data (see L