1package Test2::Event::Generic;
2use strict;
3use warnings;
4
5use Carp qw/croak/;
6use Scalar::Util qw/reftype/;
7
8our $VERSION = '1.302175';
9
10BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
11use Test2::Util::HashBase;
12
13my @FIELDS = qw{
14    causes_fail increments_count diagnostics no_display callback terminate
15    global sets_plan summary facet_data
16};
17my %DEFAULTS = (
18    causes_fail      => 0,
19    increments_count => 0,
20    diagnostics      => 0,
21    no_display       => 0,
22);
23
24sub init {
25    my $self = shift;
26
27    for my $field (@FIELDS) {
28        my $val = defined $self->{$field} ? delete $self->{$field} : $DEFAULTS{$field};
29        next unless defined $val;
30
31        my $set = "set_$field";
32        $self->$set($val);
33    }
34}
35
36for my $field (@FIELDS) {
37    no strict 'refs';
38
39    *$field = sub { exists $_[0]->{$field} ? $_[0]->{$field} : () }
40        unless exists &{$field};
41
42    *{"set_$field"} = sub { $_[0]->{$field} = $_[1] }
43        unless exists &{"set_$field"};
44}
45
46sub can {
47    my $self = shift;
48    my ($name) = @_;
49    return $self->SUPER::can($name) unless $name eq 'callback';
50    return $self->{callback} || \&Test2::Event::callback;
51}
52
53sub facet_data {
54    my $self = shift;
55    return $self->{facet_data} || $self->SUPER::facet_data();
56}
57
58sub summary {
59    my $self = shift;
60    return $self->{summary} if defined $self->{summary};
61    $self->SUPER::summary();
62}
63
64sub sets_plan {
65    my $self = shift;
66    return unless $self->{sets_plan};
67    return @{$self->{sets_plan}};
68}
69
70sub callback {
71    my $self = shift;
72    my $cb = $self->{callback} || return;
73    $self->$cb(@_);
74}
75
76sub set_global {
77    my $self = shift;
78    my ($bool) = @_;
79
80    if(!defined $bool) {
81        delete $self->{global};
82        return undef;
83    }
84
85    $self->{global} = $bool;
86}
87
88sub set_callback {
89    my $self = shift;
90    my ($cb) = @_;
91
92    if(!defined $cb) {
93        delete $self->{callback};
94        return undef;
95    }
96
97    croak "callback must be a code reference"
98        unless ref($cb) && reftype($cb) eq 'CODE';
99
100    $self->{callback} = $cb;
101}
102
103sub set_terminate {
104    my $self = shift;
105    my ($exit) = @_;
106
107    if(!defined $exit) {
108        delete $self->{terminate};
109        return undef;
110    }
111
112    croak "terminate must be a positive integer"
113       unless $exit =~ m/^\d+$/;
114
115    $self->{terminate} = $exit;
116}
117
118sub set_sets_plan {
119    my $self = shift;
120    my ($plan) = @_;
121
122    if(!defined $plan) {
123        delete $self->{sets_plan};
124        return undef;
125    }
126
127    croak "'sets_plan' must be an array reference"
128        unless ref($plan) && reftype($plan) eq 'ARRAY';
129
130    $self->{sets_plan} = $plan;
131}
132
1331;
134
135__END__
136
137=pod
138
139=encoding UTF-8
140
141=head1 NAME
142
143Test2::Event::Generic - Generic event type.
144
145=head1 DESCRIPTION
146
147This is a generic event that lets you customize all fields in the event API.
148This is useful if you have need for a custom event that does not make sense as
149a published reusable event subclass.
150
151=head1 SYNOPSIS
152
153    use Test2::API qw/context/;
154
155    sub send_custom_fail {
156        my $ctx = shift;
157
158        $ctx->send_event('Generic', causes_fail => 1, summary => 'The sky is falling');
159
160        $ctx->release;
161    }
162
163    send_custom_fail();
164
165=head1 METHODS
166
167=over 4
168
169=item $e->facet_data($data)
170
171=item $data = $e->facet_data
172
173Get or set the facet data (see L<Test2::Event>). If no facet_data is set then
174C<< Test2::Event->facet_data >> will be called to produce facets from the other
175data.
176
177=item $e->callback($hub)
178
179Call the custom callback if one is set, otherwise this does nothing.
180
181=item $e->set_callback(sub { ... })
182
183Set the custom callback. The custom callback must be a coderef. The first
184argument to your callback will be the event itself, the second will be the
185L<Test2::Event::Hub> that is using the callback.
186
187=item $bool = $e->causes_fail
188
189=item $e->set_causes_fail($bool)
190
191Get/Set the C<causes_fail> attribute. This defaults to C<0>.
192
193=item $bool = $e->diagnostics
194
195=item $e->set_diagnostics($bool)
196
197Get/Set the C<diagnostics> attribute. This defaults to C<0>.
198
199=item $bool_or_undef = $e->global
200
201=item @bool_or_empty = $e->global
202
203=item $e->set_global($bool_or_undef)
204
205Get/Set the C<diagnostics> attribute. This defaults to an empty list which is
206undef in scalar context.
207
208=item $bool = $e->increments_count
209
210=item $e->set_increments_count($bool)
211
212Get/Set the C<increments_count> attribute. This defaults to C<0>.
213
214=item $bool = $e->no_display
215
216=item $e->set_no_display($bool)
217
218Get/Set the C<no_display> attribute. This defaults to C<0>.
219
220=item @plan = $e->sets_plan
221
222Get the plan if this event sets one. The plan is a list of up to 3 items:
223C<($count, $directive, $reason)>. C<$count> must be defined, the others may be
224undef, or may not exist at all.
225
226=item $e->set_sets_plan(\@plan)
227
228Set the plan. You must pass in an arrayref with up to 3 elements.
229
230=item $summary = $e->summary
231
232=item $e->set_summary($summary_or_undef)
233
234Get/Set the summary. This will default to the event package
235C<'Test2::Event::Generic'>. You can set it to any value. Setting this to
236C<undef> will reset it to the default.
237
238=item $int_or_undef = $e->terminate
239
240=item @int_or_empty = $e->terminate
241
242=item $e->set_terminate($int_or_undef)
243
244This will get/set the C<terminate> attribute. This defaults to undef in scalar
245context, or an empty list in list context. Setting this to undef will clear it
246completely. This must be set to a positive integer (0 or larger).
247
248=back
249
250=head1 SOURCE
251
252The source code repository for Test2 can be found at
253F<http://github.com/Test-More/test-more/>.
254
255=head1 MAINTAINERS
256
257=over 4
258
259=item Chad Granum E<lt>exodist@cpan.orgE<gt>
260
261=back
262
263=head1 AUTHORS
264
265=over 4
266
267=item Chad Granum E<lt>exodist@cpan.orgE<gt>
268
269=back
270
271=head1 COPYRIGHT
272
273Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
274
275This program is free software; you can redistribute it and/or
276modify it under the same terms as Perl itself.
277
278See F<http://dev.perl.org/licenses/>
279
280=cut
281