Filename | /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/Devel/StackTrace/Frame.pm |
Statements | Executed 32 statements in 671µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 37µs | 37µs | BEGIN@7 | Devel::StackTrace::Frame::
1 | 1 | 1 | 13µs | 26µs | BEGIN@3 | Devel::StackTrace::Frame::
1 | 1 | 1 | 8µs | 12µs | BEGIN@4 | Devel::StackTrace::Frame::
1 | 1 | 1 | 8µs | 18µs | BEGIN@8 | Devel::StackTrace::Frame::
0 | 0 | 0 | 0s | 0s | __ANON__[:14] | Devel::StackTrace::Frame::
0 | 0 | 0 | 0s | 0s | args | Devel::StackTrace::Frame::
0 | 0 | 0 | 0s | 0s | as_string | Devel::StackTrace::Frame::
0 | 0 | 0 | 0s | 0s | new | Devel::StackTrace::Frame::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Devel::StackTrace::Frame; | ||||
2 | 1 | 800ns | $Devel::StackTrace::Frame::VERSION = '2.00'; | ||
3 | 2 | 22µs | 2 | 38µs | # spent 26µs (13+13) within Devel::StackTrace::Frame::BEGIN@3 which was called:
# once (13µs+13µs) by Devel::StackTrace::BEGIN@10 at line 3 # spent 26µs making 1 call to Devel::StackTrace::Frame::BEGIN@3
# spent 13µs making 1 call to strict::import |
4 | 2 | 30µs | 2 | 16µs | # spent 12µs (8+4) within Devel::StackTrace::Frame::BEGIN@4 which was called:
# once (8µs+4µs) by Devel::StackTrace::BEGIN@10 at line 4 # spent 12µs making 1 call to Devel::StackTrace::Frame::BEGIN@4
# spent 4µs making 1 call to warnings::import |
5 | |||||
6 | # Create accessor routines | ||||
7 | # spent 37µs within Devel::StackTrace::Frame::BEGIN@7 which was called:
# once (37µs+0s) by Devel::StackTrace::BEGIN@10 at line 16 | ||||
8 | 2 | 66µs | 2 | 29µs | # spent 18µs (8+11) within Devel::StackTrace::Frame::BEGIN@8 which was called:
# once (8µs+11µs) by Devel::StackTrace::BEGIN@10 at line 8 # spent 18µs making 1 call to Devel::StackTrace::Frame::BEGIN@8
# spent 11µs making 1 call to strict::unimport |
9 | 1 | 6µs | foreach my $f ( | ||
10 | qw( package filename line subroutine hasargs | ||||
11 | wantarray evaltext is_require hints bitmask args ) | ||||
12 | ) { | ||||
13 | 11 | 1µs | next if $f eq 'args'; | ||
14 | 10 | 29µs | *{$f} = sub { my $s = shift; return $s->{$f} }; | ||
15 | } | ||||
16 | 1 | 508µs | 1 | 37µs | } # spent 37µs making 1 call to Devel::StackTrace::Frame::BEGIN@7 |
17 | |||||
18 | { | ||||
19 | 2 | 3µs | my @fields = ( | ||
20 | qw( package filename line subroutine hasargs wantarray | ||||
21 | evaltext is_require hints bitmask ) | ||||
22 | ); | ||||
23 | |||||
24 | sub new { | ||||
25 | my $proto = shift; | ||||
26 | my $class = ref $proto || $proto; | ||||
27 | |||||
28 | my $self = bless {}, $class; | ||||
29 | |||||
30 | @{$self}{@fields} = @{ shift() }; | ||||
31 | |||||
32 | # fixup unix-style paths on win32 | ||||
33 | $self->{filename} = File::Spec->canonpath( $self->{filename} ); | ||||
34 | |||||
35 | $self->{args} = shift; | ||||
36 | |||||
37 | $self->{respect_overload} = shift; | ||||
38 | |||||
39 | $self->{max_arg_length} = shift; | ||||
40 | |||||
41 | $self->{message} = shift; | ||||
42 | |||||
43 | $self->{indent} = shift; | ||||
44 | |||||
45 | return $self; | ||||
46 | } | ||||
47 | } | ||||
48 | |||||
49 | sub args { | ||||
50 | my $self = shift; | ||||
51 | |||||
52 | return @{ $self->{args} }; | ||||
53 | } | ||||
54 | |||||
55 | sub as_string { | ||||
56 | my $self = shift; | ||||
57 | my $first = shift; | ||||
58 | my $p = shift; | ||||
59 | |||||
60 | my $sub = $self->subroutine; | ||||
61 | |||||
62 | # This code stolen straight from Carp.pm and then tweaked. All | ||||
63 | # errors are probably my fault -dave | ||||
64 | if ($first) { | ||||
65 | $sub | ||||
66 | = defined $self->{message} | ||||
67 | ? $self->{message} | ||||
68 | : 'Trace begun'; | ||||
69 | } | ||||
70 | else { | ||||
71 | |||||
72 | # Build a string, $sub, which names the sub-routine called. | ||||
73 | # This may also be "require ...", "eval '...' or "eval {...}" | ||||
74 | if ( my $eval = $self->evaltext ) { | ||||
75 | if ( $self->is_require ) { | ||||
76 | $sub = "require $eval"; | ||||
77 | } | ||||
78 | else { | ||||
79 | $eval =~ s/([\\\'])/\\$1/g; | ||||
80 | $sub = "eval '$eval'"; | ||||
81 | } | ||||
82 | } | ||||
83 | elsif ( $sub eq '(eval)' ) { | ||||
84 | $sub = 'eval {...}'; | ||||
85 | } | ||||
86 | |||||
87 | # if there are any arguments in the sub-routine call, format | ||||
88 | # them according to the format variables defined earlier in | ||||
89 | # this file and join them onto the $sub sub-routine string | ||||
90 | # | ||||
91 | # We copy them because they're going to be modified. | ||||
92 | # | ||||
93 | if ( my @a = $self->args ) { | ||||
94 | for (@a) { | ||||
95 | |||||
96 | # set args to the string "undef" if undefined | ||||
97 | $_ = "undef", next unless defined $_; | ||||
98 | |||||
99 | # hack! | ||||
100 | $_ = $self->Devel::StackTrace::_ref_to_string($_) | ||||
101 | if ref $_; | ||||
102 | |||||
103 | local $SIG{__DIE__}; | ||||
104 | local $@; | ||||
105 | |||||
106 | eval { | ||||
107 | my $max_arg_length | ||||
108 | = exists $p->{max_arg_length} | ||||
109 | ? $p->{max_arg_length} | ||||
110 | : $self->{max_arg_length}; | ||||
111 | |||||
112 | if ( $max_arg_length | ||||
113 | && length $_ > $max_arg_length ) { | ||||
114 | substr( $_, $max_arg_length ) = '...'; | ||||
115 | } | ||||
116 | |||||
117 | s/'/\\'/g; | ||||
118 | |||||
119 | # 'quote' arg unless it looks like a number | ||||
120 | $_ = "'$_'" unless /^-?[\d.]+$/; | ||||
121 | |||||
122 | # print control/high ASCII chars as 'M-<char>' or '^<char>' | ||||
123 | s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg; | ||||
124 | s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg; | ||||
125 | }; | ||||
126 | |||||
127 | if ( my $e = $@ ) { | ||||
128 | $_ = $e =~ /malformed utf-8/i ? '(bad utf-8)' : '?'; | ||||
129 | } | ||||
130 | } | ||||
131 | |||||
132 | # append ('all', 'the', 'arguments') to the $sub string | ||||
133 | $sub .= '(' . join( ', ', @a ) . ')'; | ||||
134 | $sub .= ' called'; | ||||
135 | } | ||||
136 | } | ||||
137 | |||||
138 | # If the user opted into indentation (a la Carp::confess), pre-add a tab | ||||
139 | my $tab = $self->{indent} && !$first ? "\t" : q{}; | ||||
140 | |||||
141 | return "${tab}$sub at " . $self->filename . ' line ' . $self->line; | ||||
142 | } | ||||
143 | |||||
144 | 1 | 4µs | 1; | ||
145 | |||||
146 | # ABSTRACT: A single frame in a stack trace | ||||
147 | |||||
148 | __END__ |