1package Test2::EventFacet::Trace; 2use strict; 3use warnings; 4 5our $VERSION = '1.302133'; 6 7BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) } 8 9use Test2::Util qw/get_tid pkg_to_file/; 10use Carp qw/confess/; 11 12use Test2::Util::HashBase qw{^frame ^pid ^tid ^cid -hid -nested details -buffered -uuid -huuid}; 13 14{ 15 no warnings 'once'; 16 *DETAIL = \&DETAILS; 17 *detail = \&details; 18 *set_detail = \&set_details; 19} 20 21sub init { 22 confess "The 'frame' attribute is required" 23 unless $_[0]->{+FRAME}; 24 25 $_[0]->{+DETAILS} = delete $_[0]->{detail} if $_[0]->{detail}; 26 27 $_[0]->{+PID} = $$ unless defined $_[0]->{+PID}; 28 $_[0]->{+TID} = get_tid() unless defined $_[0]->{+TID}; 29} 30 31sub snapshot { 32 my ($orig, @override) = @_; 33 bless {%$orig, @override}, __PACKAGE__; 34} 35 36sub signature { 37 my $self = shift; 38 39 # Signature is only valid if all of these fields are defined, there is no 40 # signature if any is missing. '0' is ok, but '' is not. 41 return join ':' => map { (defined($_) && length($_)) ? $_ : return undef } ( 42 $self->{+CID}, 43 $self->{+PID}, 44 $self->{+TID}, 45 $self->{+FRAME}->[1], 46 $self->{+FRAME}->[2], 47 ); 48} 49 50sub debug { 51 my $self = shift; 52 return $self->{+DETAILS} if $self->{+DETAILS}; 53 my ($pkg, $file, $line) = $self->call; 54 return "at $file line $line"; 55} 56 57sub alert { 58 my $self = shift; 59 my ($msg) = @_; 60 warn $msg . ' ' . $self->debug . ".\n"; 61} 62 63sub throw { 64 my $self = shift; 65 my ($msg) = @_; 66 die $msg . ' ' . $self->debug . ".\n"; 67} 68 69sub call { @{$_[0]->{+FRAME}} } 70 71sub package { $_[0]->{+FRAME}->[0] } 72sub file { $_[0]->{+FRAME}->[1] } 73sub line { $_[0]->{+FRAME}->[2] } 74sub subname { $_[0]->{+FRAME}->[3] } 75 761; 77 78__END__ 79 80=pod 81 82=encoding UTF-8 83 84=head1 NAME 85 86Test2::EventFacet::Trace - Debug information for events 87 88=head1 DESCRIPTION 89 90The L<Test2::API::Context> object, as well as all L<Test2::Event> types need to 91have access to information about where they were created. This object 92represents that information. 93 94=head1 SYNOPSIS 95 96 use Test2::EventFacet::Trace; 97 98 my $trace = Test2::EventFacet::Trace->new( 99 frame => [$package, $file, $line, $subname], 100 ); 101 102=head1 FACET FIELDS 103 104=over 4 105 106=item $string = $trace->{details} 107 108=item $string = $trace->details() 109 110Used as a custom trace message that will be used INSTEAD of 111C<< at <FILE> line <LINE> >> when calling C<< $trace->debug >>. 112 113=item $frame = $trace->{frame} 114 115=item $frame = $trace->frame() 116 117Get the call frame arrayref. 118 119=item $int = $trace->{pid} 120 121=item $int = $trace->pid() 122 123The process ID in which the event was generated. 124 125=item $int = $trace->{tid} 126 127=item $int = $trace->tid() 128 129The thread ID in which the event was generated. 130 131=item $id = $trace->{cid} 132 133=item $id = $trace->cid() 134 135The ID of the context that was used to create the event. 136 137=item $uuid = $trace->{uuid} 138 139=item $uuid = $trace->uuid() 140 141The UUID of the context that was used to create the event. (If uuid tagging was 142enabled) 143 144=back 145 146=head2 DISCOURAGED HUB RELATED FIELDS 147 148These fields were not always set properly by tools. These are B<MOSTLY> 149deprecated by the L<Test2::EventFacet::Hub> facets. These fields are not 150required, and may only reflect the hub that was current when the event was 151created, which is not necessarily the same as the hub the event was sent 152through. 153 154Some tools did do a good job setting these to the correct hub, but you cannot 155always rely on that. Use the 'hubs' facet list instead. 156 157=over 4 158 159=item $hid = $trace->{hid} 160 161=item $hid = $trace->hid() 162 163The ID of the hub that was current when the event was created. 164 165=item $huuid = $trace->{huuid} 166 167=item $huuid = $trace->huuid() 168 169The UUID of the hub that was current when the event was created. (If uuid 170tagging was enabled). 171 172=item $int = $trace->{nested} 173 174=item $int = $trace->nested() 175 176How deeply nested the event is. 177 178=item $bool = $trace->{buffered} 179 180=item $bool = $trace->buffered() 181 182True if the event was buffered and not sent to the formatter independent of a 183parent (This should never be set when nested is C<0> or C<undef>). 184 185=back 186 187=head1 METHODS 188 189B<Note:> All facet frames are also methods. 190 191=over 4 192 193=item $trace->set_detail($msg) 194 195=item $msg = $trace->detail 196 197Used to get/set a custom trace message that will be used INSTEAD of 198C<< at <FILE> line <LINE> >> when calling C<< $trace->debug >>. 199 200C<detail()> is an alias to the C<details> facet field for backwards 201compatibility. 202 203=item $str = $trace->debug 204 205Typically returns the string C<< at <FILE> line <LINE> >>. If C<detail> is set 206then its value will be returned instead. 207 208=item $trace->alert($MESSAGE) 209 210This issues a warning at the frame (filename and line number where 211errors should be reported). 212 213=item $trace->throw($MESSAGE) 214 215This throws an exception at the frame (filename and line number where 216errors should be reported). 217 218=item ($package, $file, $line, $subname) = $trace->call() 219 220Get the caller details for the debug-info. This is where errors should be 221reported. 222 223=item $pkg = $trace->package 224 225Get the debug-info package. 226 227=item $file = $trace->file 228 229Get the debug-info filename. 230 231=item $line = $trace->line 232 233Get the debug-info line number. 234 235=item $subname = $trace->subname 236 237Get the debug-info subroutine name. 238 239=item $sig = trace->signature 240 241Get a signature string that identifies this trace. This is used to check if 242multiple events are related. 243 244If UUID's are enabled then a uuid is returned. Otherwise the signature includes 245pid, tid, file, line number, and the cid which is C<'C\d+'> for traces created 246by a context, or C<'T\d+'> for traces created by C<new()>. 247 248=back 249 250=head1 SOURCE 251 252The source code repository for Test2 can be found at 253F<http://github.com/Test-More/test-more/>. 254 255=head1 MAINTAINERS 256 257=over 4 258 259=item Chad Granum E<lt>exodist@cpan.orgE<gt> 260 261=back 262 263=head1 AUTHORS 264 265=over 4 266 267=item Chad Granum E<lt>exodist@cpan.orgE<gt> 268 269=back 270 271=head1 COPYRIGHT 272 273Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>. 274 275This program is free software; you can redistribute it and/or 276modify it under the same terms as Perl itself. 277 278See F<http://dev.perl.org/licenses/> 279 280=cut 281