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