Filename | /usr/share/perl5/vendor_perl/Error.pm |
Statements | Executed 8789 statements in 12.1ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
260 | 9 | 9 | 3.27ms | 137s | try (recurses: max depth 4, inclusive time 137s) | Error::subs::
1 | 1 | 1 | 1.84ms | 2.76ms | BEGIN@20 | Error::
424 | 9 | 8 | 1.57ms | 1.57ms | catch | Error::
1 | 1 | 1 | 941µs | 1.31ms | BEGIN@46 | Error::
424 | 9 | 8 | 631µs | 631µs | with | Error::subs::
31 | 31 | 30 | 350µs | 5.72ms | import | Error::
52 | 3 | 3 | 132µs | 132µs | finally | Error::subs::
44 | 3 | 3 | 128µs | 128µs | otherwise | Error::subs::
1 | 1 | 1 | 23µs | 45µs | BEGIN@14 | Error::
1 | 1 | 1 | 19µs | 48µs | BEGIN@260 | Error::Simple::
1 | 1 | 1 | 19µs | 19µs | BEGIN@16 | Error::
1 | 1 | 1 | 15µs | 63µs | BEGIN@299 | Error::subs::
1 | 1 | 1 | 14µs | 39µ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 | 47µs | 2 | 66µs | # spent 45µs (23+22) within Error::BEGIN@14 which was called:
# once (23µs+22µs) by Foswiki::BEGIN@48 at line 14 # spent 45µs making 1 call to Error::BEGIN@14
# spent 22µs making 1 call to strict::import |
15 | 2 | 41µs | 2 | 64µs | # spent 39µs (14+25) within Error::BEGIN@15 which was called:
# once (14µs+25µs) by Foswiki::BEGIN@48 at line 15 # spent 39µs making 1 call to Error::BEGIN@15
# spent 25µs making 1 call to vars::import |
16 | 2 | 132µs | 1 | 19µs | # spent 19µs within Error::BEGIN@16 which was called:
# once (19µs+0s) by Foswiki::BEGIN@48 at line 16 # spent 19µs making 1 call to Error::BEGIN@16 |
17 | |||||
18 | 1 | 1µs | $VERSION = "0.17020"; | ||
19 | |||||
20 | # spent 2.76ms (1.84+917µs) within Error::BEGIN@20 which was called:
# once (1.84ms+917µs) by Foswiki::BEGIN@48 at line 25 | ||||
21 | '""' => 'stringify', | ||||
22 | '0+' => 'value', | ||||
23 | 'bool' => sub { return 1; }, | ||||
24 | 1 | 14µs | 1 | 72µs | 'fallback' => 1 # spent 72µs making 1 call to overload::import |
25 | 1 | 969µs | 1 | 2.76ms | ); # spent 2.76ms making 1 call to Error::BEGIN@20 |
26 | |||||
27 | 1 | 300ns | $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 | 400ns | $Error::THROWN = undef; # last error thrown, a workaround until die $ref works | ||
31 | |||||
32 | 1 | 300ns | my $LAST; # Last error created | ||
33 | 1 | 200ns | 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.52ms | 1 | 1.31ms | # spent 1.31ms (941µs+365µs) within Error::BEGIN@46 which was called:
# once (941µs+365µs) by Foswiki::BEGIN@48 at line 46 # spent 1.31ms making 1 call to Error::BEGIN@46 |
47 | |||||
48 | # spent 5.72ms (350µs+5.37) within Error::import which was called 31 times, avg 184µs/call:
# once (22µs+2.58ms) by Foswiki::BEGIN@48 at line 48 of /var/www/foswikidev/core/lib/Foswiki.pm
# once (22µs+163µs) by Foswiki::Form::BEGIN@39 at line 39 of /var/www/foswikidev/core/lib/Foswiki/Form.pm
# once (24µs+117µs) by Foswiki::Engine::BEGIN@19 at line 19 of /var/www/foswikidev/core/lib/Foswiki/Engine.pm
# once (15µs+122µs) by Foswiki::Plugins::TablePlugin::Core::BEGIN@11 at line 11 of /var/www/foswikidev/core/lib/Foswiki/Plugins/TablePlugin/Core.pm
# once (14µs+113µs) by Foswiki::UI::Rest::BEGIN@16 at line 16 of /var/www/foswikidev/core/lib/Foswiki/UI/Rest.pm
# once (11µs+115µs) by Foswiki::UI::BEGIN@163 at line 163 of /var/www/foswikidev/core/lib/Foswiki/UI.pm
# once (10µs+108µs) by Foswiki::Plugins::SubscribePlugin::BEGIN@18 at line 18 of /var/www/foswikidev/core/lib/Foswiki/Plugins/SubscribePlugin.pm
# once (15µs+100µs) by Foswiki::I18N::BEGIN@16 at line 16 of /var/www/foswikidev/core/lib/Foswiki/I18N.pm
# once (11µs+102µs) by Foswiki::Search::Node::BEGIN@16 at line 16 of /var/www/foswikidev/core/lib/Foswiki/Search/Node.pm
# once (11µs+100µs) by Foswiki::Plugins::HistoryPlugin::BEGIN@8 at line 8 of /var/www/foswikidev/core/lib/Foswiki/Plugins/HistoryPlugin.pm
# once (10µs+100µs) by Foswiki::Plugins::CommentPlugin::BEGIN@10 at line 10 of /var/www/foswikidev/core/lib/Foswiki/Plugins/CommentPlugin.pm
# once (12µs+95µs) by Foswiki::Render::BEGIN@15 at line 15 of /var/www/foswikidev/core/lib/Foswiki/Render.pm
# once (10µs+95µs) by Foswiki::Store::Rcs::Store::BEGIN@40 at line 40 of /var/www/foswikidev/core/lib/Foswiki/Store/Rcs/Store.pm
# once (9µs+94µs) by Foswiki::Query::OP_ref::BEGIN@16 at line 16 of /var/www/foswikidev/core/lib/Foswiki/Query/OP_ref.pm
# once (10µs+93µs) by Foswiki::Search::BEGIN@15 at line 15 of /var/www/foswikidev/core/lib/Foswiki/Search.pm
# once (9µs+93µs) by Foswiki::Meta::BEGIN@111 at line 111 of /var/www/foswikidev/core/lib/Foswiki/Meta.pm
# once (9µs+92µs) by Foswiki::Func::BEGIN@57 at line 57 of /var/www/foswikidev/core/lib/Foswiki/Func.pm
# once (10µs+91µs) by Foswiki::PageCache::BEGIN@63 at line 63 of /var/www/foswikidev/core/lib/Foswiki/PageCache.pm
# once (9µs+92µs) by Foswiki::Infix::Parser::BEGIN@24 at line 24 of /var/www/foswikidev/core/lib/Foswiki/Infix/Parser.pm
# once (9µs+90µs) by Foswiki::Users::TopicUserMapping::BEGIN@34 at line 34 of /var/www/foswikidev/core/lib/Foswiki/Users/TopicUserMapping.pm
# once (10µs+89µs) by Foswiki::Sandbox::BEGIN@34 at line 34 of /var/www/foswikidev/core/lib/Foswiki/Sandbox.pm
# once (10µs+89µs) by Foswiki::Plugin::BEGIN@11 at line 11 of /var/www/foswikidev/core/lib/Foswiki/Plugin.pm
# once (9µs+89µs) by Foswiki::Plugins::WysiwygPlugin::Handlers::BEGIN@10 at line 10 of /var/www/foswikidev/core/lib/Foswiki/Plugins/WysiwygPlugin/Handlers.pm
# once (9µs+88µs) by Foswiki::Contrib::JsonRpcContrib::Server::BEGIN@22 at line 22 of /var/www/foswikidev/core/lib/Foswiki/Contrib/JsonRpcContrib/Server.pm
# once (9µs+88µs) by Foswiki::LoginManager::BEGIN@54 at line 54 of /var/www/foswikidev/core/lib/Foswiki/LoginManager.pm
# once (9µs+88µs) by Foswiki::Store::BEGIN@58 at line 58 of /var/www/foswikidev/core/lib/Foswiki/Store.pm
# once (9µs+87µs) by Foswiki::Plugins::ActionTrackerPlugin::BEGIN@6 at line 6 of /var/www/foswikidev/core/lib/Foswiki/Plugins/ActionTrackerPlugin.pm
# once (9µs+85µs) by Foswiki::Contrib::JsonRpcContrib::Request::BEGIN@25 at line 25 of /var/www/foswikidev/core/lib/Foswiki/Contrib/JsonRpcContrib/Request.pm
# once (9µs+84µs) by Foswiki::Query::Node::BEGIN@35 at line 35 of /var/www/foswikidev/core/lib/Foswiki/Query/Node.pm
# once (8µs+13µs) by Foswiki::Configure::Auth::BEGIN@6 at line 6 of /var/www/foswikidev/core/lib/Foswiki/Configure/Auth.pm
# once (8µs+13µs) by Foswiki::Configure::Auth::BEGIN@7 at line 7 of /var/www/foswikidev/core/lib/Foswiki/Configure/Auth.pm | ||||
49 | 31 | 8µs | shift; | ||
50 | 31 | 41µs | my @tags = @_; | ||
51 | 31 | 26µs | local $Exporter::ExportLevel = $Exporter::ExportLevel + 1; | ||
52 | |||||
53 | @tags = grep { | ||||
54 | 60 | 86µs | if( $_ eq ':warndie' ) { | ||
55 | Error::WarnDie->import(); | ||||
56 | 0; | ||||
57 | } | ||||
58 | else { | ||||
59 | 29 | 10µs | 1; | ||
60 | } | ||||
61 | } @tags; | ||||
62 | |||||
63 | 31 | 210µs | 31 | 5.37ms | Error::subs->import(@tags); # spent 5.37ms making 31 calls to Exporter::import, avg 173µ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.57ms within Error::catch which was called 424 times, avg 4µs/call:
# 126 times (310µs+0s) by Foswiki::Plugin::registerHandlers at line 270 of /var/www/foswikidev/core/lib/Foswiki/Plugin.pm, avg 2µs/call
# 84 times (332µs+0s) by Foswiki::Infix::Parser::_parse at line 317 of /var/www/foswikidev/core/lib/Foswiki/Infix/Parser.pm, avg 4µs/call
# 84 times (290µs+0s) by Foswiki::Infix::Parser::_parse at line 312 of /var/www/foswikidev/core/lib/Foswiki/Infix/Parser.pm, avg 3µs/call
# 43 times (140µs+0s) by Foswiki::IF at line 59 of /var/www/foswikidev/core/lib/Foswiki/Macros/IF.pm, avg 3µs/call
# 40 times (338µs+0s) by Foswiki::SEARCH at line 60 of /var/www/foswikidev/core/lib/Foswiki/Macros/SEARCH.pm, avg 8µs/call
# 40 times (143µs+0s) by Foswiki::Search::parseSearch at line 139 of /var/www/foswikidev/core/lib/Foswiki/Search.pm, avg 4µs/call
# 5 times (12µs+0s) by Foswiki::UI::_execute at line 500 of /var/www/foswikidev/core/lib/Foswiki/UI.pm, avg 2µs/call
# once (4µs+0s) by Foswiki::Engine::prepare at line 155 of /var/www/foswikidev/core/lib/Foswiki/Engine.pm
# once (4µs+0s) by Foswiki::QUERY at line 77 of /var/www/foswikidev/core/lib/Foswiki/Macros/QUERY.pm | ||||
214 | 424 | 174µs | my $pkg = shift; | ||
215 | 424 | 65µs | my $code = shift; | ||
216 | 424 | 166µs | my $clauses = shift || {}; | ||
217 | 424 | 338µs | my $catch = $clauses->{'catch'} ||= []; | ||
218 | |||||
219 | 424 | 301µs | unshift @$catch, $pkg, $code; | ||
220 | |||||
221 | 424 | 911µ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 | 337µs | 2 | 77µs | # spent 48µs (19+29) within Error::Simple::BEGIN@260 which was called:
# once (19µs+29µs) by Foswiki::BEGIN@48 at line 260 # spent 48µs making 1 call to Error::Simple::BEGIN@260
# spent 29µs making 1 call to vars::import |
261 | |||||
262 | 1 | 500ns | $VERSION = "0.17020"; | ||
263 | |||||
264 | 1 | 11µ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 | 44µs | 1 | 8µs | # spent 8µs within Error::subs::BEGIN@298 which was called:
# once (8µs+0s) by Foswiki::BEGIN@48 at line 298 # spent 8µs making 1 call to Error::subs::BEGIN@298 |
299 | 2 | 2.23ms | 2 | 111µs | # spent 63µs (15+48) within Error::subs::BEGIN@299 which was called:
# once (15µs+48µs) by Foswiki::BEGIN@48 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 137s (3.27ms+137) within Error::subs::try which was called 260 times, avg 529ms/call:
# 84 times (822µs+-822µs) by Foswiki::Infix::Parser::_parse at line 312 of /var/www/foswikidev/core/lib/Foswiki/Infix/Parser.pm, avg 0s/call
# 43 times (478µs+-478µs) by Foswiki::IF at line 59 of /var/www/foswikidev/core/lib/Foswiki/Macros/IF.pm, avg 0s/call
# 42 times (388µs+-388µs) by Foswiki::Plugin::registerHandlers at line 270 of /var/www/foswikidev/core/lib/Foswiki/Plugin.pm, avg 0s/call
# 40 times (461µs+-461µs) by Foswiki::Search::parseSearch at line 139 of /var/www/foswikidev/core/lib/Foswiki/Search.pm, avg 0s/call
# 40 times (981µs+-981µs) by Foswiki::SEARCH at line 60 of /var/www/foswikidev/core/lib/Foswiki/Macros/SEARCH.pm, avg 0s/call
# 8 times (99µs+-99µs) by Foswiki::_includeTopic at line 356 of /var/www/foswikidev/core/lib/Foswiki/Macros/INCLUDE.pm, avg 0s/call
# once (14µs+137s) by Foswiki::UI::_execute at line 500 of /var/www/foswikidev/core/lib/Foswiki/UI.pm
# once (15µs+236µs) by Foswiki::Engine::prepare at line 155 of /var/www/foswikidev/core/lib/Foswiki/Engine.pm
# once (15µs+-15µs) by Foswiki::QUERY at line 77 of /var/www/foswikidev/core/lib/Foswiki/Macros/QUERY.pm | ||||
397 | 260 | 78µs | my $try = shift; | ||
398 | 260 | 116µs | my $clauses = @_ ? shift : {}; | ||
399 | 260 | 62µs | my $ok = 0; | ||
400 | 260 | 53µs | my $err = undef; | ||
401 | 260 | 98µs | my @result = (); | ||
402 | |||||
403 | 260 | 85µs | unshift @Error::STACK, $clauses; | ||
404 | |||||
405 | 260 | 54µs | my $wantarray = wantarray(); | ||
406 | |||||
407 | 260 | 60µs | do { | ||
408 | 260 | 77µs | local $Error::THROWN = undef; | ||
409 | 260 | 48µs | local $@ = undef; | ||
410 | |||||
411 | 260 | 221µs | $ok = eval { | ||
412 | 260 | 261µs | if($wantarray) { | ||
413 | @result = $try->(); | ||||
414 | } | ||||
415 | elsif(defined $wantarray) { | ||||
416 | $result[0] = $try->(); | ||||
417 | } | ||||
418 | else { | ||||
419 | 260 | 328µs | 260 | 275s | $try->(); # spent 137s making 1 call to Foswiki::UI::__ANON__[/var/www/foswikidev/core/lib/Foswiki/UI.pm:376]
# spent 137s making 40 calls to Foswiki::__ANON__[/var/www/foswikidev/core/lib/Foswiki/Macros/SEARCH.pm:40], avg 3.42s/call
# spent 151ms making 8 calls to Foswiki::__ANON__[/var/www/foswikidev/core/lib/Foswiki/Macros/INCLUDE.pm:339], avg 18.9ms/call
# spent 59.0ms making 42 calls to Foswiki::Plugin::__ANON__[/var/www/foswikidev/core/lib/Foswiki/Plugin.pm:257], avg 1.41ms/call
# spent 16.6ms making 43 calls to Foswiki::__ANON__[/var/www/foswikidev/core/lib/Foswiki/Macros/IF.pm:50], avg 385µs/call
# spent 11.4ms making 84 calls to Foswiki::Infix::Parser::__ANON__[/var/www/foswikidev/core/lib/Foswiki/Infix/Parser.pm:306], avg 135µs/call
# spent 11.2ms making 40 calls to Foswiki::Search::__ANON__[/var/www/foswikidev/core/lib/Foswiki/Search.pm:134], avg 280µs/call
# spent 814µs making 1 call to Foswiki::__ANON__[/var/www/foswikidev/core/lib/Foswiki/Macros/QUERY.pm:68]
# spent 236µs making 1 call to Foswiki::Engine::__ANON__[/var/www/foswikidev/core/lib/Foswiki/Engine.pm:110] |
420 | } | ||||
421 | 260 | 110µs | 1; | ||
422 | }; | ||||
423 | |||||
424 | 260 | 208µs | $err = $@ || $Error::THROWN | ||
425 | unless $ok; | ||||
426 | }; | ||||
427 | |||||
428 | 260 | 182µs | shift @Error::STACK; | ||
429 | |||||
430 | 260 | 32µs | $err = run_clauses($clauses,$err,wantarray,@result) | ||
431 | unless($ok); | ||||
432 | |||||
433 | 260 | 181µs | 52 | 2.90ms | $clauses->{'finally'}->() # spent 2.80ms making 8 calls to Foswiki::__ANON__[/var/www/foswikidev/core/lib/Foswiki/Macros/INCLUDE.pm:356], avg 350µs/call
# spent 92µs making 43 calls to Foswiki::__ANON__[/var/www/foswikidev/core/lib/Foswiki/Macros/IF.pm:59], avg 2µs/call
# spent 2µs making 1 call to Foswiki::__ANON__[/var/www/foswikidev/core/lib/Foswiki/Macros/QUERY.pm:77] |
434 | if(defined($clauses->{'finally'})); | ||||
435 | |||||
436 | 260 | 40µ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 | 260 | 739µ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 631µs within Error::subs::with which was called 424 times, avg 1µs/call:
# 126 times (115µs+0s) by Foswiki::Plugin::registerHandlers at line 270 of /var/www/foswikidev/core/lib/Foswiki/Plugin.pm, avg 913ns/call
# 84 times (116µs+0s) by Foswiki::Infix::Parser::_parse at line 317 of /var/www/foswikidev/core/lib/Foswiki/Infix/Parser.pm, avg 1µs/call
# 84 times (103µs+0s) by Foswiki::Infix::Parser::_parse at line 312 of /var/www/foswikidev/core/lib/Foswiki/Infix/Parser.pm, avg 1µs/call
# 43 times (48µs+0s) by Foswiki::IF at line 59 of /var/www/foswikidev/core/lib/Foswiki/Macros/IF.pm, avg 1µs/call
# 40 times (188µs+0s) by Foswiki::SEARCH at line 60 of /var/www/foswikidev/core/lib/Foswiki/Macros/SEARCH.pm, avg 5µs/call
# 40 times (54µs+0s) by Foswiki::Search::parseSearch at line 139 of /var/www/foswikidev/core/lib/Foswiki/Search.pm, avg 1µs/call
# 5 times (4µs+0s) by Foswiki::UI::_execute at line 500 of /var/www/foswikidev/core/lib/Foswiki/UI.pm, avg 880ns/call
# once (2µs+0s) by Foswiki::Engine::prepare at line 155 of /var/www/foswikidev/core/lib/Foswiki/Engine.pm
# once (1µs+0s) by Foswiki::QUERY at line 77 of /var/www/foswikidev/core/lib/Foswiki/Macros/QUERY.pm | ||||
466 | @_ | ||||
467 | 424 | 1.02ms | } | ||
468 | |||||
469 | # spent 132µs within Error::subs::finally which was called 52 times, avg 3µs/call:
# 43 times (109µs+0s) by Foswiki::IF at line 59 of /var/www/foswikidev/core/lib/Foswiki/Macros/IF.pm, avg 3µs/call
# 8 times (20µs+0s) by Foswiki::_includeTopic at line 356 of /var/www/foswikidev/core/lib/Foswiki/Macros/INCLUDE.pm, avg 2µs/call
# once (3µs+0s) by Foswiki::QUERY at line 77 of /var/www/foswikidev/core/lib/Foswiki/Macros/QUERY.pm | ||||
470 | 52 | 17µs | my $code = shift; | ||
471 | 52 | 49µs | my $clauses = { 'finally' => $code }; | ||
472 | 52 | 112µ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 128µs within Error::subs::otherwise which was called 44 times, avg 3µs/call:
# 42 times (120µs+0s) by Foswiki::Plugin::registerHandlers at line 270 of /var/www/foswikidev/core/lib/Foswiki/Plugin.pm, avg 3µs/call
# once (5µs+0s) by Foswiki::Engine::prepare at line 155 of /var/www/foswikidev/core/lib/Foswiki/Engine.pm
# once (3µs+0s) by Foswiki::UI::_execute at line 500 of /var/www/foswikidev/core/lib/Foswiki/UI.pm | ||||
503 | 44 | 11µs | my $code = shift; | ||
504 | 44 | 22µs | my $clauses = shift || {}; | ||
505 | |||||
506 | 44 | 16µs | if(exists $clauses->{'otherwise'}) { | ||
507 | require Carp; | ||||
508 | Carp::croak("Multiple otherwise clauses"); | ||||
509 | } | ||||
510 | |||||
511 | 44 | 27µs | $clauses->{'otherwise'} = $code; | ||
512 | |||||
513 | 44 | 106µ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 | 15µs | 1; | ||
613 | |||||
614 | __END__ |