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