File Coverage

inc/Test2/Util/Trace.pm
Criterion Covered Total %
statement 20 43 46.5
branch 3 8 37.5
condition n/a
subroutine 7 17 41.1
pod 10 12 83.3
total 40 80 50.0


line stmt bran cond sub pod time code
1             #line 1
2 1     1   4 package Test2::Util::Trace;
  1         2  
  1         19  
3 1     1   4 use strict;
  1         1  
  1         37  
4             use warnings;
5              
6             our $VERSION = '1.302073';
7              
8 1     1   5  
  1         1  
  1         31  
9             use Test2::Util qw/get_tid pkg_to_file/;
10 1     1   3  
  1         13  
  1         33  
11             use Carp qw/confess/;
12 1     1   316  
  1         1  
  1         4  
13             use Test2::Util::HashBase qw{frame detail pid tid};
14              
15             sub init {
16 1 50   1 0 4 confess "The 'frame' attribute is required"
17             unless $_[0]->{+FRAME};
18 1 50       5  
19 1 50       5 $_[0]->{+PID} = $$ unless defined $_[0]->{+PID};
20             $_[0]->{+TID} = get_tid() unless defined $_[0]->{+TID};
21             }
22 1     1 0 1  
  1         25  
23             sub snapshot { bless {%{$_[0]}}, __PACKAGE__ };
24              
25 0     0 1   sub debug {
26 0 0         my $self = shift;
27 0           return $self->{+DETAIL} if $self->{+DETAIL};
28 0           my ($pkg, $file, $line) = $self->call;
29             return "at $file line $line";
30             }
31              
32 0     0 1   sub alert {
33 0           my $self = shift;
34 0           my ($msg) = @_;
35             warn $msg . ' ' . $self->debug . ".\n";
36             }
37              
38 0     0 1   sub throw {
39 0           my $self = shift;
40 0           my ($msg) = @_;
41             die $msg . ' ' . $self->debug . ".\n";
42             }
43 0     0 1    
  0            
44             sub call { @{$_[0]->{+FRAME}} }
45 0     0 1    
46 0     0 1   sub package { $_[0]->{+FRAME}->[0] }
47 0     0 1   sub file { $_[0]->{+FRAME}->[1] }
48 0     0 1   sub line { $_[0]->{+FRAME}->[2] }
49             sub subname { $_[0]->{+FRAME}->[3] }
50              
51 0     0 1   sub from_json {
52 0           my $class = shift;
53             my %p = @_;
54 0            
55 0           my $trace_pkg = delete $p{__PACKAGE__};
56             require(pkg_to_file($trace_pkg));
57 0            
58             return $trace_pkg->new(%p);
59             }
60              
61 0     0 1   sub TO_JSON {
62 0           my $self = shift;
63             return {%$self, __PACKAGE__ => ref $self};
64             }
65              
66             1;
67              
68             __END__