File Coverage

blib/lib/Test2/EventFacet/Trace.pm
Criterion Covered Total %
statement 47 49 95.9
branch 12 16 75.0
condition 6 9 66.6
subroutine 19 20 95.0
pod 11 13 84.6
total 95 107 88.7


line stmt bran cond sub pod time code
1             package Test2::EventFacet::Trace;
2 246     246   1629 use strict;
  246         457  
  246         7172  
3 246     246   1180 use warnings;
  246         410  
  246         14510  
4              
5             our $VERSION = '1.302182';
6              
7 246     246   95598 BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
  246         10513  
8              
9 246     246   1696 use Test2::Util qw/get_tid pkg_to_file gen_uid/;
  246         2094  
  246         12766  
10 246     246   1447 use Carp qw/confess/;
  246         555  
  246         11901  
11              
12 246     246   1501 use Test2::Util::HashBase qw{^frame ^pid ^tid ^cid -hid -nested details -buffered -uuid -huuid <full_caller};
  246         500  
  246         1107  
13              
14             {
15 246     246   2066 no warnings 'once';
  246         836  
  246         179264  
16             *DETAIL = \&DETAILS;
17             *detail = \&details;
18             *set_detail = \&set_details;
19             }
20              
21             sub init {
22             confess "The 'frame' attribute is required"
23 906 100   906 0 3329 unless $_[0]->{+FRAME};
24              
25 904 100       3111 $_[0]->{+DETAILS} = delete $_[0]->{detail} if $_[0]->{detail};
26              
27 904 50 66     6107 unless (defined($_[0]->{+PID}) || defined($_[0]->{+TID}) || defined($_[0]->{+CID})) {
      66        
28 576 50       2555 $_[0]->{+PID} = $$ unless defined $_[0]->{+PID};
29 576 50       2790 $_[0]->{+TID} = get_tid() unless defined $_[0]->{+TID};
30             }
31             }
32              
33             sub snapshot {
34 1807     1807 0 4490 my ($orig, @override) = @_;
35 1807         23604 bless {%$orig, @override}, __PACKAGE__;
36             }
37              
38             sub signature {
39 50     50 1 90 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 238 100 66     1093 return join ':' => map { (defined($_) && length($_)) ? $_ : return undef } (
44             $self->{+CID},
45             $self->{+PID},
46             $self->{+TID},
47             $self->{+FRAME}->[1],
48 50         131 $self->{+FRAME}->[2],
49             );
50             }
51              
52             sub debug {
53 54     54 1 106 my $self = shift;
54 54 100       210 return $self->{+DETAILS} if $self->{+DETAILS};
55 52         167 my ($pkg, $file, $line) = $self->call;
56 52         411 return "at $file line $line";
57             }
58              
59             sub alert {
60 6     6 1 25 my $self = shift;
61 6         23 my ($msg) = @_;
62 6         35 warn $msg . ' ' . $self->debug . ".\n";
63             }
64              
65             sub throw {
66 25     25 1 71 my $self = shift;
67 25         59 my ($msg) = @_;
68 25         110 die $msg . ' ' . $self->debug . ".\n";
69             }
70              
71 1535     1535 1 3059 sub call { @{$_[0]->{+FRAME}} }
  1535         8546  
72              
73 0     0 1 0 sub full_call { @{$_[0]->{+FULL_CALLER}} }
  0         0  
