File Coverage

blib/lib/Test2/Util/Trace.pm
Criterion Covered Total %
statement 36 36 100.0
branch 8 8 100.0
condition n/a
subroutine 15 15 100.0
pod 8 10 80.0
total 67 69 97.1


line stmt bran cond sub pod time code
1             package Test2::Util::Trace;
2 57     57   499 use strict;
  57         56  
  57         1244  
3 57     57   161 use warnings;
  57         54  
  57         1828  
4              
5             our $VERSION = '0.000044';
6              
7 57     57   197 use Test2::Util qw/get_tid/;
  57         55  
  57         2012  
8              
9 57     57   172 use Carp qw/confess/;
  57         65  
  57         1957  
10              
11 57     57   17563 use Test2::Util::HashBase qw{frame detail pid tid};
  57         85  
  57         349  
12              
13             sub init {
14             confess "The 'frame' attribute is required"
15 139 100   139 0 517 unless $_[0]->{+FRAME};
16              
17 138 100       457 $_[0]->{+PID} = $$ unless defined $_[0]->{+PID};
18 138 100       428 $_[0]->{+TID} = get_tid() unless defined $_[0]->{+TID};
19             }
20              
21 173     173 0 144 sub snapshot { bless {%{$_[0]}}, __PACKAGE__ };
  173         1212  
22              
23             sub debug {
24 34     34 1 32 my $self = shift;
25 34 100       66 return $self->{+DETAIL} if $self->{+DETAIL};
26 33         55 my ($pkg, $file, $line) = $self->call;
27 33         141 return "at $file line $line";
28             }
29              
30             sub alert {
31 3     3 1 23 my $self = shift;
32 3         6 my ($msg) = @_;
33 3         12 warn $msg . ' ' . $self->debug . ".\n";
34             }
35              
36             sub throw {
37 5     5 1 18 my $self = shift;
38 5         8 my ($msg) = @_;
39 5         20 die $msg . ' ' . $self->debug . ".\n";
40             }
41              
42 34     34 1 30 sub call { @{$_[0]->{+FRAME}} }
  34         69  
43              
44 1     1 1 5 sub package { $_[0]->{+FRAME}->[0] }
45 1     1 1 4 sub file { $_[0]->{+FRAME}->[1] }
46 1     1 1 4 sub line { $_[0]->{+FRAME}->[2] }
47 1     1 1 3 sub subname { $_[0]->{+FRAME}->[3] }
48              
49             1;
50              
51             __END__