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