cpan/Test-Simple/lib/Test2/EventFacet/Trace.pm

   1 package Test2::EventFacet::Trace;
   2 use strict;
   3 use warnings;
   4
   5 our $VERSION = '1.302101';
   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