← Index
NYTProf Performance Profile   « line view »
For ./view
  Run on Fri Jul 31 19:05:14 2015
Reported on Fri Jul 31 19:08:09 2015

Filename/usr/share/perl5/vendor_perl/Error.pm
StatementsExecuted 7767 statements in 12.2ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
250998.95ms61.3sError::subs::::try Error::subs::try (recurses: max depth 4, inclusive time 67.1s)
1111.87ms2.76msError::::BEGIN@20 Error::BEGIN@20
320881.48ms1.48msError::::catch Error::catch
111935µs1.29msError::::BEGIN@46 Error::BEGIN@46
32088535µs535µsError::subs::::with Error::subs::with
232323362µs3.40msError::::import Error::import
4833201µs201µsError::subs::::finally Error::subs::finally
3833155µs155µsError::subs::::otherwise Error::subs::otherwise
11121µs21µsError::::BEGIN@16 Error::BEGIN@16
11120µs53µsError::Simple::::BEGIN@260 Error::Simple::BEGIN@260
11120µs43µsError::::BEGIN@14 Error::BEGIN@14
11115µs63µsError::subs::::BEGIN@299 Error::subs::BEGIN@299
11114µs40µsError::::BEGIN@15 Error::BEGIN@15
1118µs8µsError::subs::::BEGIN@298 Error::subs::BEGIN@298
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__[:495] Error::subs::__ANON__[:495]
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
14248µs265µ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
use strict;
# spent 43µs making 1 call to Error::BEGIN@14 # spent 22µs making 1 call to strict::import
15242µs265µ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
use vars qw($VERSION);
# spent 40µs making 1 call to Error::BEGIN@15 # spent 26µs making 1 call to vars::import
162125µs121µs
# spent 21µs within Error::BEGIN@16 which was called: # once (21µs+0s) by Foswiki::BEGIN@47 at line 16
use 5.004;
# spent 21µs making 1 call to Error::BEGIN@16
17
181900ns$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
use overload (
21 '""' => 'stringify',
22 '0+' => 'value',
23 'bool' => sub { return 1; },
24113µs166µs 'fallback' => 1
# spent 66µs making 1 call to overload::import
251974µs12.76ms);
# spent 2.76ms making 1 call to Error::BEGIN@20
26
271400ns$Error::Depth = 0; # Depth to pass to caller()
281200ns$Error::Debug = 0; # Generate verbose stack traces
2911µs@Error::STACK = (); # Clause stack for try
301300ns$Error::THROWN = undef; # last error thrown, a workaround until die $ref works
31
321300nsmy $LAST; # Last error created
331300nsmy %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
4111µs$Error::ObjectifyCallback = \&_throw_Error_Simple;
42
43
44# Exported subs are defined in Error::subs
45
4621.55ms11.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
use Scalar::Util ();
# 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
sub import {
49236µs shift;
502367µs my @tags = @_;
512329µs local $Exporter::ExportLevel = $Exporter::ExportLevel + 1;
52
53 @tags = grep {
544681µs if( $_ eq ':warndie' ) {
55 Error::WarnDie->import();
56 0;
57 }
58 else {
59239µs 1;
60 }
61 } @tags;
62
6323208µs233.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
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 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
sub catch {
214320154µs my $pkg = shift;
21532052µs my $code = shift;
216320132µs my $clauses = shift || {};
217320344µs my $catch = $clauses->{'catch'} ||= [];
218
219320297µs unshift @$catch, $pkg, $code;
220
221320813µs $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
2602331µs286µ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
use vars qw($VERSION);
# spent 53µs making 1 call to Error::Simple::BEGIN@260 # spent 33µs making 1 call to vars::import
261
2621500ns$VERSION = "0.17020";
263
264110µs@Error::Simple::ISA = qw(Error);
265
266sub 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
282sub 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
296package Error::subs;
297
298249µs18µs
# spent 8µs within Error::subs::BEGIN@298 which was called: # once (8µs+0s) by Foswiki::BEGIN@47 at line 298
use Exporter ();
# spent 8µs making 1 call to Error::subs::BEGIN@298
29922.16ms2112µ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
use vars qw(@EXPORT_OK @ISA %EXPORT_TAGS);
# spent 63µs making 1 call to Error::subs::BEGIN@299 # spent 48µs making 1 call to vars::import
300
30112µs@EXPORT_OK = qw(try with finally except otherwise);
30212µs%EXPORT_TAGS = (try => \@EXPORT_OK);
303
30417µs@ISA = qw(Exporter);
305
306sub 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
sub try (&;$) {
39725082µs my $try = shift;
398250128µs my $clauses = @_ ? shift : {};
39925072µs my $ok = 0;
40025063µs my $err = undef;
401250110µs my @result = ();
402
403250112µs unshift @Error::STACK, $clauses;
404
40525055µs my $wantarray = wantarray();
406
40725068µs do {
408250101µs local $Error::THROWN = undef;
40925053µs local $@ = undef;
410
411250254µs $ok = eval {
412250253µs if($wantarray) {
413 @result = $try->();
414 }
415 elsif(defined $wantarray) {
416 $result[0] = $try->();
417 }
418 else {
419250372µs250128s $try->();
420 }
421250127µs 1;
422 };
423
424250222µs $err = $@ || $Error::THROWN
425 unless $ok;
426 };
427
428250202µs shift @Error::STACK;
429
43025042µs $err = run_clauses($clauses,$err,wantarray,@result)
431 unless($ok);
432
433250213µs483.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
43625044µ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
448250758µ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
sub with (&;$) {
466 @_
467320864µ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
sub finally (&) {
4704822µs my $code = shift;
4714865µs my $clauses = { 'finally' => $code };
47248155µ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
478sub 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
sub otherwise (&;$) {
5033813µs my $code = shift;
5043826µs my $clauses = shift || {};
505
5063818µs if(exists $clauses->{'otherwise'}) {
507 require Carp;
508 Carp::croak("Multiple otherwise clauses");
509 }
510
5113833µs $clauses->{'otherwise'} = $code;
512
51338132µs $clauses;
514}
515
5161;
517
518package Error::WarnDie;
519
520sub 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
5341200nsmy $old_DIE;
5351100nsmy $old_WARN;
536
537sub 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
582sub 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
603sub import
604{
605 $old_DIE = $SIG{__DIE__};
606 $old_WARN = $SIG{__WARN__};
607
608 $SIG{__DIE__} = \&DEATH;
609 $SIG{__WARN__} = \&TAXES;
610}
611
612114µs1;
613
614__END__