File Coverage

blib/lib/Test2/Event/Generic.pm
Criterion Covered Total %
statement 71 71 100.0
branch 26 26 100.0
condition 10 13 76.9
subroutine 19 19 100.0
pod 8 10 80.0
total 134 139 96.4


line stmt bran cond sub pod time code
1             package Test2::Event::Generic;
2 2     2   597 use strict;
  2         6  
  2         61  
3 2     2   10 use warnings;
  2         5  
  2         57  
4              
5 2     2   10 use Carp qw/croak/;
  2         4  
  2         167  
6 2     2   13 use Scalar::Util qw/reftype/;
  2         5  
  2         155  
7              
8             our $VERSION = '1.302182';
9              
10 2     2   13 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
  2         92  
11 2     2   14 use Test2::Util::HashBase;
  2         4  
  2         12  
12              
13             my @FIELDS = qw{
14             causes_fail increments_count diagnostics no_display callback terminate
15             global sets_plan summary facet_data
16             };
17             my %DEFAULTS = (
18             causes_fail => 0,
19             increments_count => 0,
20             diagnostics => 0,
21             no_display => 0,
22             );
23              
24             sub init {
25 6     6 0 10 my $self = shift;
26              
27 6         15 for my $field (@FIELDS) {
28 60 100       134 my $val = defined $self->{$field} ? delete $self->{$field} : $DEFAULTS{$field};
29 60 100       115 next unless defined $val;
30              
31 25         44 my $set = "set_$field";
32 25         72 $self->$set($val);
33             }
34             }
35              
36             for my $field (@FIELDS) {
37 2     2   16 no strict 'refs';
  2         4  
  2         1406  
38              
39 146 100   146   771 *$field = sub { exists $_[0]->{$field} ? $_[0]->{$field} : () }
40             unless exists &{$field};
41              
42 36     36   85 *{"set_$field"} = sub { $_[0]->{$field} = $_[1] }
43             unless exists &{"set_$field"};
44             }
45              
46             sub can {
47 26     26 0 53 my $self = shift;
48 26         51 my ($name) = @_;
49 26 100       196 return $self->SUPER::can($name) unless $name eq 'callback';
50 19   100     162 return $self->{callback} || \&Test2::Event::callback;
51             }
52              
53             sub facet_data {
54 22     22 1 41 my $self = shift;
55 22   66     175 return $self->{facet_data} || $self->SUPER::facet_data();
56             }
57              
58             sub summary {
59 34     34 1 54 my $self = shift;
60 34 100       80 return $self->{summary} if defined $self->{summary};
61 32         87 $self->SUPER::summary();
62             }
63              
64             sub sets_plan {
65 23     23 1 40 my $self = shift;
66 23 100       96 return unless $self->{sets_plan};
67 5         7 return @{$self->{sets_plan}};
  5         25  
68             }
69              
70             sub callback {
71 4     4 1 21 my $self = shift;
72 4   100     25 my $cb = $self->{callback} || return;
73 1         5 $self->$cb(@_);
74             }
75              
76             sub set_global {
77 5     5 1 12 my $self = shift;
78 5         9 my ($bool) = @_;
79              
80 5 100       16 if(!defined $bool) {
81 1         3 delete $self->{global};
82 1         2 return undef;
83             }
84              
85 4         12 $self->{global} = $bool;
86             }
87              
88             sub set_callback {
89 4     4 1 19 my $self = shift;
90 4         9 my ($cb) = @_;
91              
92 4 100       25 if(!defined $cb) {
93 1         13 delete $self->{callback};
94 1         3 return undef;
95             }
96              
97 3 100 66     104 croak "callback must be a code reference"
98             unless ref($cb) && reftype($cb) eq 'CODE';
99              
100 2         9 $self->{callback} = $cb;
101             }
102              
103             sub set_terminate {
104 10     10 1 32 my $self = shift;
105 10         20 my ($exit) = @_;
106              
107 10 100       26 if(!defined $exit) {
108 2         6 delete $self->{terminate};
109 2         5 return undef;
110             }
111              
112 8 100       290 croak "terminate must be a positive integer"
113             unless $exit =~ m/^\d+$/;
114              
115 5         23 $self->{terminate} = $exit;
116             }
117              
118             sub set_sets_plan {
119 6     6 1 16 my $self = shift;
120 6         13 my ($plan) = @_;
121              
122 6 100       20 if(!defined $plan) {
123 1         3 delete $self->{sets_plan};
124 1         3 return undef;
125             }
126              
127 5 100 66     209 croak "'sets_plan' must be an array reference"
128             unless ref($plan) && reftype($plan) eq 'ARRAY';
129              
130 4         12 $self->{sets_plan} = $plan;
131             }
132              
133             1;
134              
135             __END__
136              
137             =pod
138              
139             =encoding UTF-8
140              
141             =head1 NAME
142              
143             Test2::Event::Generic - Generic event type.
144              
145             =head1 DESCRIPTION
146              
147             This is a generic event that lets you customize all fields in the event API.
148             This is useful if you have need for a custom event that does not make sense as
149             a 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              
173             Get or set the facet data (see L<Test2::Event>). If no facet_data is set then
174             C<< Test2::Event->facet_data >> will be called to produce facets from the other
175             data.
176              
177             =item $e->callback($hub)
178              
179             Call the custom callback if one is set, otherwise this does nothing.
180              
181             =item $e->set_callback(sub { ... })
182              
183             Set the custom callback. The custom callback must be a coderef. The first
184             argument to your callback will be the event itself, the second will be the
185             L<Test2::Event::Hub> that is using the callback.
186              
187             =item $bool = $e->causes_fail
188              
189             =item $e->set_causes_fail($bool)
190              
191             Get/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              
197             Get/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              
205             Get/Set the C<diagnostics> attribute. This defaults to an empty list which is
206             undef in scalar context.
207              
208             =item $bool = $e->increments_count
209              
210             =item $e->set_increments_count($bool)
211              
212             Get/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              
218             Get/Set the C<no_display> attribute. This defaults to C<0>.
219              
220             =item @plan = $e->sets_plan
221              
222             Get the plan if this event sets one. The plan is a list of up to 3 items:
223             C<($count, $directive, $reason)>. C<$count> must be defined, the others may be
224             undef, or may not exist at all.
225              
226             =item $e->set_sets_plan(\@plan)
227              
228             Set 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              
234             Get/Set the summary. This will default to the event package
235             C<'Test2::Event::Generic'>. You can set it to any value. Setting this to
236             C<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              
244             This will get/set the C<terminate> attribute. This defaults to undef in scalar
245             context, or an empty list in list context. Setting this to undef will clear it
246             completely. This must be set to a positive integer (0 or larger).
247              
248             =back
249              
250             =head1 SOURCE
251              
252             The source code repository for Test2 can be found at
253             F<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              
273             Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
274              
275             This program is free software; you can redistribute it and/or
276             modify it under the same terms as Perl itself.
277              
278             See F<http://dev.perl.org/licenses/>
279              
280             =cut