Filename | /usr/share/perl5/vendor_perl/Error.pm |
Statements | Executed 7767 statements in 12.2ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
250 | 9 | 9 | 8.95ms | 61.3s | try (recurses: max depth 4, inclusive time 67.1s) | Error::subs::
1 | 1 | 1 | 1.87ms | 2.76ms | BEGIN@20 | Error::
320 | 8 | 8 | 1.48ms | 1.48ms | catch | Error::
1 | 1 | 1 | 935µs | 1.29ms | BEGIN@46 | Error::
320 | 8 | 8 | 535µs | 535µs | with | Error::subs::
23 | 23 | 23 | 362µs | 3.40ms | import | Error::
48 | 3 | 3 | 201µs | 201µs | finally | Error::subs::
38 | 3 | 3 | 155µs | 155µs | otherwise | Error::subs::
1 | 1 | 1 | 21µs | 21µs | BEGIN@16 | Error::
1 | 1 | 1 | 20µs | 53µs | BEGIN@260 | Error::Simple::
1 | 1 | 1 | 20µs | 43µs | BEGIN@14 | Error::
1 | 1 | 1 | 15µs | 63µs | BEGIN@299 | Error::subs::
1 | 1 | 1 | 14µs | 40µs | BEGIN@15 | Error::
1 | 1 | 1 | 8µs | 8µs | BEGIN@298 | 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__[:495] | 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 | 48µs | 2 | 65µs | # spent 43µs (20+22) within Error::BEGIN@14 which was called:
# once (20µs+22µs) by Foswiki::BEGIN@47 at line 14 # spent 43µs making 1 call to Error::BEGIN@14
# spent 22µs making 1 call to strict::import |
15 | 2 | 42µs | 2 | 65µs | # spent 40µs (14+26) within Error::BEGIN@15 which was called:
# once (14µs+26µs) by Foswiki::BEGIN@47 at line 15 # spent 40µs making 1 call to Error::BEGIN@15
# spent 26µs making 1 call to vars::import |
16 | 2 | 125µs | 1 | 21µs | # spent 21µs within Error::BEGIN@16 which was called:
# once (21µs+0s) by Foswiki::BEGIN@47 at line 16 # spent 21µs making 1 call to Error::BEGIN@16 |
17 | |||||
18 | 1 | 900ns | $VERSION = "0.17020"; | ||
19 | |||||
20 | # spent 2.76ms (1.87+891µs) within Error::BEGIN@20 which was called:
# once (1.87ms+891µs) by Foswiki::BEGIN@47 at line 25 | ||||
21 | '""' => 'stringify', | ||||
22 | '0+' => 'value', | ||||
23 | 'bool' => sub { return 1; }, | ||||
24 | 1 | 13µs | 1 | 66µs | 'fallback' => 1 # spent 66µs making 1 call to overload::import |
25 | 1 | 974µs | 1 | 2.76ms | ); # spent 2.76ms making 1 call to Error::BEGIN@20 |
26 | |||||
27 | 1 | 400ns | $Error::Depth = 0; # Depth to pass to caller() | ||
28 | 1 | 200ns | $Error::Debug = 0; # Generate verbose stack traces | ||
29 | 1 | 1µs | @Error::STACK = (); # Clause stack for try | ||
30 | 1 | 300ns | $Error::THROWN = undef; # last error thrown, a workaround until die $ref works | ||
31 | |||||
32 | 1 | 300ns | my $LAST; # Last error created | ||
33 | 1 | 300ns | 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 | 1µs | $Error::ObjectifyCallback = \&_throw_Error_Simple; | ||
42 | |||||
43 | |||||
44 | # Exported subs are defined in Error::subs | ||||
45 | |||||
46 | 2 | 1.55ms | 1 | 1.29ms | # spent 1.29ms (935µs+357µs) within Error::BEGIN@46 which was called:
# once (935µs+357µs) by Foswiki::BEGIN@47 at line 46 # spent 1.29ms making 1 call to Error::BEGIN@46 |
47 | |||||
48 | # spent 3.40ms (362µs+3.04) within Error::import which was called 23 times, avg 148µs/call:
# once (35µs+263µs) by Foswiki::Infix::Parser::BEGIN@19 at line 19 of /var/www/foswiki11/lib/Foswiki/Infix/Parser.pm
# once (32µs+253µs) by Foswiki::UI::Rest::BEGIN@16 at line 16 of /var/www/foswiki11/lib/Foswiki/UI/Rest.pm
# once (41µs+168µs) by Foswiki::Query::Node::BEGIN@35 at line 35 of /var/www/foswiki11/lib/Foswiki/Query/Node.pm
# once (25µs+179µs) by Foswiki::Plugins::ActionTrackerPlugin::BEGIN@6 at line 6 of /var/www/foswiki11/lib/Foswiki/Plugins/ActionTrackerPlugin.pm
# once (19µs+179µs) by Foswiki::BEGIN@47 at line 47 of /var/www/foswiki11/lib/Foswiki.pm
# once (21µs+170µs) by Foswiki::Form::BEGIN@39 at line 39 of /var/www/foswiki11/lib/Foswiki/Form.pm
# once (14µs+140µs) by Foswiki::Plugins::WysiwygPlugin::Handlers::BEGIN@10 at line 10 of /var/www/foswiki11/lib/Foswiki/Plugins/WysiwygPlugin/Handlers.pm
# once (15µs+139µs) by Foswiki::Query::OP_ref::BEGIN@16 at line 16 of /var/www/foswiki11/lib/Foswiki/Query/OP_ref.pm
# once (15µs+122µs) by Foswiki::Engine::BEGIN@19 at line 19 of /var/www/foswiki11/lib/Foswiki/Engine.pm
# once (13µs+122µs) by Foswiki::Plugins::TablePlugin::Core::BEGIN@11 at line 11 of /var/www/foswiki11/lib/Foswiki/Plugins/TablePlugin/Core.pm
# once (11µs+119µs) by Foswiki::Render::BEGIN@15 at line 15 of /var/www/foswiki11/lib/Foswiki/Render.pm
# once (11µs+117µs) by Foswiki::Meta::BEGIN@115 at line 115 of /var/www/foswiki11/lib/Foswiki/Meta.pm
# once (10µs+111µs) by Foswiki::UI::BEGIN@149 at line 149 of /var/www/foswiki11/lib/Foswiki/UI.pm
# once (11µs+105µs) by Foswiki::Sandbox::BEGIN@34 at line 34 of /var/www/foswiki11/lib/Foswiki/Sandbox.pm
# once (11µs+100µs) by Foswiki::Plugin::BEGIN@11 at line 11 of /var/www/foswiki11/lib/Foswiki/Plugin.pm
# once (9µs+100µs) by Foswiki::Search::BEGIN@15 at line 15 of /var/www/foswiki11/lib/Foswiki/Search.pm
# once (12µs+95µs) by Foswiki::Plugins::HistoryPlugin::BEGIN@8 at line 8 of /var/www/foswiki11/lib/Foswiki/Plugins/HistoryPlugin.pm
# once (9µs+98µs) by Foswiki::Users::TopicUserMapping::BEGIN@34 at line 34 of /var/www/foswiki11/lib/Foswiki/Users/TopicUserMapping.pm
# once (10µs+96µs) by Foswiki::Store::VC::Store::BEGIN@40 at line 40 of /var/www/foswiki11/lib/Foswiki/Store/VC/Store.pm
# once (9µs+96µs) by Foswiki::Store::BEGIN@55 at line 55 of /var/www/foswiki11/lib/Foswiki/Store.pm
# once (9µs+91µs) by Foswiki::Func::BEGIN@57 at line 57 of /var/www/foswiki11/lib/Foswiki/Func.pm
# once (9µs+90µs) by Foswiki::Search::Node::BEGIN@19 at line 19 of /var/www/foswiki11/lib/Foswiki/Search/Node.pm
# once (9µs+85µs) by Foswiki::LoginManager::BEGIN@54 at line 54 of /var/www/foswiki11/lib/Foswiki/LoginManager.pm | ||||
49 | 23 | 6µs | shift; | ||
50 | 23 | 67µs | my @tags = @_; | ||
51 | 23 | 29µs | local $Exporter::ExportLevel = $Exporter::ExportLevel + 1; | ||
52 | |||||
53 | @tags = grep { | ||||
54 | 46 | 81µs | if( $_ eq ':warndie' ) { | ||
55 | Error::WarnDie->import(); | ||||
56 | 0; | ||||
57 | } | ||||
58 | else { | ||||
59 | 23 | 9µs | 1; | ||
60 | } | ||||
61 | } @tags; | ||||
62 | |||||
63 | 23 | 208µs | 23 | 3.04ms | Error::subs->import(@tags); # spent 3.04ms making 23 calls to Exporter::import, avg 132µ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 1.48ms within Error::catch which was called 320 times, avg 5µs/call:
# 108 times (396µs+0s) by Foswiki::Plugin::registerHandlers at line 254 of /var/www/foswiki11/lib/Foswiki/Plugin.pm, avg 4µs/call
# 83 times (350µs+0s) by Foswiki::Infix::Parser::_parse at line 282 of /var/www/foswiki11/lib/Foswiki/Infix/Parser.pm, avg 4µs/call
# 41 times (199µs+0s) by Foswiki::IF at line 52 of /var/www/foswiki11/lib/Foswiki/Macros/IF.pm, avg 5µs/call
# 41 times (161µs+0s) by Foswiki::Search::parseSearch at line 138 of /var/www/foswiki11/lib/Foswiki/Search.pm, avg 4µs/call
# 40 times (342µs+0s) by Foswiki::SEARCH at line 41 of /var/www/foswiki11/lib/Foswiki/Macros/SEARCH.pm, avg 9µs/call
# 5 times (12µs+0s) by Foswiki::UI::_execute at line 435 of /var/www/foswiki11/lib/Foswiki/UI.pm, avg 2µs/call
# once (10µs+0s) by Foswiki::QUERY at line 65 of /var/www/foswiki11/lib/Foswiki/Macros/QUERY.pm
# once (6µs+0s) by Foswiki::Engine::prepare at line 122 of /var/www/foswiki11/lib/Foswiki/Engine.pm | ||||
214 | 320 | 154µs | my $pkg = shift; | ||
215 | 320 | 52µs | my $code = shift; | ||
216 | 320 | 132µs | my $clauses = shift || {}; | ||
217 | 320 | 344µs | my $catch = $clauses->{'catch'} ||= []; | ||
218 | |||||
219 | 320 | 297µs | unshift @$catch, $pkg, $code; | ||
220 | |||||
221 | 320 | 813µs | $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 | 2 | 331µs | 2 | 86µs | # spent 53µs (20+33) within Error::Simple::BEGIN@260 which was called:
# once (20µs+33µs) by Foswiki::BEGIN@47 at line 260 # spent 53µs making 1 call to Error::Simple::BEGIN@260
# spent 33µs making 1 call to vars::import |
261 | |||||
262 | 1 | 500ns | $VERSION = "0.17020"; | ||
263 | |||||
264 | 1 | 10µs | @Error::Simple::ISA = qw(Error); | ||
265 | |||||
266 | sub new { | ||||
267 | my $self = shift; | ||||
268 | my $text = "" . shift; | ||||
269 | my $value = shift; | ||||
270 | my(@args) = (); | ||||
271 | |||||
272 | local $Error::Depth = $Error::Depth + 1; | ||||
273 | |||||
274 | @args = ( -file => $1, -line => $2) | ||||
275 | if($text =~ s/\s+at\s+(\S+)\s+line\s+(\d+)(?:,\s*<[^>]*>\s+line\s+\d+)?\.?\n?$//s); | ||||
276 | push(@args, '-value', 0 + $value) | ||||
277 | if defined($value); | ||||
278 | |||||
279 | $self->SUPER::new(-text => $text, @args); | ||||
280 | } | ||||
281 | |||||
282 | sub stringify { | ||||
283 | my $self = shift; | ||||
284 | my $text = $self->SUPER::stringify; | ||||
285 | $text .= sprintf(" at %s line %d.\n", $self->file, $self->line) | ||||
286 | unless($text =~ /\n$/s); | ||||
287 | $text; | ||||
288 | } | ||||
289 | |||||
290 | ########################################################################## | ||||
291 | ########################################################################## | ||||
292 | |||||
293 | # Inspired by code from Jesse Glick <jglick@sig.bsh.com> and | ||||
294 | # Peter Seibel <peter@weblogic.com> | ||||
295 | |||||
296 | package Error::subs; | ||||
297 | |||||
298 | 2 | 49µs | 1 | 8µs | # spent 8µs within Error::subs::BEGIN@298 which was called:
# once (8µs+0s) by Foswiki::BEGIN@47 at line 298 # spent 8µs making 1 call to Error::subs::BEGIN@298 |
299 | 2 | 2.16ms | 2 | 112µs | # spent 63µs (15+48) within Error::subs::BEGIN@299 which was called:
# once (15µs+48µs) by Foswiki::BEGIN@47 at line 299 # spent 63µs making 1 call to Error::subs::BEGIN@299
# spent 48µs making 1 call to vars::import |
300 | |||||
301 | 1 | 2µs | @EXPORT_OK = qw(try with finally except otherwise); | ||
302 | 1 | 2µs | %EXPORT_TAGS = (try => \@EXPORT_OK); | ||
303 | |||||
304 | 1 | 7µs | @ISA = qw(Exporter); | ||
305 | |||||
306 | sub run_clauses ($$$\@) { | ||||
307 | my($clauses,$err,$wantarray,$result) = @_; | ||||
308 | my $code = undef; | ||||
309 | |||||
310 | $err = $Error::ObjectifyCallback->({'text' =>$err}) unless ref($err); | ||||
311 | |||||
312 | CATCH: { | ||||
313 | |||||
314 | # catch | ||||
315 | my $catch; | ||||
316 | if(defined($catch = $clauses->{'catch'})) { | ||||
317 | my $i = 0; | ||||
318 | |||||
319 | CATCHLOOP: | ||||
320 | for( ; $i < @$catch ; $i += 2) { | ||||
321 | my $pkg = $catch->[$i]; | ||||
322 | unless(defined $pkg) { | ||||
323 | #except | ||||
324 | splice(@$catch,$i,2,$catch->[$i+1]->($err)); | ||||
325 | $i -= 2; | ||||
326 | next CATCHLOOP; | ||||
327 | } | ||||
328 | elsif(Scalar::Util::blessed($err) && $err->isa($pkg)) { | ||||
329 | $code = $catch->[$i+1]; | ||||
330 | while(1) { | ||||
331 | my $more = 0; | ||||
332 | local($Error::THROWN, $@); | ||||
333 | my $ok = eval { | ||||
334 | $@ = $err; | ||||
335 | if($wantarray) { | ||||
336 | @{$result} = $code->($err,\$more); | ||||
337 | } | ||||
338 | elsif(defined($wantarray)) { | ||||
339 | @{$result} = (); | ||||
340 | $result->[0] = $code->($err,\$more); | ||||
341 | } | ||||
342 | else { | ||||
343 | $code->($err,\$more); | ||||
344 | } | ||||
345 | 1; | ||||
346 | }; | ||||
347 | if( $ok ) { | ||||
348 | next CATCHLOOP if $more; | ||||
349 | undef $err; | ||||
350 | } | ||||
351 | else { | ||||
352 | $err = $@ || $Error::THROWN; | ||||
353 | $err = $Error::ObjectifyCallback->({'text' =>$err}) | ||||
354 | unless ref($err); | ||||
355 | } | ||||
356 | last CATCH; | ||||
357 | }; | ||||
358 | } | ||||
359 | } | ||||
360 | } | ||||
361 | |||||
362 | # otherwise | ||||
363 | my $owise; | ||||
364 | if(defined($owise = $clauses->{'otherwise'})) { | ||||
365 | my $code = $clauses->{'otherwise'}; | ||||
366 | my $more = 0; | ||||
367 | local($Error::THROWN, $@); | ||||
368 | my $ok = eval { | ||||
369 | $@ = $err; | ||||
370 | if($wantarray) { | ||||
371 | @{$result} = $code->($err,\$more); | ||||
372 | } | ||||
373 | elsif(defined($wantarray)) { | ||||
374 | @{$result} = (); | ||||
375 | $result->[0] = $code->($err,\$more); | ||||
376 | } | ||||
377 | else { | ||||
378 | $code->($err,\$more); | ||||
379 | } | ||||
380 | 1; | ||||
381 | }; | ||||
382 | if( $ok ) { | ||||
383 | undef $err; | ||||
384 | } | ||||
385 | else { | ||||
386 | $err = $@ || $Error::THROWN; | ||||
387 | |||||
388 | $err = $Error::ObjectifyCallback->({'text' =>$err}) | ||||
389 | unless ref($err); | ||||
390 | } | ||||
391 | } | ||||
392 | } | ||||
393 | $err; | ||||
394 | } | ||||
395 | |||||
396 | # spent 61.3s (8.95ms+61.3) within Error::subs::try which was called 250 times, avg 245ms/call:
# 83 times (6.21ms+-6.21ms) by Foswiki::Infix::Parser::_parse at line 282 of /var/www/foswiki11/lib/Foswiki/Infix/Parser.pm, avg 0s/call
# 41 times (462µs+-462µs) by Foswiki::Search::parseSearch at line 138 of /var/www/foswiki11/lib/Foswiki/Search.pm, avg 0s/call
# 41 times (594µs+-594µs) by Foswiki::IF at line 52 of /var/www/foswiki11/lib/Foswiki/Macros/IF.pm, avg 0s/call
# 40 times (977µs+-977µs) by Foswiki::SEARCH at line 41 of /var/www/foswiki11/lib/Foswiki/Macros/SEARCH.pm, avg 0s/call
# 36 times (475µs+-475µs) by Foswiki::Plugin::registerHandlers at line 254 of /var/www/foswiki11/lib/Foswiki/Plugin.pm, avg 0s/call
# 6 times (175µs+-175µs) by Foswiki::INCLUDE at line 348 of /var/www/foswiki11/lib/Foswiki/Macros/INCLUDE.pm, avg 0s/call
# once (17µs+61.3s) by Foswiki::UI::_execute at line 435 of /var/www/foswiki11/lib/Foswiki/UI.pm
# once (19µs+6.11ms) by Foswiki::Engine::prepare at line 122 of /var/www/foswiki11/lib/Foswiki/Engine.pm
# once (19µs+-19µs) by Foswiki::QUERY at line 65 of /var/www/foswiki11/lib/Foswiki/Macros/QUERY.pm | ||||
397 | 250 | 82µs | my $try = shift; | ||
398 | 250 | 128µs | my $clauses = @_ ? shift : {}; | ||
399 | 250 | 72µs | my $ok = 0; | ||
400 | 250 | 63µs | my $err = undef; | ||
401 | 250 | 110µs | my @result = (); | ||
402 | |||||
403 | 250 | 112µs | unshift @Error::STACK, $clauses; | ||
404 | |||||
405 | 250 | 55µs | my $wantarray = wantarray(); | ||
406 | |||||
407 | 250 | 68µs | do { | ||
408 | 250 | 101µs | local $Error::THROWN = undef; | ||
409 | 250 | 53µs | local $@ = undef; | ||
410 | |||||
411 | 250 | 254µs | $ok = eval { | ||
412 | 250 | 253µs | if($wantarray) { | ||
413 | @result = $try->(); | ||||
414 | } | ||||
415 | elsif(defined $wantarray) { | ||||
416 | $result[0] = $try->(); | ||||
417 | } | ||||
418 | else { | ||||
419 | 250 | 372µs | 250 | 128s | $try->(); # spent 61.3s making 1 call to Foswiki::UI::__ANON__[/var/www/foswiki11/lib/Foswiki/UI.pm:318]
# spent 49.6s making 40 calls to Foswiki::__ANON__[/var/www/foswiki11/lib/Foswiki/Macros/SEARCH.pm:33], avg 1.24s/call
# spent 17.4s making 6 calls to Foswiki::__ANON__[/var/www/foswiki11/lib/Foswiki/Macros/INCLUDE.pm:331], avg 2.90s/call
# spent 41.3ms making 36 calls to Foswiki::Plugin::__ANON__[/var/www/foswiki11/lib/Foswiki/Plugin.pm:241], avg 1.15ms/call
# spent 34.9ms making 41 calls to Foswiki::__ANON__[/var/www/foswiki11/lib/Foswiki/Macros/IF.pm:43], avg 851µs/call
# spent 19.8ms making 83 calls to Foswiki::Infix::Parser::__ANON__[/var/www/foswiki11/lib/Foswiki/Infix/Parser.pm:277], avg 238µs/call
# spent 10.6ms making 41 calls to Foswiki::Search::__ANON__[/var/www/foswiki11/lib/Foswiki/Search.pm:133], avg 258µs/call
# spent 6.11ms making 1 call to Foswiki::Engine::__ANON__[/var/www/foswiki11/lib/Foswiki/Engine.pm:77]
# spent 653µs making 1 call to Foswiki::__ANON__[/var/www/foswiki11/lib/Foswiki/Macros/QUERY.pm:56] |
420 | } | ||||
421 | 250 | 127µs | 1; | ||
422 | }; | ||||
423 | |||||
424 | 250 | 222µs | $err = $@ || $Error::THROWN | ||
425 | unless $ok; | ||||
426 | }; | ||||
427 | |||||
428 | 250 | 202µs | shift @Error::STACK; | ||
429 | |||||
430 | 250 | 42µs | $err = run_clauses($clauses,$err,wantarray,@result) | ||
431 | unless($ok); | ||||
432 | |||||
433 | 250 | 213µs | 48 | 3.93ms | $clauses->{'finally'}->() # spent 3.81ms making 6 calls to Foswiki::__ANON__[/var/www/foswiki11/lib/Foswiki/Macros/INCLUDE.pm:348], avg 636µs/call
# spent 116µs making 41 calls to Foswiki::__ANON__[/var/www/foswiki11/lib/Foswiki/Macros/IF.pm:52], avg 3µs/call
# spent 3µs making 1 call to Foswiki::__ANON__[/var/www/foswiki11/lib/Foswiki/Macros/QUERY.pm:65] |
434 | if(defined($clauses->{'finally'})); | ||||
435 | |||||
436 | 250 | 44µs | if (defined($err)) | ||
437 | { | ||||
438 | if (Scalar::Util::blessed($err) && $err->can('throw')) | ||||
439 | { | ||||
440 | throw $err; | ||||
441 | } | ||||
442 | else | ||||
443 | { | ||||
444 | die $err; | ||||
445 | } | ||||
446 | } | ||||
447 | |||||
448 | 250 | 758µs | wantarray ? @result : $result[0]; | ||
449 | } | ||||
450 | |||||
451 | # Each clause adds a sub to the list of clauses. The finally clause is | ||||
452 | # always the last, and the otherwise clause is always added just before | ||||
453 | # the finally clause. | ||||
454 | # | ||||
455 | # All clauses, except the finally clause, add a sub which takes one argument | ||||
456 | # this argument will be the error being thrown. The sub will return a code ref | ||||
457 | # if that clause can handle that error, otherwise undef is returned. | ||||
458 | # | ||||
459 | # The otherwise clause adds a sub which unconditionally returns the users | ||||
460 | # code reference, this is why it is forced to be last. | ||||
461 | # | ||||
462 | # The catch clause is defined in Error.pm, as the syntax causes it to | ||||
463 | # be called as a method | ||||
464 | |||||
465 | # spent 535µs within Error::subs::with which was called 320 times, avg 2µs/call:
# 108 times (137µs+0s) by Foswiki::Plugin::registerHandlers at line 254 of /var/www/foswiki11/lib/Foswiki/Plugin.pm, avg 1µs/call
# 83 times (111µs+0s) by Foswiki::Infix::Parser::_parse at line 282 of /var/www/foswiki11/lib/Foswiki/Infix/Parser.pm, avg 1µs/call
# 41 times (62µs+0s) by Foswiki::IF at line 52 of /var/www/foswiki11/lib/Foswiki/Macros/IF.pm, avg 2µs/call
# 41 times (57µs+0s) by Foswiki::Search::parseSearch at line 138 of /var/www/foswiki11/lib/Foswiki/Search.pm, avg 1µs/call
# 40 times (159µs+0s) by Foswiki::SEARCH at line 41 of /var/www/foswiki11/lib/Foswiki/Macros/SEARCH.pm, avg 4µs/call
# 5 times (4µs+0s) by Foswiki::UI::_execute at line 435 of /var/www/foswiki11/lib/Foswiki/UI.pm, avg 860ns/call
# once (2µs+0s) by Foswiki::QUERY at line 65 of /var/www/foswiki11/lib/Foswiki/Macros/QUERY.pm
# once (2µs+0s) by Foswiki::Engine::prepare at line 122 of /var/www/foswiki11/lib/Foswiki/Engine.pm | ||||
466 | @_ | ||||
467 | 320 | 864µs | } | ||
468 | |||||
469 | # spent 201µs within Error::subs::finally which was called 48 times, avg 4µs/call:
# 41 times (144µs+0s) by Foswiki::IF at line 52 of /var/www/foswiki11/lib/Foswiki/Macros/IF.pm, avg 4µs/call
# 6 times (53µs+0s) by Foswiki::INCLUDE at line 348 of /var/www/foswiki11/lib/Foswiki/Macros/INCLUDE.pm, avg 9µs/call
# once (4µs+0s) by Foswiki::QUERY at line 65 of /var/www/foswiki11/lib/Foswiki/Macros/QUERY.pm | ||||
470 | 48 | 22µs | my $code = shift; | ||
471 | 48 | 65µs | my $clauses = { 'finally' => $code }; | ||
472 | 48 | 155µs | $clauses; | ||
473 | } | ||||
474 | |||||
475 | # The except clause is a block which returns a hashref or a list of | ||||
476 | # key-value pairs, where the keys are the classes and the values are subs. | ||||
477 | |||||
478 | sub except (&;$) { | ||||
479 | my $code = shift; | ||||
480 | my $clauses = shift || {}; | ||||
481 | my $catch = $clauses->{'catch'} ||= []; | ||||
482 | |||||
483 | my $sub = sub { | ||||
484 | my $ref; | ||||
485 | my(@array) = $code->($_[0]); | ||||
486 | if(@array == 1 && ref($array[0])) { | ||||
487 | $ref = $array[0]; | ||||
488 | $ref = [ %$ref ] | ||||
489 | if(UNIVERSAL::isa($ref,'HASH')); | ||||
490 | } | ||||
491 | else { | ||||
492 | $ref = \@array; | ||||
493 | } | ||||
494 | @$ref | ||||
495 | }; | ||||
496 | |||||
497 | unshift @{$catch}, undef, $sub; | ||||
498 | |||||
499 | $clauses; | ||||
500 | } | ||||
501 | |||||
502 | # spent 155µs within Error::subs::otherwise which was called 38 times, avg 4µs/call:
# 36 times (147µs+0s) by Foswiki::Plugin::registerHandlers at line 254 of /var/www/foswiki11/lib/Foswiki/Plugin.pm, avg 4µs/call
# once (5µs+0s) by Foswiki::Engine::prepare at line 122 of /var/www/foswiki11/lib/Foswiki/Engine.pm
# once (3µs+0s) by Foswiki::UI::_execute at line 435 of /var/www/foswiki11/lib/Foswiki/UI.pm | ||||
503 | 38 | 13µs | my $code = shift; | ||
504 | 38 | 26µs | my $clauses = shift || {}; | ||
505 | |||||
506 | 38 | 18µs | if(exists $clauses->{'otherwise'}) { | ||
507 | require Carp; | ||||
508 | Carp::croak("Multiple otherwise clauses"); | ||||
509 | } | ||||
510 | |||||
511 | 38 | 33µs | $clauses->{'otherwise'} = $code; | ||
512 | |||||
513 | 38 | 132µs | $clauses; | ||
514 | } | ||||
515 | |||||
516 | 1; | ||||
517 | |||||
518 | package Error::WarnDie; | ||||
519 | |||||
520 | sub gen_callstack($) | ||||
521 | { | ||||
522 | my ( $start ) = @_; | ||||
523 | |||||
524 | require Carp; | ||||
525 | local $Carp::CarpLevel = $start; | ||||
526 | my $trace = Carp::longmess(""); | ||||
527 | # Remove try calls from the trace | ||||
528 | $trace =~ s/(\n\s+\S+__ANON__[^\n]+)?\n\s+eval[^\n]+\n\s+Error::subs::try[^\n]+(?=\n)//sog; | ||||
529 | $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; | ||||
530 | my @callstack = split( m/\n/, $trace ); | ||||
531 | return @callstack; | ||||
532 | } | ||||
533 | |||||
534 | 1 | 200ns | my $old_DIE; | ||
535 | 1 | 100ns | my $old_WARN; | ||
536 | |||||
537 | sub DEATH | ||||
538 | { | ||||
539 | my ( $e ) = @_; | ||||
540 | |||||
541 | local $SIG{__DIE__} = $old_DIE if( defined $old_DIE ); | ||||
542 | |||||
543 | die @_ if $^S; | ||||
544 | |||||
545 | my ( $etype, $message, $location, @callstack ); | ||||
546 | if ( ref($e) && $e->isa( "Error" ) ) { | ||||
547 | $etype = "exception of type " . ref( $e ); | ||||
548 | $message = $e->text; | ||||
549 | $location = $e->file . ":" . $e->line; | ||||
550 | @callstack = split( m/\n/, $e->stacktrace ); | ||||
551 | } | ||||
552 | else { | ||||
553 | # Don't apply subsequent layer of message formatting | ||||
554 | die $e if( $e =~ m/^\nUnhandled perl error caught at toplevel:\n\n/ ); | ||||
555 | $etype = "perl error"; | ||||
556 | my $stackdepth = 0; | ||||
557 | while( caller( $stackdepth ) =~ m/^Error(?:$|::)/ ) { | ||||
558 | $stackdepth++ | ||||
559 | } | ||||
560 | |||||
561 | @callstack = gen_callstack( $stackdepth + 1 ); | ||||
562 | |||||
563 | $message = "$e"; | ||||
564 | chomp $message; | ||||
565 | |||||
566 | if ( $message =~ s/ at (.*?) line (\d+)\.$// ) { | ||||
567 | $location = $1 . ":" . $2; | ||||
568 | } | ||||
569 | else { | ||||
570 | my @caller = caller( $stackdepth ); | ||||
571 | $location = $caller[1] . ":" . $caller[2]; | ||||
572 | } | ||||
573 | } | ||||
574 | |||||
575 | shift @callstack; | ||||
576 | # Do it this way in case there are no elements; we don't print a spurious \n | ||||
577 | my $callstack = join( "", map { "$_\n"} @callstack ); | ||||
578 | |||||
579 | die "\nUnhandled $etype caught at toplevel:\n\n $message\n\nThrown from: $location\n\nFull stack trace:\n\n$callstack\n"; | ||||
580 | } | ||||
581 | |||||
582 | sub TAXES | ||||
583 | { | ||||
584 | my ( $message ) = @_; | ||||
585 | |||||
586 | local $SIG{__WARN__} = $old_WARN if( defined $old_WARN ); | ||||
587 | |||||
588 | $message =~ s/ at .*? line \d+\.$//; | ||||
589 | chomp $message; | ||||
590 | |||||
591 | my @callstack = gen_callstack( 1 ); | ||||
592 | my $location = shift @callstack; | ||||
593 | |||||
594 | # $location already starts in a leading space | ||||
595 | $message .= $location; | ||||
596 | |||||
597 | # Do it this way in case there are no elements; we don't print a spurious \n | ||||
598 | my $callstack = join( "", map { "$_\n"} @callstack ); | ||||
599 | |||||
600 | warn "$message:\n$callstack"; | ||||
601 | } | ||||
602 | |||||
603 | sub import | ||||
604 | { | ||||
605 | $old_DIE = $SIG{__DIE__}; | ||||
606 | $old_WARN = $SIG{__WARN__}; | ||||
607 | |||||
608 | $SIG{__DIE__} = \&DEATH; | ||||
609 | $SIG{__WARN__} = \&TAXES; | ||||
610 | } | ||||
611 | |||||
612 | 1 | 14µs | 1; | ||
613 | |||||
614 | __END__ |