1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
|
package Test2::Event::V2;
use strict;
use warnings;
our $VERSION = '1.302194';
use Scalar::Util qw/reftype/;
use Carp qw/croak/;
BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use Test2::Util::Facets2Legacy qw{
causes_fail diagnostics global increments_count no_display sets_plan
subtest_id summary terminate
};
use Test2::Util::HashBase qw/-about/;
sub non_facet_keys {
return (
+UUID,
Test2::Util::ExternalMeta::META_KEY(),
);
}
sub init {
my $self = shift;
my $uuid;
if ($uuid = $self->{+UUID}) {
croak "uuid '$uuid' passed to constructor, but uuid '$self->{+ABOUT}->{uuid}' is already set in the 'about' facet"
if $self->{+ABOUT}->{uuid} && $self->{+ABOUT}->{uuid} ne $uuid;
$self->{+ABOUT}->{uuid} = $uuid;
}
elsif ($self->{+ABOUT} && $self->{+ABOUT}->{uuid}) {
$uuid = $self->{+ABOUT}->{uuid};
$self->SUPER::set_uuid($uuid);
}
# Clone the trace, make sure it is blessed
if (my $trace = $self->{+TRACE}) {
$self->{+TRACE} = Test2::EventFacet::Trace->new(%$trace);
}
}
sub set_uuid {
my $self = shift;
my ($uuid) = @_;
$self->{+ABOUT}->{uuid} = $uuid;
$self->SUPER::set_uuid($uuid);
}
sub facet_data {
my $self = shift;
my $f = { %{$self} };
delete $f->{$_} for $self->non_facet_keys;
my %out;
for my $k (keys %$f) {
next if substr($k, 0, 1) eq '_';
my $data = $f->{$k} or next; # Key is there, but no facet
my $is_list = 'ARRAY' eq (reftype($data) || '');
$out{$k} = $is_list ? [ map { {%{$_}} } @$data ] : {%$data};
}
if (my $meta = $self->meta_facet_data) {
$out{meta} = {%$meta, %{$out{meta} || {}}};
}
return \%out;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Test2::Event::V2 - Second generation event.
=head1 DESCRIPTION
This is the event type that should be used instead of L<Test2::Event> or its
legacy subclasses.
=head1 SYNOPSIS
=head2 USING A CONTEXT
use Test2::API qw/context/;
sub my_tool {
my $ctx = context();
my $event = $ctx->send_ev2(info => [{tag => 'NOTE', details => "This is a note"}]);
$ctx->release;
return $event;
}
=head2 USING THE CONSTRUCTOR
use Test2::Event::V2;
my $e = Test2::Event::V2->new(
trace => {frame => [$PKG, $FILE, $LINE, $SUBNAME]},
info => [{tag => 'NOTE', details => "This is a note"}],
);
=head1 METHODS
This class inherits from L<Test2::Event>.
=over 4
=item $fd = $e->facet_data()
This will return a hashref of facet data. Each facet hash will be a shallow
copy of the original.
=item $about = $e->about()
This will return the 'about' facet hashref.
B<NOTE:> This will return the internal hashref, not a copy.
=item $trace = $e->trace()
This will return the 'trace' facet, normally blessed (but this is not enforced
when the trace is set using C<set_trace()>.
B<NOTE:> This will return the internal trace, not a copy.
=back
=head2 MUTATION
=over 4
=item $e->add_amnesty({...})
Inherited from L<Test2::Event>. This can be used to add 'amnesty' facets to an
existing event. Each new item is added to the B<END> of the list.
B<NOTE:> Items B<ARE> blessed when added.
=item $e->add_hub({...})
Inherited from L<Test2::Event>. This is used by hubs to stamp events as they
pass through. New items are added to the B<START> of the list.
B<NOTE:> Items B<ARE NOT> blessed when added.
=item $e->set_uuid($UUID)
Inherited from L<Test2::Event>, overridden to also vivify/mutate the 'about'
facet.
=item $e->set_trace($trace)
Inherited from L<Test2::Event> which allows you to change the trace.
B<Note:> This method does not bless/clone the trace for you. Many things will
expect the trace to be blessed, so you should probably do that.
=back
=head2 LEGACY SUPPORT METHODS
These are all imported from L<Test2::Util::Facets2Legacy>, see that module or
L<Test2::Event> for documentation on what they do.
=over 4
=item causes_fail
=item diagnostics
=item global
=item increments_count
=item no_display
=item sets_plan
=item subtest_id
=item summary
=item terminate
=back
=head1 THIRD PARTY META-DATA
This object consumes L<Test2::Util::ExternalMeta> which provides a consistent
way for you to attach meta-data to instances of this class. This is useful for
tools, plugins, and other extensions.
=head1 SOURCE
The source code repository for Test2 can be found at
F<http://github.com/Test-More/test-more/>.
=head1 MAINTAINERS
=over 4
=item Chad Granum E<lt>exodist@cpan.orgE<gt>
=back
=head1 AUTHORS
=over 4
=item Chad Granum E<lt>exodist@cpan.orgE<gt>
=back
=head1 COPYRIGHT
Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
See F<http://dev.perl.org/licenses/>
=cut
|
