Commit | Line | Data |
---|---|---|
07bc328a SH |
1 | package Test2::EventFacet::Trace; |
2 | use strict; | |
3 | use warnings; | |
4 | ||
1195d90a | 5 | our $VERSION = '1.302098'; |
07bc328a SH |
6 | |
7 | BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) } | |
8 | ||
9 | use Test2::Util qw/get_tid pkg_to_file/; | |
10 | use Carp qw/confess/; | |
11 | ||
12 | use Test2::Util::HashBase qw{^frame ^pid ^tid ^cid -hid -nested details -buffered}; | |
13 | ||
14 | { | |
15 | no warnings 'once'; | |
16 | *DETAIL = \&DETAILS; | |
17 | *detail = \&details; | |
18 | *set_detail = \&set_details; | |
19 | } | |
20 | ||
21 | sub 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 | ||
31 | sub snapshot { | |
32 | my ($orig, @override) = @_; | |
33 | bless {%$orig, @override}, __PACKAGE__; | |
34 | } | |
35 | ||
36 | sub 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 | ||
50 | sub 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 | ||
57 | sub alert { | |
58 | my $self = shift; | |
59 | my ($msg) = @_; | |
60 | warn $msg . ' ' . $self->debug . ".\n"; | |
61 | } | |
62 | ||
63 | sub throw { | |
64 | my $self = shift; | |
65 | my ($msg) = @_; | |
66 | die $msg . ' ' . $self->debug . ".\n"; | |
67 | } | |
68 | ||
69 | sub call { @{$_[0]->{+FRAME}} } | |
70 | ||
71 | sub package { $_[0]->{+FRAME}->[0] } | |
72 | sub file { $_[0]->{+FRAME}->[1] } | |
73 | sub line { $_[0]->{+FRAME}->[2] } | |
74 | sub subname { $_[0]->{+FRAME}->[3] } | |
75 | ||
76 | 1; | |
77 | ||
78 | __END__ | |
79 | ||
80 | =pod | |
81 | ||
82 | =encoding UTF-8 | |
83 | ||
84 | =head1 NAME | |
85 | ||
86 | Test2::EventFacet::Trace - Debug information for events | |
87 | ||
88 | =head1 DESCRIPTION | |
89 | ||
90 | The L<Test2::API::Context> object, as well as all L<Test2::Event> types need to | |
91 | have access to information about where they were created. This object | |
92 | represents 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 | ||
110 | Used as a custom trace message that will be used INSTEAD of | |
111 | C<< at <FILE> line <LINE> >> when calling C<< $trace->debug >>. | |
112 | ||
113 | =item $frame = $trace->{frame} | |
114 | ||
115 | =item $frame = $trace->frame() | |
116 | ||
117 | Get the call frame arrayref. | |
118 | ||
119 | =item $int = $trace->{pid} | |
120 | ||
121 | =item $int = $trace->pid() | |
122 | ||
123 | The process ID in which the event was generated. | |
124 | ||
125 | =item $int = $trace->{tid} | |
126 | ||
127 | =item $int = $trace->tid() | |
128 | ||
129 | The thread ID in which the event was generated. | |
130 | ||
131 | =item $id = $trace->{cid} | |
132 | ||
133 | =item $id = $trace->cid() | |
134 | ||
135 | The ID of the context that was used to create the event. | |
136 | ||
137 | =item $hid = $trace->{hid} | |
138 | ||
139 | =item $hid = $trace->hid() | |
140 | ||
141 | The ID of the hub that was current when the event was created. | |
142 | ||
143 | =item $int = $trace->{nested} | |
144 | ||
145 | =item $int = $trace->nested() | |
146 | ||
147 | How deeply nested the event is. | |
148 | ||
149 | =item $bool = $trace->{buffered} | |
150 | ||
151 | =item $bool = $trace->buffered() | |
152 | ||
153 | True if the event was buffered and not sent to the formatter independent of a | |
154 | parent (This should never be set when nested is C<0> or C<undef>). | |
155 | ||
156 | =back | |
157 | ||
158 | =head1 METHODS | |
159 | ||
160 | B<Note:> All facet frames are also methods. | |
161 | ||
162 | =over 4 | |
163 | ||
164 | =item $trace->set_detail($msg) | |
165 | ||
166 | =item $msg = $trace->detail | |
167 | ||
168 | Used to get/set a custom trace message that will be used INSTEAD of | |
169 | C<< at <FILE> line <LINE> >> when calling C<< $trace->debug >>. | |
170 | ||
171 | C<detail()> is an alias to the C<details> facet field for backwards | |
172 | compatibility. | |
173 | ||
174 | =item $str = $trace->debug | |
175 | ||
176 | Typically returns the string C<< at <FILE> line <LINE> >>. If C<detail> is set | |
177 | then its value will be returned instead. | |
178 | ||
179 | =item $trace->alert($MESSAGE) | |
180 | ||
181 | This issues a warning at the frame (filename and line number where | |
182 | errors should be reported). | |
183 | ||
184 | =item $trace->throw($MESSAGE) | |
185 | ||
186 | This throws an exception at the frame (filename and line number where | |
187 | errors should be reported). | |
188 | ||
189 | =item ($package, $file, $line, $subname) = $trace->call() | |
190 | ||
191 | Get the caller details for the debug-info. This is where errors should be | |
192 | reported. | |
193 | ||
194 | =item $pkg = $trace->package | |
195 | ||
196 | Get the debug-info package. | |
197 | ||
198 | =item $file = $trace->file | |
199 | ||
200 | Get the debug-info filename. | |
201 | ||
202 | =item $line = $trace->line | |
203 | ||
204 | Get the debug-info line number. | |
205 | ||
206 | =item $subname = $trace->subname | |
207 | ||
208 | Get the debug-info subroutine name. | |
209 | ||
210 | =item $sig = trace->signature | |
211 | ||
212 | Get a signature string that identifies this trace. This is used to check if | |
213 | multiple events are related. The Trace includes pid, tid, file, line number, | |
214 | and the cid which is C<'C\d+'> for traces created by a context, or C<'T\d+'> | |
215 | for traces created by C<new()>. | |
216 | ||
217 | =back | |
218 | ||
219 | =head1 SOURCE | |
220 | ||
221 | The source code repository for Test2 can be found at | |
222 | F<http://github.com/Test-More/test-more/>. | |
223 | ||
224 | =head1 MAINTAINERS | |
225 | ||
226 | =over 4 | |
227 | ||
228 | =item Chad Granum E<lt>exodist@cpan.orgE<gt> | |
229 | ||
230 | =back | |
231 | ||
232 | =head1 AUTHORS | |
233 | ||
234 | =over 4 | |
235 | ||
236 | =item Chad Granum E<lt>exodist@cpan.orgE<gt> | |
237 | ||
238 | =back | |
239 | ||
240 | =head1 COPYRIGHT | |
241 | ||
242 | Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>. | |
243 | ||
244 | This program is free software; you can redistribute it and/or | |
245 | modify it under the same terms as Perl itself. | |
246 | ||
247 | See F<http://dev.perl.org/licenses/> | |
248 | ||
249 | =cut |