File Coverage

blib/lib/StackTrace/Auto.pm
Criterion Covered Total %
statement 30 30 100.0
branch 8 8 100.0
condition 6 6 100.0
subroutine 9 9 100.0
pod 0 1 0.0
total 53 54 98.1


line stmt bran cond sub pod time code
1             package StackTrace::Auto;
2             # ABSTRACT: a role for generating stack traces during instantiation
3             $StackTrace::Auto::VERSION = '1.000';
4 1     1   659 use Moo::Role;
  1         2  
  1         6  
5 1     1   310 use Sub::Quote ();
  1         1  
  1         38  
6 1     1   7 use Module::Runtime 0.002 ();
  1         27  
  1         31  
7 1     1   6 use Scalar::Util ();
  1         2  
  1         435  
8              
9             #pod =head1 SYNOPSIS
10             #pod
11             #pod First, include StackTrace::Auto in a Moose or Mooclass...
12             #pod
13             #pod package Some::Class;
14             #pod # NOTE: Moo can also be used here instead of Moose
15             #pod use Moose;
16             #pod with 'StackTrace::Auto';
17             #pod
18             #pod ...then create an object of that class...
19             #pod
20             #pod my $obj = Some::Class->new;
21             #pod
22             #pod ...and now you have a stack trace for the object's creation.
23             #pod
24             #pod print $obj->stack_trace->as_string;
25             #pod
26             #pod =attr stack_trace
27             #pod
28             #pod This attribute will contain an object representing the stack at the point when
29             #pod the error was generated and thrown. It must be an object performing the
30             #pod C method.
31             #pod
32             #pod =attr stack_trace_class
33             #pod
34             #pod This attribute may be provided to use an alternate class for stack traces. The
35             #pod default is L.
36             #pod
37             #pod In general, you will not need to think about this attribute.
38             #pod
39             #pod =cut
40              
41             has stack_trace => (
42             is => 'ro',
43             isa => Sub::Quote::quote_sub(q{
44             require Scalar::Util;
45             die "stack_trace must be have an 'as_string' method!" unless
46             Scalar::Util::blessed($_[0]) && $_[0]->can('as_string')
47             }),
48             default => Sub::Quote::quote_sub(q{
49             $_[0]->stack_trace_class->new(
50             @{ $_[0]->stack_trace_args },
51             );
52             }),
53             lazy => 1,
54             init_arg => undef,
55             );
56              
57       25 0   sub BUILD {};
58             before BUILD => sub { $_[0]->stack_trace };
59              
60             has stack_trace_class => (
61             is => 'ro',
62             isa => Sub::Quote::quote_sub(q{
63             die "stack_trace_class must be a class that responds to ->new"
64             unless defined($_[0]) && !ref($_[0]) && $_[0]->can("new");
65             }),
66             coerce => Sub::Quote::quote_sub(q{
67             Module::Runtime::use_package_optimistically($_[0]);
68             }),
69             lazy => 1,
70             builder => '_build_stack_trace_class',
71             );
72              
73             #pod =attr stack_trace_args
74             #pod
75             #pod This attribute is an arrayref of arguments to pass when building the stack
76             #pod trace. In general, you will not need to think about it.
77             #pod
78             #pod =cut
79              
80             has stack_trace_args => (
81             is => 'ro',
82             isa => Sub::Quote::quote_sub(q{
83             die "stack_trace_args must be an arrayref"
84             unless ref($_[0]) && ref($_[0]) eq "ARRAY";
85             }),
86             lazy => 1,
87             builder => '_build_stack_trace_args',
88             );
89              
90             sub _build_stack_trace_class {
91 15     15   788 return 'Devel::StackTrace';
92             }
93              
94             sub _build_stack_trace_args {
95 25     25   2740 my ($self) = @_;
96              
97 25         86 Scalar::Util::weaken($self); # Prevent memory leak
98              
99 25         34 my $found_mark = 0;
100             return [
101             filter_frames_early => 1,
102             frame_filter => sub {
103 188     188   9924 my ($raw) = @_;
104 188         300 my $sub = $raw->{caller}->[3];
105 188         794 (my $package = $sub) =~ s/::\w+\z//;
106 188 100       421 if ($found_mark == 2) {
    100          
107 35         76 return 1;
108             }
109             elsif ($found_mark == 1) {
110 28 100 100     101 return 0 if $sub =~ /::new$/ && $self->isa($package);
111 25         40 $found_mark++;
112 25         56 return 1;
113             } else {
114 125 100 100     531 $found_mark++ if $sub =~ /::new$/ && $self->isa($package);
115 125         295 return 0;
116             }
117             },
118 25         473 ];
119             }
120              
121 1     1   8 no Moo::Role;
  1         2  
  1         4  
122             1;
123              
124             __END__