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