← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/local/src/github.com/foswiki/core/bin/view
  Run on Sun Dec 4 17:17:59 2011
Reported on Sun Dec 4 17:26:32 2011

Filename/usr/share/perl5/Error.pm
StatementsExecuted 7764 statements in 25.7ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
260111111.9ms265sError::subs::::try Error::subs::try (recurses: max depth 4, inclusive time 85.9s)
28210104.00ms4.00msError::::catch Error::catch
1111.67ms2.13msError::::BEGIN@20 Error::BEGIN@20
1111.23ms1.93msError::::BEGIN@46 Error::BEGIN@46
28210101.23ms1.23msError::subs::::with Error::subs::with
9633995µs995µsError::subs::::finally Error::subs::finally
242424814µs10.2msError::::import Error::import
2133418µs418µsError::subs::::otherwise Error::subs::otherwise
11128µs28µsError::::BEGIN@16 Error::BEGIN@16
11124µs31µsError::::BEGIN@14 Error::BEGIN@14
11115µs67µsError::::BEGIN@15 Error::BEGIN@15
11115µs124µsError::subs::::BEGIN@295 Error::subs::BEGIN@295
11110µs10µsError::subs::::BEGIN@294 Error::subs::BEGIN@294
0000s0sError::Simple::::new Error::Simple::new
0000s0sError::Simple::::stringify Error::Simple::stringify
0000s0sError::WarnDie::::DEATHError::WarnDie::DEATH
0000s0sError::WarnDie::::TAXESError::WarnDie::TAXES
0000s0sError::WarnDie::::gen_callstackError::WarnDie::gen_callstack
0000s0sError::WarnDie::::importError::WarnDie::import
0000s0sError::::__ANON__[:23] Error::__ANON__[:23]
0000s0sError::::_throw_Error_Simple Error::_throw_Error_Simple
0000s0sError::::associate Error::associate
0000s0sError::::file Error::file
0000s0sError::::flush Error::flush
0000s0sError::::line Error::line
0000s0sError::::new Error::new
0000s0sError::::object Error::object
0000s0sError::::prior Error::prior
0000s0sError::::record Error::record
0000s0sError::::stacktrace Error::stacktrace
0000s0sError::::stringify Error::stringify
0000s0sError::subs::::__ANON__[:492] Error::subs::__ANON__[:492]
0000s0sError::subs::::except Error::subs::except
0000s0sError::subs::::run_clauses Error::subs::run_clauses
0000s0sError::::text Error::text
0000s0sError::::throw Error::throw
0000s0sError::::value Error::value
0000s0sError::::with Error::with
Call graph for these subroutines as a Graphviz dot language file.
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
12package Error;
13
14247µs239µ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
use strict;
# spent 31µs making 1 call to Error::BEGIN@14 # spent 8µs making 1 call to strict::import
15250µs2118µ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
use vars qw($VERSION);
# spent 67µs making 1 call to Error::BEGIN@15 # spent 51µs making 1 call to vars::import
162126µs128µs
# spent 28µs within Error::BEGIN@16 which was called: # once (28µs+0s) by Foswiki::BEGIN@47 at line 16
use 5.004;
# spent 28µs making 1 call to Error::BEGIN@16
17
1812µ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
use overload (
21 '""' => 'stringify',
22 '0+' => 'value',
23 'bool' => sub { return 1; },
241149µs 'fallback' => 1
# spent 149µs making 1 call to overload::import
2521.45ms12.13ms);
# spent 2.13ms making 1 call to Error::BEGIN@20
26
2711µs$Error::Depth = 0; # Depth to pass to caller()
2811µs$Error::Debug = 0; # Generate verbose stack traces
2912µs@Error::STACK = (); # Clause stack for try
3011µs$Error::THROWN = undef; # last error thrown, a workaround until die $ref works
31
3211µsmy $LAST; # Last error created
3311µsmy %ERROR; # Last error associated with package
34
35sub _throw_Error_Simple
36{
37 my $args = shift;
38 return Error::Simple->new($args->{'text'});
39}
40
4112µs$Error::ObjectifyCallback = \&_throw_Error_Simple;
42
43
44# Exported subs are defined in Error::subs
45
4621.76ms11.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
use Scalar::Util ();
# 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
sub import {
49168893µs shift;
50 my @tags = @_;
51 local $Exporter::ExportLevel = $Exporter::ExportLevel + 1;
52
53 @tags = grep {
54 if( $_ eq ':warndie' ) {
55 Error::WarnDie->import();
56 0;
57 }
58 else {
59 1;
60 }
61 } @tags;
62
63249.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
69sub 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
92sub 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
110sub 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
125sub 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
144sub 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
177sub 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
191sub 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
202sub 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
sub catch {
21416924.33ms my $pkg = shift;
215 my $code = shift;
216 my $clauses = shift || {};
217 my $catch = $clauses->{'catch'} ||= [];
218
219 unshift @$catch, $pkg, $code;
220
221 $clauses;
222}
223
224# Object query methods
225
226sub object {
227 my $self = shift;
228 exists $self->{'-object'} ? $self->{'-object'} : undef;
229}
230
231sub file {
232 my $self = shift;
233 exists $self->{'-file'} ? $self->{'-file'} : undef;
234}
235
236sub line {
237 my $self = shift;
238 exists $self->{'-line'} ? $self->{'-line'} : undef;
239}
240
241sub text {
242 my $self = shift;
243 exists $self->{'-text'} ? $self->{'-text'} : undef;
244}
245
246# overload methods
247
248sub stringify {
249 my $self = shift;
250 defined $self->{'-text'} ? $self->{'-text'} : "Died";
251}
252
253sub value {
254 my $self = shift;
255 exists $self->{'-value'} ? $self->{'-value'} : undef;
256}
257
258package Error::Simple;
259
26019µs@Error::Simple::ISA = qw(Error);
261
262sub 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
278sub 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
292package Error::subs;
293
294245µs110µs
# spent 10µs within Error::subs::BEGIN@294 which was called: # once (10µs+0s) by Foswiki::BEGIN@47 at line 294
use Exporter ();
# spent 10µs making 1 call to Error::subs::BEGIN@294
29522.29ms2232µ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
use vars qw(@EXPORT_OK @ISA %EXPORT_TAGS);
# spent 124µs making 1 call to Error::subs::BEGIN@295 # spent 108µs making 1 call to vars::import
296
29713µs@EXPORT_OK = qw(try with finally except otherwise);
29813µs%EXPORT_TAGS = (try => \@EXPORT_OK);
299
30015µs@ISA = qw(Exporter);
301
302sub 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
sub try (&;$) {
394520011.5ms my $try = shift;
395 my $clauses = @_ ? shift : {};
396 my $ok = 0;
397 my $err = undef;
398 my @result = ();
399
400 unshift @Error::STACK, $clauses;
401
402 my $wantarray = wantarray();
403
404 do {
405 local $Error::THROWN = undef;
406 local $@ = undef;
407
408 $ok = eval {
409 if($wantarray) {
410 @result = $try->();
411 }
412 elsif(defined $wantarray) {
413 $result[0] = $try->();
414 }
415 else {
416260351s $try->();
417 }
418 1;
419 };
420
421 $err = $@ || $Error::THROWN
422 unless $ok;
423 };
424
425 shift @Error::STACK;
426
427 $err = run_clauses($clauses,$err,wantarray,@result)
428 unless($ok);
429
4309635.8ms $clauses->{'finally'}->()
431 if(defined($clauses->{'finally'}));
432
433 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 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
sub with (&;$) {
463 @_
4642821.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
sub finally (&) {
4672881.07ms my $code = shift;
468 my $clauses = { 'finally' => $code };
469 $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
475sub 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
sub otherwise (&;$) {
500105453µs my $code = shift;
501 my $clauses = shift || {};
502
503 if(exists $clauses->{'otherwise'}) {
504 require Carp;
505 Carp::croak("Multiple otherwise clauses");
506 }
507
508 $clauses->{'otherwise'} = $code;
509
510 $clauses;
511}
512
5131;
514
515package Error::WarnDie;
516
517sub 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
53111µsmy $old_DIE;
5321700nsmy $old_WARN;
533
534sub 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
579sub 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
600sub import
601{
602 $old_DIE = $SIG{__DIE__};
603 $old_WARN = $SIG{__WARN__};
604
605 $SIG{__DIE__} = \&DEATH;
606 $SIG{__WARN__} = \&TAXES;
607}
608
609115µs1;
610
611__END__