74              
75 645     645 1 2240 sub package { $_[0]->{+FRAME}->[0] }
76 10     10 1 51 sub file { $_[0]->{+FRAME}->[1] }
77 22     22 1 72 sub line { $_[0]->{+FRAME}->[2] }
78 2     2 1 11 sub subname { $_[0]->{+FRAME}->[3] }
79              
80 599 50   599 1 2150 sub warning_bits { $_[0]->{+FULL_CALLER} ? $_[0]->{+FULL_CALLER}->[9] : undef }
81              
82             1;
83              
84             __END__
85              
86             =pod
87              
88             =encoding UTF-8
89              
90             =head1 NAME
91              
92             Test2::EventFacet::Trace - Debug information for events
93              
94             =head1 DESCRIPTION
95              
96             The L<Test2::API::Context> object, as well as all L<Test2::Event> types need to
97             have access to information about where they were created. This object
98             represents 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              
116             Used as a custom trace message that will be used INSTEAD of
117             C<< at <FILE> line <LINE> >> when calling C<< $trace->debug >>.
118              
119             =item $frame = $trace->{frame}
120              
121             =item $frame = $trace->frame()
122              
123             Get the call frame arrayref.
124              
125             [$package, $file, $line, $subname]
126              
127             =item $int = $trace->{pid}
128              
129             =item $int = $trace->pid()
130              
131             The process ID in which the event was generated.
132              
133             =item $int = $trace->{tid}
134              
135             =item $int = $trace->tid()
136              
137             The thread ID in which the event was generated.
138              
139             =item $id = $trace->{cid}
140              
141             =item $id = $trace->cid()
142              
143             The ID of the context that was used to create the event.
144              
145             =item $uuid = $trace->{uuid}
146              
147             =item $uuid = $trace->uuid()
148              
149             The UUID of the context that was used to create the event. (If uuid tagging was
150             enabled)
151              
152             =item ($pkg, $file, $line, $subname) = $trace->call
153              
154             Get the basic call info as a list.
155              
156             =item @caller = $trace->full_call
157              
158             Get the full caller(N) results.
159              
160             =item $warning_bits = $trace->warning_bits
161              
162             Get index 9 from the full caller info. This is the warnings_bits field.
163              
164             The value of this is not portable across perl versions or even processes.
165             However it can be used in the process that generated it to reproduce the
166             warnings 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              
177             These fields were not always set properly by tools. These are B<MOSTLY>
178             deprecated by the L<Test2::EventFacet::Hub> facets. These fields are not
179             required, and may only reflect the hub that was current when the event was
180             created, which is not necessarily the same as the hub the event was sent
181             through.
182              
183             Some tools did do a good job setting these to the correct hub, but you cannot
184             always 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              
192             The 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              
198             The UUID of the hub that was current when the event was created. (If uuid
199             tagging was enabled).
200              
201             =item $int = $trace->{nested}
202              
203             =item $int = $trace->nested()
204              
205             How deeply nested the event is.
206              
207             =item $bool = $trace->{buffered}
208              
209             =item $bool = $trace->buffered()
210              
211             True if the event was buffered and not sent to the formatter independent of a
212             parent (This should never be set when nested is C<0> or C<undef>).
213              
214             =back
215              
216             =head1 METHODS
217              
218             B<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              
226             Used to get/set a custom trace message that will be used INSTEAD of
227             C<< at <FILE> line <LINE> >> when calling C<< $trace->debug >>.
228              
229             C<detail()> is an alias to the C<details> facet field for backwards
230             compatibility.
231              
232             =item $str = $trace->debug
233              
234             Typically returns the string C<< at <FILE> line <LINE> >>. If C<detail> is set
235             then its value will be returned instead.
236              
237             =item $trace->alert($MESSAGE)
238              
239             This issues a warning at the frame (filename and line number where
240             errors should be reported).
241              
242             =item $trace->throw($MESSAGE)
243              
244             This throws an exception at the frame (filename and line number where
245             errors should be reported).
246              
247             =item ($package, $file, $line, $subname) = $trace->call()
248              
249             Get the caller details for the debug-info. This is where errors should be
250             reported.
251              
252             =item $pkg = $trace->package
253              
254             Get the debug-info package.
255              
256             =item $file = $trace->file
257              
258             Get the debug-info filename.
259              
260             =item $line = $trace->line
261              
262             Get the debug-info line number.
263              
264             =item $subname = $trace->subname
265              
266             Get the debug-info subroutine name.
267              
268             =item $sig = trace->signature
269              
270             Get a signature string that identifies this trace. This is used to check if
271             multiple events are related. The signature includes pid, tid, file, line
272             number, and the cid.
273              
274             =back
275              
276             =head1 SOURCE
277              
278             The source code repository for Test2 can be found at
279             F<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              
299             Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>.
300              
301             This program is free software; you can redistribute it and/or
302             modify it under the same terms as Perl itself.
303              
304             See F<http://dev.perl.org/licenses/>
305              
306             =cut