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

   1 package Test2::Util::Trace;
   2 use strict;
   3 use warnings;
   4
   5 our $VERSION = '1.302026';
   6
   7
   8 use Test2::Util qw/get_tid/;
   9
  10 use Carp qw/confess/;
  11
  12 use Test2::Util::HashBase qw{frame detail pid tid};
  13
  14 sub init {
  15     confess "The 'frame' attribute is required"
  16         unless $_[0]->{+FRAME};
  17
  18     $_[0]->{+PID} = $$        unless defined $_[0]->{+PID};
  19     $_[0]->{+TID} = get_tid() unless defined $_[0]->{+TID};
  20 }
  21
  22 sub snapshot { bless {%{$_[0]}}, __PACKAGE__ };
  23
  24 sub debug {
  25     my $self = shift;
  26     return $self->{+DETAIL} if $self->{+DETAIL};
  27     my ($pkg, $file, $line) = $self->call;
  28     return "at $file line $line";
  29 }
  30
  31 sub alert {
  32     my $self = shift;
  33     my ($msg) = @_;
  34     warn $msg . ' ' . $self->debug . ".\n";
  35 }
  36
  37 sub throw {
  38     my $self = shift;
  39     my ($msg) = @_;
  40     die $msg . ' ' . $self->debug . ".\n";
  41 }
  42
  43 sub call { @{$_[0]->{+FRAME}} }
  44
  45 sub package { $_[0]->{+FRAME}->[0] }
  46 sub file    { $_[0]->{+FRAME}->[1] }
  47 sub line    { $_[0]->{+FRAME}->[2] }
  48 sub subname { $_[0]->{+FRAME}->[3] }
  49
  50 1;
  51
  52 __END__
  53
  54 =pod
  55
  56 =encoding UTF-8
  57
  58 =head1 NAME
  59
  60 Test2::Util::Trace - Debug information for events
  61
  62 =head1 DESCRIPTION
  63
  64 The L<Test2::API::Context> object, as well as all L<Test2::Event> types need to
  65 have access to information about where they were created.  This object
  66 represents that information.
  67
  68 =head1 SYNOPSIS
  69
  70     use Test2::Util::Trace;
  71
  72     my $trace = Test2::Util::Trace->new(
  73         frame => [$package, $file, $line, $subname],
  74     );
  75
  76 =head1 METHODS
  77
  78 =over 4
  79
  80 =item $trace->set_detail($msg)
  81
  82 =item $msg = $trace->detail
  83
  84 Used to get/set a custom trace message that will be used INSTEAD of
  85 C<< at <FILE> line <LINE> >> when calling C<< $trace->debug >>.
  86
  87 =item $str = $trace->debug
  88
  89 Typically returns the string C<< at <FILE> line <LINE> >>. If C<detail> is set
  90 then its value will be returned instead.
  91
  92 =item $trace->alert($MESSAGE)
  93
  94 This issues a warning at the frame (filename and line number where
  95 errors should be reported).
  96
  97 =item $trace->throw($MESSAGE)
  98
  99 This throws an exception at the frame (filename and line number where
 100 errors should be reported).
 101
 102 =item $frame = $trace->frame()
 103
 104 Get the call frame arrayref.
 105
 106 =item ($package, $file, $line, $subname) = $trace->call()
 107
 108 Get the caller details for the debug-info. This is where errors should be
 109 reported.
 110
 111 =item $pkg = $trace->package
 112
 113 Get the debug-info package.
 114
 115 =item $file = $trace->file
 116
 117 Get the debug-info filename.
 118
 119 =item $line = $trace->line
 120
 121 Get the debug-info line number.
 122
 123 =item $subname = $trace->subname
 124
 125 Get the debug-info subroutine name.
 126
 127 =back
 128
 129 =head1 SOURCE
 130
 131 The source code repository for Test2 can be found at
 132 F<http://github.com/Test-More/test-more/>.
 133
 134 =head1 MAINTAINERS
 135
 136 =over 4
 137
 138 =item Chad Granum E<lt>exodist@cpan.orgE<gt>
 139
 140 =back
 141
 142 =head1 AUTHORS
 143
 144 =over 4
 145
 146 =item Chad Granum E<lt>exodist@cpan.orgE<gt>
 147
 148 =back
 149
 150 =head1 COPYRIGHT
 151
 152 Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
 153
 154 This program is free software; you can redistribute it and/or
 155 modify it under the same terms as Perl itself.
 156
 157 See F<http://dev.perl.org/licenses/>
 158
 159 =cut