Filename | /usr/share/perl5/Error.pm |
Statements | Executed 7764 statements in 25.7ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
260 | 11 | 11 | 11.9ms | 265s | try (recurses: max depth 4, inclusive time 85.9s) | Error::subs::
282 | 10 | 10 | 4.00ms | 4.00ms | catch | Error::
1 | 1 | 1 | 1.67ms | 2.13ms | BEGIN@20 | Error::
1 | 1 | 1 | 1.23ms | 1.93ms | BEGIN@46 | Error::
282 | 10 | 10 | 1.23ms | 1.23ms | with | Error::subs::
96 | 3 | 3 | 995µs | 995µs | finally | Error::subs::
24 | 24 | 24 | 814µs | 10.2ms | import | Error::
21 | 3 | 3 | 418µs | 418µs | otherwise | Error::subs::
1 | 1 | 1 | 28µs | 28µs | BEGIN@16 | Error::
1 | 1 | 1 | 24µs | 31µs | BEGIN@14 | Error::
1 | 1 | 1 | 15µs | 67µs | BEGIN@15 | Error::
1 | 1 | 1 | 15µs | 124µs | BEGIN@295 | Error::subs::
1 | 1 | 1 | 10µs | 10µs | BEGIN@294 | Error::subs::
0 | 0 | 0 | 0s | 0s | new | Error::Simple::
0 | 0 | 0 | 0s | 0s | stringify | Error::Simple::
0 | 0 | 0 | 0s | 0s | DEATH | Error::WarnDie::
0 | 0 | 0 | 0s | 0s | TAXES | Error::WarnDie::
0 | 0 | 0 | 0s | 0s | gen_callstack | Error::WarnDie::
0 | 0 | 0 | 0s | 0s | import | Error::WarnDie::
0 | 0 | 0 | 0s | 0s | __ANON__[:23] | Error::
0 | 0 | 0 | 0s | 0s | _throw_Error_Simple | Error::
0 | 0 | 0 | 0s | 0s | associate | Error::
0 | 0 | 0 | 0s | 0s | file | Error::
0 | 0 | 0 | 0s | 0s | flush | Error::
0 | 0 | 0 | 0s | 0s | line | Error::
0 | 0 | 0 | 0s | 0s | new | Error::
0 | 0 | 0 | 0s | 0s | object | Error::
0 | 0 | 0 | 0s | 0s | prior | Error::
0 | 0 | 0 | 0s | 0s | record | Error::
0 | 0 | 0 | 0s | 0s | stacktrace | Error::
0 | 0 | 0 | 0s | 0s | stringify | Error::
0 | 0 | 0 | 0s | 0s | __ANON__[:492] | Error::subs::
0 | 0 | 0 | 0s | 0s | except | Error::subs::
0 | 0 | 0 | 0s | 0s | run_clauses | Error::subs::
0 | 0 | 0 | 0s | 0s | text | Error::
0 | 0 | 0 | 0s | 0s | throw | Error::
0 | 0 | 0 | 0s | 0s | value | Error::
0 | 0 | 0 | 0s | 0s | with | Error::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # Error.pm | ||||
2 | # | ||||
3 | # Copyright (c) 1997-8 Graham Barr <gbarr@ti.com>. All rights reserved. | ||||
4 | # This program is free software; you can redistribute it and/or | ||||
5 | # modify it under the same terms as Perl itself. | ||||
6 | # | ||||
7 | # Based on my original Error.pm, and Exceptions.pm by Peter Seibel | ||||
8 | # <peter@weblogic.com> and adapted by Jesse Glick <jglick@sig.bsh.com>. | ||||
9 | # | ||||
10 | # but modified ***significantly*** | ||||
11 | |||||
12 | package Error; | ||||
13 | |||||
14 | 2 | 47µs | 2 | 39µs | # spent 31µs (24+8) within Error::BEGIN@14 which was called:
# once (24µs+8µs) by Foswiki::BEGIN@47 at line 14 # spent 31µs making 1 call to Error::BEGIN@14
# spent 8µs making 1 call to strict::import |
15 | 2 | 50µs | 2 | 118µs | # spent 67µs (15+51) within Error::BEGIN@15 which was called:
# once (15µs+51µs) by Foswiki::BEGIN@47 at line 15 # spent 67µs making 1 call to Error::BEGIN@15
# spent 51µs making 1 call to vars::import |
16 | 2 | 126µs | 1 | 28µs | # spent 28µs within Error::BEGIN@16 which was called:
# once (28µs+0s) by Foswiki::BEGIN@47 at line 16 # spent 28µs making 1 call to Error::BEGIN@16 |
17 | |||||
18 | 1 | 2µs | $VERSION = "0.17010"; | ||
19 | |||||
20 | # spent 2.13ms (1.67+456µs) within Error::BEGIN@20 which was called:
# once (1.67ms+456µs) by Foswiki::BEGIN@47 at line 25 | ||||
21 | '""' => 'stringify', | ||||
22 | '0+' => 'value', | ||||
23 | 'bool' => sub { return 1; }, | ||||
24 | 1 | 15µs | 1 | 149µs | 'fallback' => 1 # spent 149µs making 1 call to overload::import |
25 | 1 | 1.44ms | 1 | 2.13ms | ); # spent 2.13ms making 1 call to Error::BEGIN@20 |
26 | |||||
27 | 1 | 1µs | $Error::Depth = 0; # Depth to pass to caller() | ||
28 | 1 | 1µs | $Error::Debug = 0; # Generate verbose stack traces | ||
29 | 1 | 2µs | @Error::STACK = (); # Clause stack for try | ||
30 | 1 | 1µs | $Error::THROWN = undef; # last error thrown, a workaround until die $ref works | ||
31 | |||||
32 | 1 | 1µs | my $LAST; # Last error created | ||
33 | 1 | 1µs | my %ERROR; # Last error associated with package | ||
34 | |||||
35 | sub _throw_Error_Simple | ||||
36 | { | ||||
37 | my $args = shift; | ||||
38 | return Error::Simple->new($args->{'text'}); | ||||
39 | } | ||||
40 | |||||
41 | 1 | 2µs | $Error::ObjectifyCallback = \&_throw_Error_Simple; | ||
42 | |||||
43 | |||||
44 | # Exported subs are defined in Error::subs | ||||
45 | |||||
46 | 2 | 1.76ms | 1 | 1.93ms | # spent 1.93ms (1.23+691µs) within Error::BEGIN@46 which was called:
# once (1.23ms+691µs) by Foswiki::BEGIN@47 at line 46 # spent 1.93ms making 1 call to Error::BEGIN@46 |
47 | |||||
48 | # spent 10.2ms (814µs+9.39) within Error::import which was called 24 times, avg 425µs/call:
# once (60µs+527µs) by Foswiki::Plugins::CommentPlugin::BEGIN@10 at line 10 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Plugins/CommentPlugin.pm
# once (48µs+499µs) by Foswiki::Plugins::TablePlugin::Core::BEGIN@11 at line 11 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Plugins/TablePlugin/Core.pm
# once (46µs+493µs) by Foswiki::Search::Node::BEGIN@16 at line 16 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Search/Node.pm
# once (48µs+490µs) by Foswiki::Render::BEGIN@15 at line 15 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Render.pm
# once (43µs+472µs) by Foswiki::Form::BEGIN@39 at line 39 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Form.pm
# once (56µs+396µs) by Foswiki::Plugin::BEGIN@11 at line 11 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Plugin.pm
# once (32µs+416µs) by Foswiki::BEGIN@47 at line 47 of /usr/local/src/github.com/foswiki/core/lib/Foswiki.pm
# once (30µs+392µs) by Foswiki::Store::VC::Store::BEGIN@40 at line 40 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Store/VC/Store.pm
# once (33µs+387µs) by Foswiki::UI::Rest::BEGIN@16 at line 16 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/UI/Rest.pm
# once (31µs+371µs) by Foswiki::Infix::Parser::BEGIN@24 at line 24 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Infix/Parser.pm
# once (29µs+371µs) by Foswiki::Users::HtPasswdUser::BEGIN@22 at line 22 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Users/HtPasswdUser.pm
# once (29µs+370µs) by Foswiki::Users::TopicUserMapping::BEGIN@34 at line 34 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Users/TopicUserMapping.pm
# once (32µs+364µs) by Foswiki::UI::BEGIN@149 at line 149 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/UI.pm
# once (30µs+366µs) by Foswiki::Engine::BEGIN@19 at line 19 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Engine.pm
# once (29µs+364µs) by Foswiki::Sandbox::BEGIN@36 at line 36 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Sandbox.pm
# once (29µs+363µs) by Foswiki::Plugins::CommentPlugin::BEGIN@8.53 at line 8 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Plugins/CommentPlugin/Comment.pm
# once (28µs+361µs) by Foswiki::Search::BEGIN@15 at line 15 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Search.pm
# once (27µs+360µs) by Foswiki::Query::OP_ref::BEGIN@16 at line 16 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Query/OP_ref.pm
# once (28µs+350µs) by Foswiki::Meta::BEGIN@117 at line 117 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Meta.pm
# once (26µs+347µs) by Foswiki::Plugins::HistoryPlugin::BEGIN@8 at line 8 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Plugins/HistoryPlugin.pm
# once (27µs+339µs) by Foswiki::Store::BEGIN@55 at line 55 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Store.pm
# once (24µs+338µs) by Foswiki::Func::BEGIN@59 at line 59 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Func.pm
# once (24µs+335µs) by Foswiki::Query::Node::BEGIN@35 at line 35 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Query/Node.pm
# once (25µs+323µs) by Foswiki::LoginManager::BEGIN@54 at line 54 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/LoginManager.pm | ||||
49 | 24 | 43µs | shift; | ||
50 | 24 | 89µs | my @tags = @_; | ||
51 | 24 | 93µs | local $Exporter::ExportLevel = $Exporter::ExportLevel + 1; | ||
52 | |||||
53 | @tags = grep { | ||||
54 | 48 | 215µs | if( $_ eq ':warndie' ) { | ||
55 | Error::WarnDie->import(); | ||||
56 | 0; | ||||
57 | } | ||||
58 | else { | ||||
59 | 24 | 40µs | 1; | ||
60 | } | ||||
61 | } @tags; | ||||
62 | |||||
63 | 24 | 413µs | 24 | 9.39ms | Error::subs->import(@tags); # spent 9.39ms making 24 calls to Exporter::import, avg 391µs/call |
64 | } | ||||
65 | |||||
66 | # I really want to use last for the name of this method, but it is a keyword | ||||
67 | # which prevent the syntax last Error | ||||
68 | |||||
69 | sub prior { | ||||
70 | shift; # ignore | ||||
71 | |||||
72 | return $LAST unless @_; | ||||
73 | |||||
74 | my $pkg = shift; | ||||
75 | return exists $ERROR{$pkg} ? $ERROR{$pkg} : undef | ||||
76 | unless ref($pkg); | ||||
77 | |||||
78 | my $obj = $pkg; | ||||
79 | my $err = undef; | ||||
80 | if($obj->isa('HASH')) { | ||||
81 | $err = $obj->{'__Error__'} | ||||
82 | if exists $obj->{'__Error__'}; | ||||
83 | } | ||||
84 | elsif($obj->isa('GLOB')) { | ||||
85 | $err = ${*$obj}{'__Error__'} | ||||
86 | if exists ${*$obj}{'__Error__'}; | ||||
87 | } | ||||
88 | |||||
89 | $err; | ||||
90 | } | ||||
91 | |||||
92 | sub flush { | ||||
93 | shift; #ignore | ||||
94 | |||||
95 | unless (@_) { | ||||
96 | $LAST = undef; | ||||
97 | return; | ||||
98 | } | ||||
99 | |||||
100 | my $pkg = shift; | ||||
101 | return unless ref($pkg); | ||||
102 | |||||
103 | undef $ERROR{$pkg} if defined $ERROR{$pkg}; | ||||
104 | } | ||||
105 | |||||
106 | # Return as much information as possible about where the error | ||||
107 | # happened. The -stacktrace element only exists if $Error::DEBUG | ||||
108 | # was set when the error was created | ||||
109 | |||||
110 | sub stacktrace { | ||||
111 | my $self = shift; | ||||
112 | |||||
113 | return $self->{'-stacktrace'} | ||||
114 | if exists $self->{'-stacktrace'}; | ||||
115 | |||||
116 | my $text = exists $self->{'-text'} ? $self->{'-text'} : "Died"; | ||||
117 | |||||
118 | $text .= sprintf(" at %s line %d.\n", $self->file, $self->line) | ||||
119 | unless($text =~ /\n$/s); | ||||
120 | |||||
121 | $text; | ||||
122 | } | ||||
123 | |||||
124 | |||||
125 | sub associate { | ||||
126 | my $err = shift; | ||||
127 | my $obj = shift; | ||||
128 | |||||
129 | return unless ref($obj); | ||||
130 | |||||
131 | if($obj->isa('HASH')) { | ||||
132 | $obj->{'__Error__'} = $err; | ||||
133 | } | ||||
134 | elsif($obj->isa('GLOB')) { | ||||
135 | ${*$obj}{'__Error__'} = $err; | ||||
136 | } | ||||
137 | $obj = ref($obj); | ||||
138 | $ERROR{ ref($obj) } = $err; | ||||
139 | |||||
140 | return; | ||||
141 | } | ||||
142 | |||||
143 | |||||
144 | sub new { | ||||
145 | my $self = shift; | ||||
146 | my($pkg,$file,$line) = caller($Error::Depth); | ||||
147 | |||||
148 | my $err = bless { | ||||
149 | '-package' => $pkg, | ||||
150 | '-file' => $file, | ||||
151 | '-line' => $line, | ||||
152 | @_ | ||||
153 | }, $self; | ||||
154 | |||||
155 | $err->associate($err->{'-object'}) | ||||
156 | if(exists $err->{'-object'}); | ||||
157 | |||||
158 | # To always create a stacktrace would be very inefficient, so | ||||
159 | # we only do it if $Error::Debug is set | ||||
160 | |||||
161 | if($Error::Debug) { | ||||
162 | require Carp; | ||||
163 | local $Carp::CarpLevel = $Error::Depth; | ||||
164 | my $text = defined($err->{'-text'}) ? $err->{'-text'} : "Error"; | ||||
165 | my $trace = Carp::longmess($text); | ||||
166 | # Remove try calls from the trace | ||||
167 | $trace =~ s/(\n\s+\S+__ANON__[^\n]+)?\n\s+eval[^\n]+\n\s+Error::subs::try[^\n]+(?=\n)//sog; | ||||
168 | $trace =~ s/(\n\s+\S+__ANON__[^\n]+)?\n\s+eval[^\n]+\n\s+Error::subs::run_clauses[^\n]+\n\s+Error::subs::try[^\n]+(?=\n)//sog; | ||||
169 | $err->{'-stacktrace'} = $trace | ||||
170 | } | ||||
171 | |||||
172 | $@ = $LAST = $ERROR{$pkg} = $err; | ||||
173 | } | ||||
174 | |||||
175 | # Throw an error. this contains some very gory code. | ||||
176 | |||||
177 | sub throw { | ||||
178 | my $self = shift; | ||||
179 | local $Error::Depth = $Error::Depth + 1; | ||||
180 | |||||
181 | # if we are not rethrow-ing then create the object to throw | ||||
182 | $self = $self->new(@_) unless ref($self); | ||||
183 | |||||
184 | die $Error::THROWN = $self; | ||||
185 | } | ||||
186 | |||||
187 | # syntactic sugar for | ||||
188 | # | ||||
189 | # die with Error( ... ); | ||||
190 | |||||
191 | sub with { | ||||
192 | my $self = shift; | ||||
193 | local $Error::Depth = $Error::Depth + 1; | ||||
194 | |||||
195 | $self->new(@_); | ||||
196 | } | ||||
197 | |||||
198 | # syntactic sugar for | ||||
199 | # | ||||
200 | # record Error( ... ) and return; | ||||
201 | |||||
202 | sub record { | ||||
203 | my $self = shift; | ||||
204 | local $Error::Depth = $Error::Depth + 1; | ||||
205 | |||||
206 | $self->new(@_); | ||||
207 | } | ||||
208 | |||||
209 | # catch clause for | ||||
210 | # | ||||
211 | # try { ... } catch CLASS with { ... } | ||||
212 | |||||
213 | # spent 4.00ms within Error::catch which was called 282 times, avg 14µs/call:
# 77 times (1.07ms+0s) by Foswiki::Infix::Parser::_parse at line 304 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Infix/Parser.pm, avg 14µs/call
# 75 times (1.14ms+0s) by Foswiki::IF at line 52 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Macros/IF.pm, avg 15µs/call
# 63 times (882µs+0s) by Foswiki::Users::HtPasswdUser::fetchPass at line 487 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Users/HtPasswdUser.pm, avg 14µs/call
# 57 times (757µs+0s) by Foswiki::Plugin::registerHandlers at line 248 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Plugin.pm, avg 13µs/call
# 5 times (59µs+0s) by Foswiki::UI::_execute at line 435 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/UI.pm, avg 12µs/call
# once (25µs+0s) by Foswiki::Search::parseSearch at line 142 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Search.pm
# once (20µs+0s) by Foswiki::QUERY at line 65 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Macros/QUERY.pm
# once (16µs+0s) by Foswiki::FORMAT at line 73 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Macros/FORMAT.pm
# once (16µs+0s) by Foswiki::Meta::renderFormForDisplay at line 1748 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Meta.pm
# once (14µs+0s) by Foswiki::Engine::prepare at line 144 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Engine.pm | ||||
214 | 282 | 511µs | my $pkg = shift; | ||
215 | 282 | 407µs | my $code = shift; | ||
216 | 282 | 471µs | my $clauses = shift || {}; | ||
217 | 282 | 746µs | my $catch = $clauses->{'catch'} ||= []; | ||
218 | |||||
219 | 282 | 647µs | unshift @$catch, $pkg, $code; | ||
220 | |||||
221 | 282 | 1.55ms | $clauses; | ||
222 | } | ||||
223 | |||||
224 | # Object query methods | ||||
225 | |||||
226 | sub object { | ||||
227 | my $self = shift; | ||||
228 | exists $self->{'-object'} ? $self->{'-object'} : undef; | ||||
229 | } | ||||
230 | |||||
231 | sub file { | ||||
232 | my $self = shift; | ||||
233 | exists $self->{'-file'} ? $self->{'-file'} : undef; | ||||
234 | } | ||||
235 | |||||
236 | sub line { | ||||
237 | my $self = shift; | ||||
238 | exists $self->{'-line'} ? $self->{'-line'} : undef; | ||||
239 | } | ||||
240 | |||||
241 | sub text { | ||||
242 | my $self = shift; | ||||
243 | exists $self->{'-text'} ? $self->{'-text'} : undef; | ||||
244 | } | ||||
245 | |||||
246 | # overload methods | ||||
247 | |||||
248 | sub stringify { | ||||
249 | my $self = shift; | ||||
250 | defined $self->{'-text'} ? $self->{'-text'} : "Died"; | ||||
251 | } | ||||
252 | |||||
253 | sub value { | ||||
254 | my $self = shift; | ||||
255 | exists $self->{'-value'} ? $self->{'-value'} : undef; | ||||
256 | } | ||||
257 | |||||
258 | package Error::Simple; | ||||
259 | |||||
260 | 1 | 9µs | @Error::Simple::ISA = qw(Error); | ||
261 | |||||
262 | sub new { | ||||
263 | my $self = shift; | ||||
264 | my $text = "" . shift; | ||||
265 | my $value = shift; | ||||
266 | my(@args) = (); | ||||
267 | |||||
268 | local $Error::Depth = $Error::Depth + 1; | ||||
269 | |||||
270 | @args = ( -file => $1, -line => $2) | ||||
271 | if($text =~ s/\s+at\s+(\S+)\s+line\s+(\d+)(?:,\s*<[^>]*>\s+line\s+\d+)?\.?\n?$//s); | ||||
272 | push(@args, '-value', 0 + $value) | ||||
273 | if defined($value); | ||||
274 | |||||
275 | $self->SUPER::new(-text => $text, @args); | ||||
276 | } | ||||
277 | |||||
278 | sub stringify { | ||||
279 | my $self = shift; | ||||
280 | my $text = $self->SUPER::stringify; | ||||
281 | $text .= sprintf(" at %s line %d.\n", $self->file, $self->line) | ||||
282 | unless($text =~ /\n$/s); | ||||
283 | $text; | ||||
284 | } | ||||
285 | |||||
286 | ########################################################################## | ||||
287 | ########################################################################## | ||||
288 | |||||
289 | # Inspired by code from Jesse Glick <jglick@sig.bsh.com> and | ||||
290 | # Peter Seibel <peter@weblogic.com> | ||||
291 | |||||
292 | package Error::subs; | ||||
293 | |||||
294 | 2 | 45µs | 1 | 10µs | # spent 10µs within Error::subs::BEGIN@294 which was called:
# once (10µs+0s) by Foswiki::BEGIN@47 at line 294 # spent 10µs making 1 call to Error::subs::BEGIN@294 |
295 | 2 | 2.29ms | 2 | 232µs | # spent 124µs (15+108) within Error::subs::BEGIN@295 which was called:
# once (15µs+108µs) by Foswiki::BEGIN@47 at line 295 # spent 124µs making 1 call to Error::subs::BEGIN@295
# spent 108µs making 1 call to vars::import |
296 | |||||
297 | 1 | 3µs | @EXPORT_OK = qw(try with finally except otherwise); | ||
298 | 1 | 3µs | %EXPORT_TAGS = (try => \@EXPORT_OK); | ||
299 | |||||
300 | 1 | 5µs | @ISA = qw(Exporter); | ||
301 | |||||
302 | sub run_clauses ($$$\@) { | ||||
303 | my($clauses,$err,$wantarray,$result) = @_; | ||||
304 | my $code = undef; | ||||
305 | local $Error::THROWN = undef; | ||||
306 | |||||
307 | $err = $Error::ObjectifyCallback->({'text' =>$err}) unless ref($err); | ||||
308 | |||||
309 | CATCH: { | ||||
310 | |||||
311 | # catch | ||||
312 | my $catch; | ||||
313 | if(defined($catch = $clauses->{'catch'})) { | ||||
314 | my $i = 0; | ||||
315 | |||||
316 | CATCHLOOP: | ||||
317 | for( ; $i < @$catch ; $i += 2) { | ||||
318 | my $pkg = $catch->[$i]; | ||||
319 | unless(defined $pkg) { | ||||
320 | #except | ||||
321 | splice(@$catch,$i,2,$catch->[$i+1]->()); | ||||
322 | $i -= 2; | ||||
323 | next CATCHLOOP; | ||||
324 | } | ||||
325 | elsif(Scalar::Util::blessed($err) && $err->isa($pkg)) { | ||||
326 | $code = $catch->[$i+1]; | ||||
327 | while(1) { | ||||
328 | my $more = 0; | ||||
329 | local($Error::THROWN, $@); | ||||
330 | my $ok = eval { | ||||
331 | $@ = $err; | ||||
332 | if($wantarray) { | ||||
333 | @{$result} = $code->($err,\$more); | ||||
334 | } | ||||
335 | elsif(defined($wantarray)) { | ||||
336 | @{$result} = (); | ||||
337 | $result->[0] = $code->($err,\$more); | ||||
338 | } | ||||
339 | else { | ||||
340 | $code->($err,\$more); | ||||
341 | } | ||||
342 | 1; | ||||
343 | }; | ||||
344 | if( $ok ) { | ||||
345 | next CATCHLOOP if $more; | ||||
346 | undef $err; | ||||
347 | } | ||||
348 | else { | ||||
349 | $err = $@ || $Error::THROWN; | ||||
350 | $err = $Error::ObjectifyCallback->({'text' =>$err}) | ||||
351 | unless ref($err); | ||||
352 | } | ||||
353 | last CATCH; | ||||
354 | }; | ||||
355 | } | ||||
356 | } | ||||
357 | } | ||||
358 | |||||
359 | # otherwise | ||||
360 | my $owise; | ||||
361 | if(defined($owise = $clauses->{'otherwise'})) { | ||||
362 | my $code = $clauses->{'otherwise'}; | ||||
363 | my $more = 0; | ||||
364 | local($Error::THROWN, $@); | ||||
365 | my $ok = eval { | ||||
366 | $@ = $err; | ||||
367 | if($wantarray) { | ||||
368 | @{$result} = $code->($err,\$more); | ||||
369 | } | ||||
370 | elsif(defined($wantarray)) { | ||||
371 | @{$result} = (); | ||||
372 | $result->[0] = $code->($err,\$more); | ||||
373 | } | ||||
374 | else { | ||||
375 | $code->($err,\$more); | ||||
376 | } | ||||
377 | 1; | ||||
378 | }; | ||||
379 | if( $ok ) { | ||||
380 | undef $err; | ||||
381 | } | ||||
382 | else { | ||||
383 | $err = $@ || $Error::THROWN; | ||||
384 | |||||
385 | $err = $Error::ObjectifyCallback->({'text' =>$err}) | ||||
386 | unless ref($err); | ||||
387 | } | ||||
388 | } | ||||
389 | } | ||||
390 | $err; | ||||
391 | } | ||||
392 | |||||
393 | # spent 265s (11.9ms+265) within Error::subs::try which was called 260 times, avg 1.02s/call:
# 77 times (3.27ms+-3.27ms) by Foswiki::Infix::Parser::_parse at line 304 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Infix/Parser.pm, avg 0s/call
# 75 times (3.58ms+-3.58ms) by Foswiki::IF at line 52 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Macros/IF.pm, avg 0s/call
# 63 times (2.63ms+-2.63ms) by Foswiki::Users::HtPasswdUser::fetchPass at line 487 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Users/HtPasswdUser.pm, avg 0s/call
# 20 times (1.19ms+-1.19ms) by Foswiki::INCLUDE at line 343 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Macros/INCLUDE.pm, avg 0s/call
# 19 times (893µs+-893µs) by Foswiki::Plugin::registerHandlers at line 248 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Plugin.pm, avg 0s/call
# once (58µs+265s) by Foswiki::UI::_execute at line 435 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/UI.pm
# once (49µs+6.10ms) by Foswiki::Engine::prepare at line 144 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Engine.pm
# once (60µs+-60µs) by Foswiki::Search::parseSearch at line 142 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Search.pm
# once (60µs+-60µs) by Foswiki::Meta::renderFormForDisplay at line 1748 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Meta.pm
# once (59µs+-59µs) by Foswiki::QUERY at line 65 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Macros/QUERY.pm
# once (52µs+-52µs) by Foswiki::FORMAT at line 73 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Macros/FORMAT.pm | ||||
394 | 260 | 392µs | my $try = shift; | ||
395 | 260 | 435µs | my $clauses = @_ ? shift : {}; | ||
396 | 260 | 354µs | my $ok = 0; | ||
397 | 260 | 350µs | my $err = undef; | ||
398 | 260 | 423µs | my @result = (); | ||
399 | |||||
400 | 260 | 519µs | unshift @Error::STACK, $clauses; | ||
401 | |||||
402 | 260 | 438µs | my $wantarray = wantarray(); | ||
403 | |||||
404 | 260 | 638µs | do { | ||
405 | 260 | 411µs | local $Error::THROWN = undef; | ||
406 | 260 | 356µs | local $@ = undef; | ||
407 | |||||
408 | 260 | 826µs | $ok = eval { | ||
409 | 260 | 759µs | if($wantarray) { | ||
410 | @result = $try->(); | ||||
411 | } | ||||
412 | elsif(defined $wantarray) { | ||||
413 | $result[0] = $try->(); | ||||
414 | } | ||||
415 | else { | ||||
416 | 260 | 1.33ms | 260 | 351s | $try->(); # spent 265s making 1 call to Foswiki::UI::__ANON__[/usr/local/src/github.com/foswiki/core/lib/Foswiki/UI.pm:318]
# spent 81.2s making 19 calls to Foswiki::Plugin::__ANON__[/usr/local/src/github.com/foswiki/core/lib/Foswiki/Plugin.pm:235], avg 4.27s/call
# spent 3.16s making 20 calls to Foswiki::__ANON__[/usr/local/src/github.com/foswiki/core/lib/Foswiki/Macros/INCLUDE.pm:326], avg 158ms/call
# spent 1.35s making 1 call to Foswiki::Meta::__ANON__[/usr/local/src/github.com/foswiki/core/lib/Foswiki/Meta.pm:1739]
# spent 79.9ms making 75 calls to Foswiki::__ANON__[/usr/local/src/github.com/foswiki/core/lib/Foswiki/Macros/IF.pm:43], avg 1.07ms/call
# spent 30.1ms making 77 calls to Foswiki::Infix::Parser::__ANON__[/usr/local/src/github.com/foswiki/core/lib/Foswiki/Infix/Parser.pm:299], avg 391µs/call
# spent 21.2ms making 63 calls to Foswiki::Users::HtPasswdUser::__ANON__[/usr/local/src/github.com/foswiki/core/lib/Foswiki/Users/HtPasswdUser.pm:484], avg 337µs/call
# spent 6.10ms making 1 call to Foswiki::Engine::__ANON__[/usr/local/src/github.com/foswiki/core/lib/Foswiki/Engine.pm:102]
# spent 2.84ms making 1 call to Foswiki::__ANON__[/usr/local/src/github.com/foswiki/core/lib/Foswiki/Macros/QUERY.pm:56]
# spent 1.73ms making 1 call to Foswiki::Search::__ANON__[/usr/local/src/github.com/foswiki/core/lib/Foswiki/Search.pm:137]
# spent 554µs making 1 call to Foswiki::__ANON__[/usr/local/src/github.com/foswiki/core/lib/Foswiki/Macros/FORMAT.pm:65] |
417 | } | ||||
418 | 260 | 426µs | 1; | ||
419 | }; | ||||
420 | |||||
421 | 260 | 446µs | $err = $@ || $Error::THROWN | ||
422 | unless $ok; | ||||
423 | }; | ||||
424 | |||||
425 | 260 | 429µs | shift @Error::STACK; | ||
426 | |||||
427 | 260 | 337µs | $err = run_clauses($clauses,$err,wantarray,@result) | ||
428 | unless($ok); | ||||
429 | |||||
430 | 260 | 868µs | 96 | 35.8ms | $clauses->{'finally'}->() # spent 35.4ms making 20 calls to Foswiki::__ANON__[/usr/local/src/github.com/foswiki/core/lib/Foswiki/Macros/INCLUDE.pm:343], avg 1.77ms/call
# spent 412µs making 75 calls to Foswiki::__ANON__[/usr/local/src/github.com/foswiki/core/lib/Foswiki/Macros/IF.pm:52], avg 5µs/call
# spent 6µs making 1 call to Foswiki::__ANON__[/usr/local/src/github.com/foswiki/core/lib/Foswiki/Macros/QUERY.pm:65] |
431 | if(defined($clauses->{'finally'})); | ||||
432 | |||||
433 | 260 | 347µs | if (defined($err)) | ||
434 | { | ||||
435 | if (Scalar::Util::blessed($err) && $err->can('throw')) | ||||
436 | { | ||||
437 | throw $err; | ||||
438 | } | ||||
439 | else | ||||
440 | { | ||||
441 | die $err; | ||||
442 | } | ||||
443 | } | ||||
444 | |||||
445 | 260 | 1.45ms | wantarray ? @result : $result[0]; | ||
446 | } | ||||
447 | |||||
448 | # Each clause adds a sub to the list of clauses. The finally clause is | ||||
449 | # always the last, and the otherwise clause is always added just before | ||||
450 | # the finally clause. | ||||
451 | # | ||||
452 | # All clauses, except the finally clause, add a sub which takes one argument | ||||
453 | # this argument will be the error being thrown. The sub will return a code ref | ||||
454 | # if that clause can handle that error, otherwise undef is returned. | ||||
455 | # | ||||
456 | # The otherwise clause adds a sub which unconditionally returns the users | ||||
457 | # code reference, this is why it is forced to be last. | ||||
458 | # | ||||
459 | # The catch clause is defined in Error.pm, as the syntax causes it to | ||||
460 | # be called as a method | ||||
461 | |||||
462 | # spent 1.23ms within Error::subs::with which was called 282 times, avg 4µs/call:
# 77 times (326µs+0s) by Foswiki::Infix::Parser::_parse at line 304 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Infix/Parser.pm, avg 4µs/call
# 75 times (331µs+0s) by Foswiki::IF at line 52 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Macros/IF.pm, avg 4µs/call
# 63 times (265µs+0s) by Foswiki::Users::HtPasswdUser::fetchPass at line 487 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Users/HtPasswdUser.pm, avg 4µs/call
# 57 times (252µs+0s) by Foswiki::Plugin::registerHandlers at line 248 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Plugin.pm, avg 4µs/call
# 5 times (20µs+0s) by Foswiki::UI::_execute at line 435 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/UI.pm, avg 4µs/call
# once (12µs+0s) by Foswiki::Search::parseSearch at line 142 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Search.pm
# once (7µs+0s) by Foswiki::QUERY at line 65 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Macros/QUERY.pm
# once (6µs+0s) by Foswiki::Meta::renderFormForDisplay at line 1748 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Meta.pm
# once (5µs+0s) by Foswiki::Engine::prepare at line 144 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Engine.pm
# once (5µs+0s) by Foswiki::FORMAT at line 73 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Macros/FORMAT.pm | ||||
463 | @_ | ||||
464 | 282 | 1.59ms | } | ||
465 | |||||
466 | # spent 995µs within Error::subs::finally which was called 96 times, avg 10µs/call:
# 75 times (665µs+0s) by Foswiki::IF at line 52 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Macros/IF.pm, avg 9µs/call
# 20 times (320µs+0s) by Foswiki::INCLUDE at line 343 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Macros/INCLUDE.pm, avg 16µs/call
# once (10µs+0s) by Foswiki::QUERY at line 65 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Macros/QUERY.pm | ||||
467 | 96 | 162µs | my $code = shift; | ||
468 | 96 | 282µs | my $clauses = { 'finally' => $code }; | ||
469 | 96 | 626µs | $clauses; | ||
470 | } | ||||
471 | |||||
472 | # The except clause is a block which returns a hashref or a list of | ||||
473 | # key-value pairs, where the keys are the classes and the values are subs. | ||||
474 | |||||
475 | sub except (&;$) { | ||||
476 | my $code = shift; | ||||
477 | my $clauses = shift || {}; | ||||
478 | my $catch = $clauses->{'catch'} ||= []; | ||||
479 | |||||
480 | my $sub = sub { | ||||
481 | my $ref; | ||||
482 | my(@array) = $code->($_[0]); | ||||
483 | if(@array == 1 && ref($array[0])) { | ||||
484 | $ref = $array[0]; | ||||
485 | $ref = [ %$ref ] | ||||
486 | if(UNIVERSAL::isa($ref,'HASH')); | ||||
487 | } | ||||
488 | else { | ||||
489 | $ref = \@array; | ||||
490 | } | ||||
491 | @$ref | ||||
492 | }; | ||||
493 | |||||
494 | unshift @{$catch}, undef, $sub; | ||||
495 | |||||
496 | $clauses; | ||||
497 | } | ||||
498 | |||||
499 | # spent 418µs within Error::subs::otherwise which was called 21 times, avg 20µs/call:
# 19 times (390µs+0s) by Foswiki::Plugin::registerHandlers at line 248 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Plugin.pm, avg 21µs/call
# once (14µs+0s) by Foswiki::UI::_execute at line 435 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/UI.pm
# once (14µs+0s) by Foswiki::Engine::prepare at line 144 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Engine.pm | ||||
500 | 21 | 166µs | my $code = shift; | ||
501 | 21 | 48µs | my $clauses = shift || {}; | ||
502 | |||||
503 | 21 | 38µs | if(exists $clauses->{'otherwise'}) { | ||
504 | require Carp; | ||||
505 | Carp::croak("Multiple otherwise clauses"); | ||||
506 | } | ||||
507 | |||||
508 | 21 | 53µs | $clauses->{'otherwise'} = $code; | ||
509 | |||||
510 | 21 | 148µs | $clauses; | ||
511 | } | ||||
512 | |||||
513 | 1; | ||||
514 | |||||
515 | package Error::WarnDie; | ||||
516 | |||||
517 | sub gen_callstack($) | ||||
518 | { | ||||
519 | my ( $start ) = @_; | ||||
520 | |||||
521 | require Carp; | ||||
522 | local $Carp::CarpLevel = $start; | ||||
523 | my $trace = Carp::longmess(""); | ||||
524 | # Remove try calls from the trace | ||||
525 | $trace =~ s/(\n\s+\S+__ANON__[^\n]+)?\n\s+eval[^\n]+\n\s+Error::subs::try[^\n]+(?=\n)//sog; | ||||
526 | $trace =~ s/(\n\s+\S+__ANON__[^\n]+)?\n\s+eval[^\n]+\n\s+Error::subs::run_clauses[^\n]+\n\s+Error::subs::try[^\n]+(?=\n)//sog; | ||||
527 | my @callstack = split( m/\n/, $trace ); | ||||
528 | return @callstack; | ||||
529 | } | ||||
530 | |||||
531 | 1 | 1µs | my $old_DIE; | ||
532 | 1 | 700ns | my $old_WARN; | ||
533 | |||||
534 | sub DEATH | ||||
535 | { | ||||
536 | my ( $e ) = @_; | ||||
537 | |||||
538 | local $SIG{__DIE__} = $old_DIE if( defined $old_DIE ); | ||||
539 | |||||
540 | die @_ if $^S; | ||||
541 | |||||
542 | my ( $etype, $message, $location, @callstack ); | ||||
543 | if ( ref($e) && $e->isa( "Error" ) ) { | ||||
544 | $etype = "exception of type " . ref( $e ); | ||||
545 | $message = $e->text; | ||||
546 | $location = $e->file . ":" . $e->line; | ||||
547 | @callstack = split( m/\n/, $e->stacktrace ); | ||||
548 | } | ||||
549 | else { | ||||
550 | # Don't apply subsequent layer of message formatting | ||||
551 | die $e if( $e =~ m/^\nUnhandled perl error caught at toplevel:\n\n/ ); | ||||
552 | $etype = "perl error"; | ||||
553 | my $stackdepth = 0; | ||||
554 | while( caller( $stackdepth ) =~ m/^Error(?:$|::)/ ) { | ||||
555 | $stackdepth++ | ||||
556 | } | ||||
557 | |||||
558 | @callstack = gen_callstack( $stackdepth + 1 ); | ||||
559 | |||||
560 | $message = "$e"; | ||||
561 | chomp $message; | ||||
562 | |||||
563 | if ( $message =~ s/ at (.*?) line (\d+)\.$// ) { | ||||
564 | $location = $1 . ":" . $2; | ||||
565 | } | ||||
566 | else { | ||||
567 | my @caller = caller( $stackdepth ); | ||||
568 | $location = $caller[1] . ":" . $caller[2]; | ||||
569 | } | ||||
570 | } | ||||
571 | |||||
572 | shift @callstack; | ||||
573 | # Do it this way in case there are no elements; we don't print a spurious \n | ||||
574 | my $callstack = join( "", map { "$_\n"} @callstack ); | ||||
575 | |||||
576 | die "\nUnhandled $etype caught at toplevel:\n\n $message\n\nThrown from: $location\n\nFull stack trace:\n\n$callstack\n"; | ||||
577 | } | ||||
578 | |||||
579 | sub TAXES | ||||
580 | { | ||||
581 | my ( $message ) = @_; | ||||
582 | |||||
583 | local $SIG{__WARN__} = $old_WARN if( defined $old_WARN ); | ||||
584 | |||||
585 | $message =~ s/ at .*? line \d+\.$//; | ||||
586 | chomp $message; | ||||
587 | |||||
588 | my @callstack = gen_callstack( 1 ); | ||||
589 | my $location = shift @callstack; | ||||
590 | |||||
591 | # $location already starts in a leading space | ||||
592 | $message .= $location; | ||||
593 | |||||
594 | # Do it this way in case there are no elements; we don't print a spurious \n | ||||
595 | my $callstack = join( "", map { "$_\n"} @callstack ); | ||||
596 | |||||
597 | warn "$message:\n$callstack"; | ||||
598 | } | ||||
599 | |||||
600 | sub import | ||||
601 | { | ||||
602 | $old_DIE = $SIG{__DIE__}; | ||||
603 | $old_WARN = $SIG{__WARN__}; | ||||
604 | |||||
605 | $SIG{__DIE__} = \&DEATH; | ||||
606 | $SIG{__WARN__} = \&TAXES; | ||||
607 | } | ||||
608 | |||||
609 | 1 | 15µs | 1; | ||
610 | |||||
611 | __END__ |