Commit | Line | Data |
---|---|---|
c6a6e1c8 CG |
1 | package Test2::Event::Generic; |
2 | use strict; | |
3 | use warnings; | |
4 | ||
5 | use Carp qw/croak/; | |
6 | use Scalar::Util qw/reftype/; | |
7 | ||
cf76a266 | 8 | our $VERSION = '1.302198'; |
c6a6e1c8 CG |
9 | |
10 | BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } | |
11 | use Test2::Util::HashBase; | |
12 | ||
13 | my @FIELDS = qw{ | |
14 | causes_fail increments_count diagnostics no_display callback terminate | |
07bc328a | 15 | global sets_plan summary facet_data |
c6a6e1c8 CG |
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 | 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 | ||
36 | for my $field (@FIELDS) { | |
37 | no strict 'refs'; | |
c6a6e1c8 CG |
38 | |
39 | *$field = sub { exists $_[0]->{$field} ? $_[0]->{$field} : () } | |
07bc328a | 40 | unless exists &{$field}; |
c6a6e1c8 CG |
41 | |
42 | *{"set_$field"} = sub { $_[0]->{$field} = $_[1] } | |
07bc328a SH |
43 | unless exists &{"set_$field"}; |
44 | } | |
45 | ||
46 | sub 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 | ||
53 | sub facet_data { | |
54 | my $self = shift; | |
55 | return $self->{facet_data} || $self->SUPER::facet_data(); | |
c6a6e1c8 CG |
56 | } |
57 | ||
58 | sub summary { | |
59 | my $self = shift; | |
60 | return $self->{summary} if defined $self->{summary}; | |
61 | $self->SUPER::summary(); | |
62 | } | |
63 | ||
64 | sub sets_plan { | |
65 | my $self = shift; | |
66 | return unless $self->{sets_plan}; | |
67 | return @{$self->{sets_plan}}; | |
68 | } | |
69 | ||
70 | sub callback { | |
71 | my $self = shift; | |
72 | my $cb = $self->{callback} || return; | |
73 | $self->$cb(@_); | |
74 | } | |
75 | ||
76 | sub 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 | ||
88 | sub 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 | ||
103 | sub 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 | ||
118 | sub 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 | ||
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 | ||
07bc328a SH |
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 | ||
c6a6e1c8 CG |
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 | ||
18c72c39 | 273 | Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>. |
c6a6e1c8 CG |
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 |