Filename | /home/ss5/perl5/perlbrew/perls/perl-5.14.1/lib/site_perl/5.14.1/Devel/StackTrace/Frame.pm |
Statements | Executed 32 statements in 3.49ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 213µs | 213µs | BEGIN@10 | Devel::StackTrace::Frame::
1 | 1 | 1 | 34µs | 34µs | BEGIN@2 | Devel::StackTrace::Frame::
1 | 1 | 1 | 27µs | 38µs | BEGIN@6 | Devel::StackTrace::Frame::
1 | 1 | 1 | 25µs | 77µs | BEGIN@11 | Devel::StackTrace::Frame::
1 | 1 | 1 | 25µs | 45µs | BEGIN@7 | Devel::StackTrace::Frame::
0 | 0 | 0 | 0s | 0s | __ANON__[:17] | 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 | # spent 34µs within Devel::StackTrace::Frame::BEGIN@2 which was called:
# once (34µs+0s) by Devel::StackTrace::BEGIN@11 at line 4 | ||||
3 | 1 | 18µs | $Devel::StackTrace::Frame::VERSION = '1.27'; | ||
4 | 1 | 73µs | 1 | 34µs | } # spent 34µs making 1 call to Devel::StackTrace::Frame::BEGIN@2 |
5 | |||||
6 | 2 | 87µs | 2 | 48µs | # spent 38µs (27+11) within Devel::StackTrace::Frame::BEGIN@6 which was called:
# once (27µs+11µs) by Devel::StackTrace::BEGIN@11 at line 6 # spent 38µs making 1 call to Devel::StackTrace::Frame::BEGIN@6
# spent 11µs making 1 call to strict::import |
7 | 2 | 110µs | 2 | 64µs | # spent 45µs (25+19) within Devel::StackTrace::Frame::BEGIN@7 which was called:
# once (25µs+19µs) by Devel::StackTrace::BEGIN@11 at line 7 # spent 45µs making 1 call to Devel::StackTrace::Frame::BEGIN@7
# spent 19µs making 1 call to warnings::import |
8 | |||||
9 | # Create accessor routines | ||||
10 | # spent 213µs within Devel::StackTrace::Frame::BEGIN@10 which was called:
# once (213µs+0s) by Devel::StackTrace::BEGIN@11 at line 19 | ||||
11 | 2 | 385µs | 2 | 128µs | # spent 77µs (25+51) within Devel::StackTrace::Frame::BEGIN@11 which was called:
# once (25µs+51µs) by Devel::StackTrace::BEGIN@11 at line 11 # spent 77µs making 1 call to Devel::StackTrace::Frame::BEGIN@11
# spent 51µs making 1 call to strict::unimport |
12 | 1 | 21µs | foreach my $f ( | ||
13 | qw( package filename line subroutine hasargs | ||||
14 | wantarray evaltext is_require hints bitmask args ) | ||||
15 | ) { | ||||
16 | 11 | 10µs | next if $f eq 'args'; | ||
17 | 10 | 183µs | *{$f} = sub { my $s = shift; return $s->{$f} }; | ||
18 | } | ||||
19 | 1 | 2.57ms | 1 | 213µs | } # spent 213µs making 1 call to Devel::StackTrace::Frame::BEGIN@10 |
20 | |||||
21 | { | ||||
22 | 2 | 15µs | my @fields = ( | ||
23 | qw( package filename line subroutine hasargs wantarray | ||||
24 | evaltext is_require hints bitmask ) | ||||
25 | ); | ||||
26 | |||||
27 | sub new { | ||||
28 | my $proto = shift; | ||||
29 | my $class = ref $proto || $proto; | ||||
30 | |||||
31 | my $self = bless {}, $class; | ||||
32 | |||||
33 | @{$self}{@fields} = @{ shift() }; | ||||
34 | |||||
35 | # fixup unix-style paths on win32 | ||||
36 | $self->{filename} = File::Spec->canonpath( $self->{filename} ); | ||||
37 | |||||
38 | $self->{args} = shift; | ||||
39 | |||||
40 | $self->{respect_overload} = shift; | ||||
41 | |||||
42 | $self->{max_arg_length} = shift; | ||||
43 | |||||
44 | $self->{message} = shift; | ||||
45 | |||||
46 | $self->{indent} = shift; | ||||
47 | |||||
48 | return $self; | ||||
49 | } | ||||
50 | } | ||||
51 | |||||
52 | sub args { | ||||
53 | my $self = shift; | ||||
54 | |||||
55 | return @{ $self->{args} }; | ||||
56 | } | ||||
57 | |||||
58 | sub as_string { | ||||
59 | my $self = shift; | ||||
60 | my $first = shift; | ||||
61 | |||||
62 | my $sub = $self->subroutine; | ||||
63 | |||||
64 | # This code stolen straight from Carp.pm and then tweaked. All | ||||
65 | # errors are probably my fault -dave | ||||
66 | if ($first) { | ||||
67 | $sub | ||||
68 | = defined $self->{message} | ||||
69 | ? $self->{message} | ||||
70 | : 'Trace begun'; | ||||
71 | } | ||||
72 | else { | ||||
73 | |||||
74 | # Build a string, $sub, which names the sub-routine called. | ||||
75 | # This may also be "require ...", "eval '...' or "eval {...}" | ||||
76 | if ( my $eval = $self->evaltext ) { | ||||
77 | if ( $self->is_require ) { | ||||
78 | $sub = "require $eval"; | ||||
79 | } | ||||
80 | else { | ||||
81 | $eval =~ s/([\\\'])/\\$1/g; | ||||
82 | $sub = "eval '$eval'"; | ||||
83 | } | ||||
84 | } | ||||
85 | elsif ( $sub eq '(eval)' ) { | ||||
86 | $sub = 'eval {...}'; | ||||
87 | } | ||||
88 | |||||
89 | # if there are any arguments in the sub-routine call, format | ||||
90 | # them according to the format variables defined earlier in | ||||
91 | # this file and join them onto the $sub sub-routine string | ||||
92 | # | ||||
93 | # We copy them because they're going to be modified. | ||||
94 | # | ||||
95 | if ( my @a = $self->args ) { | ||||
96 | for (@a) { | ||||
97 | |||||
98 | # set args to the string "undef" if undefined | ||||
99 | $_ = "undef", next unless defined $_; | ||||
100 | |||||
101 | # hack! | ||||
102 | $_ = $self->Devel::StackTrace::_ref_to_string($_) | ||||
103 | if ref $_; | ||||
104 | |||||
105 | local $SIG{__DIE__}; | ||||
106 | local $@; | ||||
107 | |||||
108 | eval { | ||||
109 | if ( $self->{max_arg_length} | ||||
110 | && length $_ > $self->{max_arg_length} ) { | ||||
111 | substr( $_, $self->{max_arg_length} ) = '...'; | ||||
112 | } | ||||
113 | |||||
114 | s/'/\\'/g; | ||||
115 | |||||
116 | # 'quote' arg unless it looks like a number | ||||
117 | $_ = "'$_'" unless /^-?[\d.]+$/; | ||||
118 | |||||
119 | # print control/high ASCII chars as 'M-<char>' or '^<char>' | ||||
120 | s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg; | ||||
121 | s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg; | ||||
122 | }; | ||||
123 | |||||
124 | if ( my $e = $@ ) { | ||||
125 | $_ = $e =~ /malformed utf-8/i ? '(bad utf-8)' : '?'; | ||||
126 | } | ||||
127 | } | ||||
128 | |||||
129 | # append ('all', 'the', 'arguments') to the $sub string | ||||
130 | $sub .= '(' . join( ', ', @a ) . ')'; | ||||
131 | $sub .= ' called'; | ||||
132 | } | ||||
133 | } | ||||
134 | |||||
135 | # If the user opted into indentation (a la Carp::confess), pre-add a tab | ||||
136 | my $tab = $self->{indent} && !$first ? "\t" : q{}; | ||||
137 | |||||
138 | return "${tab}$sub at " . $self->filename . ' line ' . $self->line; | ||||
139 | } | ||||
140 | |||||
141 | 1 | 17µs | 1; | ||
142 | |||||
143 | # ABSTRACT: A single frame in a stack trace | ||||
144 | |||||
- - | |||||
147 | =pod | ||||
148 | |||||
149 | =head1 NAME | ||||
150 | |||||
151 | Devel::StackTrace::Frame - A single frame in a stack trace | ||||
152 | |||||
153 | =head1 VERSION | ||||
154 | |||||
155 | version 1.27 | ||||
156 | |||||
157 | =head1 DESCRIPTION | ||||
158 | |||||
159 | See L<Devel::StackTrace> for details. | ||||
160 | |||||
161 | =head1 METHODS | ||||
162 | |||||
163 | See the L<caller> documentation for more information on what these | ||||
164 | methods return. | ||||
165 | |||||
166 | =over 4 | ||||
167 | |||||
168 | =item * $frame->package | ||||
169 | |||||
170 | =item * $frame->filename | ||||
171 | |||||
172 | =item * $frame->line | ||||
173 | |||||
174 | =item * $frame->subroutine | ||||
175 | |||||
176 | =item * $frame->hasargs | ||||
177 | |||||
178 | =item * $frame->wantarray | ||||
179 | |||||
180 | =item * $frame->evaltext | ||||
181 | |||||
182 | Returns undef if the frame was not part of an eval. | ||||
183 | |||||
184 | =item * $frame->is_require | ||||
185 | |||||
186 | Returns undef if the frame was not part of a require. | ||||
187 | |||||
188 | =item * $frame->args | ||||
189 | |||||
190 | Returns the arguments passed to the frame. Note that any arguments | ||||
191 | that are references are returned as references, not copies. | ||||
192 | |||||
193 | =item * $frame->hints | ||||
194 | |||||
195 | =item * $frame->bitmask | ||||
196 | |||||
197 | =back | ||||
198 | |||||
199 | =head1 AUTHOR | ||||
200 | |||||
201 | Dave Rolsky <autarch@urth.org> | ||||
202 | |||||
203 | =head1 COPYRIGHT AND LICENSE | ||||
204 | |||||
205 | This software is Copyright (c) 2011 by Dave Rolsky. | ||||
206 | |||||
207 | This is free software, licensed under: | ||||
208 | |||||
209 | The Artistic License 2.0 (GPL Compatible) | ||||
210 | |||||
211 | =cut | ||||
212 | |||||
213 | |||||
214 | __END__ |