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