1package Test2::EventFacet::Trace;
2use strict;
3use warnings;
4
5our $VERSION = '1.302175';
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};
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 package { $_[0]->{+FRAME}->[0] }
74sub file    { $_[0]->{+FRAME}->[1] }
75sub line    { $_[0]->{+FRAME}->[2] }
76sub subname { $_[0]->{+FRAME}->[3] }
77
781;
79
80__END__
81
82=pod
83
84=encoding UTF-8
85
86=head1 NAME
87
88Test2::EventFacet::Trace - Debug information for events
89
90=head1 DESCRIPTION
91
92The L<Test2::API::Context> object, as well as all L<Test2::Event> types need to
93have access to information about where they were created.  This object
94represents that information.
95
96=head1 SYNOPSIS
97
98    use Test2::EventFacet::Trace;
99
100    my $trace = Test2::EventFacet::Trace->new(
101        frame => [$package, $file, $line, $subname],
102    );
103
104=head1 FACET FIELDS
105
106=over 4
107
108=item $string = $trace->{details}
109
110=item $string = $trace->details()
111
112Used as a custom trace message that will be used INSTEAD of
113C<< at <FILE> line <LINE> >> when calling C<< $trace->debug >>.
114
115=item $frame = $trace->{frame}
116
117=item $frame = $trace->frame()
118
119Get the call frame arrayref.
120
121=item $int = $trace->{pid}
122
123=item $int = $trace->pid()
124
125The process ID in which the event was generated.
126
127=item $int = $trace->{tid}
128
129=item $int = $trace->tid()
130
131The thread ID in which the event was generated.
132
133=item $id = $trace->{cid}
134
135=item $id = $trace->cid()
136
137The ID of the context that was used to create the event.
138
139=item $uuid = $trace->{uuid}
140
141=item $uuid = $trace->uuid()
142
143The UUID of the context that was used to create the event. (If uuid tagging was
144enabled)
145
146=back
147
148=head2 DISCOURAGED HUB RELATED FIELDS
149
150These fields were not always set properly by tools. These are B<MOSTLY>
151deprecated by the L<Test2::EventFacet::Hub> facets. These fields are not
152required, and may only reflect the hub that was current when the event was
153created, which is not necessarily the same as the hub the event was sent
154through.
155
156Some tools did do a good job setting these to the correct hub, but you cannot
157always rely on that. Use the 'hubs' facet list instead.
158
159=over 4
160
161=item $hid = $trace->{hid}
162
163=item $hid = $trace->hid()
164
165The ID of the hub that was current when the event was created.
166
167=item $huuid = $trace->{huuid}
168
169=item $huuid = $trace->huuid()
170
171The UUID of the hub that was current when the event was created. (If uuid
172tagging was enabled).
173
174=item $int = $trace->{nested}
175
176=item $int = $trace->nested()
177
178How deeply nested the event is.
179
180=item $bool = $trace->{buffered}
181
182=item $bool = $trace->buffered()
183
184True if the event was buffered and not sent to the formatter independent of a
185parent (This should never be set when nested is C<0> or C<undef>).
186
187=back
188
189=head1 METHODS
190
191B<Note:> All facet frames are also methods.
192
193=over 4
194
195=item $trace->set_detail($msg)
196
197=item $msg = $trace->detail
198
199Used to get/set a custom trace message that will be used INSTEAD of
200C<< at <FILE> line <LINE> >> when calling C<< $trace->debug >>.
201
202C<detail()> is an alias to the C<details> facet field for backwards
203compatibility.
204
205=item $str = $trace->debug
206
207Typically returns the string C<< at <FILE> line <LINE> >>. If C<detail> is set
208then its value will be returned instead.
209
210=item $trace->alert($MESSAGE)
211
212This issues a warning at the frame (filename and line number where
213errors should be reported).
214
215=item $trace->throw($MESSAGE)
216
217This throws an exception at the frame (filename and line number where
218errors should be reported).
219
220=item ($package, $file, $line, $subname) = $trace->call()
221
222Get the caller details for the debug-info. This is where errors should be
223reported.
224
225=item $pkg = $trace->package
226
227Get the debug-info package.
228
229=item $file = $trace->file
230
231Get the debug-info filename.
232
233=item $line = $trace->line
234
235Get the debug-info line number.
236
237=item $subname = $trace->subname
238
239Get the debug-info subroutine name.
240
241=item $sig = trace->signature
242
243Get a signature string that identifies this trace. This is used to check if
244multiple events are related. The signature includes pid, tid, file, line
245number, and the cid.
246
247=back
248
249=head1 SOURCE
250
251The source code repository for Test2 can be found at
252F<http://github.com/Test-More/test-more/>.
253
254=head1 MAINTAINERS
255
256=over 4
257
258=item Chad Granum E<lt>exodist@cpan.orgE<gt>
259
260=back
261
262=head1 AUTHORS
263
264=over 4
265
266=item Chad Granum E<lt>exodist@cpan.orgE<gt>
267
268=back
269
270=head1 COPYRIGHT
271
272Copyright 2019 Chad Granum E<lt>exodist@cpan.orgE<gt>.
273
274This program is free software; you can redistribute it and/or
275modify it under the same terms as Perl itself.
276
277See F<http://dev.perl.org/licenses/>
278
279=cut
280