Filename | /usr/lib/perl5/Scope/Upper.pm |
Statements | Executed 17 statements in 717µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
100001 | 1 | 1 | 303ms | 303ms | HERE (xsub) | Scope::Upper::
1 | 1 | 1 | 12µs | 12µs | BEGIN@3 | Scope::Upper::
1 | 1 | 1 | 11µs | 194µs | BEGIN@201 | Scope::Upper::
1 | 1 | 1 | 11µs | 69µs | BEGIN@725 | Scope::Upper::
1 | 1 | 1 | 7µs | 10µs | BEGIN@6 | Scope::Upper::
1 | 1 | 1 | 6µs | 15µs | BEGIN@5 | Scope::Upper::
1 | 1 | 1 | 3µs | 3µs | BEGIN@19 | Scope::Upper::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Scope::Upper; | ||||
2 | |||||
3 | 2 | 39µs | 1 | 12µs | # spent 12µs within Scope::Upper::BEGIN@3 which was called:
# once (12µs+0s) by PONAPI::Server::BEGIN@13 at line 3 # spent 12µs making 1 call to Scope::Upper::BEGIN@3 |
4 | |||||
5 | 2 | 24µs | 2 | 24µs | # spent 15µs (6+9) within Scope::Upper::BEGIN@5 which was called:
# once (6µs+9µs) by PONAPI::Server::BEGIN@13 at line 5 # spent 15µs making 1 call to Scope::Upper::BEGIN@5
# spent 9µs making 1 call to strict::import |
6 | 2 | 31µs | 2 | 13µs | # spent 10µs (7+3) within Scope::Upper::BEGIN@6 which was called:
# once (7µs+3µs) by PONAPI::Server::BEGIN@13 at line 6 # spent 10µs making 1 call to Scope::Upper::BEGIN@6
# spent 3µs making 1 call to warnings::import |
7 | |||||
8 | =head1 NAME | ||||
9 | |||||
10 | Scope::Upper - Act on upper scopes. | ||||
11 | |||||
12 | =head1 VERSION | ||||
13 | |||||
14 | Version 0.24 | ||||
15 | |||||
16 | =cut | ||||
17 | |||||
18 | 1 | 0s | our $VERSION; | ||
19 | # spent 3µs within Scope::Upper::BEGIN@19 which was called:
# once (3µs+0s) by PONAPI::Server::BEGIN@13 at line 21 | ||||
20 | 1 | 6µs | $VERSION = '0.24'; | ||
21 | 1 | 86µs | 1 | 3µs | } # spent 3µs making 1 call to Scope::Upper::BEGIN@19 |
22 | |||||
23 | =head1 SYNOPSIS | ||||
24 | |||||
25 | L</reap>, L</localize>, L</localize_elem>, L</localize_delete> and L</WORDS> : | ||||
26 | |||||
27 | package Scope; | ||||
28 | |||||
29 | use Scope::Upper qw< | ||||
30 | reap localize localize_elem localize_delete | ||||
31 | :words | ||||
32 | >; | ||||
33 | |||||
34 | sub new { | ||||
35 | my ($class, $name) = @_; | ||||
36 | |||||
37 | localize '$tag' => bless({ name => $name }, $class) => UP; | ||||
38 | |||||
39 | reap { print Scope->tag->name, ": end\n" } UP; | ||||
40 | } | ||||
41 | |||||
42 | # Get the tag stored in the caller namespace | ||||
43 | sub tag { | ||||
44 | my $l = 0; | ||||
45 | my $pkg = __PACKAGE__; | ||||
46 | $pkg = caller $l++ while $pkg eq __PACKAGE__; | ||||
47 | |||||
48 | no strict 'refs'; | ||||
49 | ${$pkg . '::tag'}; | ||||
50 | } | ||||
51 | |||||
52 | sub name { shift->{name} } | ||||
53 | |||||
54 | # Locally capture warnings and reprint them with the name prefixed | ||||
55 | sub catch { | ||||
56 | localize_elem '%SIG', '__WARN__' => sub { | ||||
57 | print Scope->tag->name, ': ', @_; | ||||
58 | } => UP; | ||||
59 | } | ||||
60 | |||||
61 | # Locally clear @INC | ||||
62 | sub private { | ||||
63 | for (reverse 0 .. $#INC) { | ||||
64 | # First UP is the for loop, second is the sub boundary | ||||
65 | localize_delete '@INC', $_ => UP UP; | ||||
66 | } | ||||
67 | } | ||||
68 | |||||
69 | ... | ||||
70 | |||||
71 | package UserLand; | ||||
72 | |||||
73 | { | ||||
74 | Scope->new("top"); # initializes $UserLand::tag | ||||
75 | |||||
76 | { | ||||
77 | Scope->catch; | ||||
78 | my $one = 1 + undef; # prints "top: Use of uninitialized value..." | ||||
79 | |||||
80 | { | ||||
81 | Scope->private; | ||||
82 | eval { require Cwd }; | ||||
83 | print $@; # prints "Can't locate Cwd.pm in @INC | ||||
84 | } # (@INC contains:) at..." | ||||
85 | |||||
86 | require Cwd; # loads Cwd.pm | ||||
87 | } | ||||
88 | |||||
89 | } # prints "top: done" | ||||
90 | |||||
91 | L</unwind> and L</want_at> : | ||||
92 | |||||
93 | package Try; | ||||
94 | |||||
95 | use Scope::Upper qw<unwind want_at :words>; | ||||
96 | |||||
97 | sub try (&) { | ||||
98 | my @result = shift->(); | ||||
99 | my $cx = SUB UP; # Point to the sub above this one | ||||
100 | unwind +(want_at($cx) ? @result : scalar @result) => $cx; | ||||
101 | } | ||||
102 | |||||
103 | ... | ||||
104 | |||||
105 | sub zap { | ||||
106 | try { | ||||
107 | my @things = qw<a b c>; | ||||
108 | return @things; # returns to try() and then outside zap() | ||||
109 | # not reached | ||||
110 | }; | ||||
111 | # not reached | ||||
112 | } | ||||
113 | |||||
114 | my @stuff = zap(); # @stuff contains qw<a b c> | ||||
115 | my $stuff = zap(); # $stuff contains 3 | ||||
116 | |||||
117 | L</uplevel> : | ||||
118 | |||||
119 | package Uplevel; | ||||
120 | |||||
121 | use Scope::Upper qw<uplevel CALLER>; | ||||
122 | |||||
123 | sub target { | ||||
124 | faker(@_); | ||||
125 | } | ||||
126 | |||||
127 | sub faker { | ||||
128 | uplevel { | ||||
129 | my $sub = (caller 0)[3]; | ||||
130 | print "$_[0] from $sub()"; | ||||
131 | } @_ => CALLER(1); | ||||
132 | } | ||||
133 | |||||
134 | target('hello'); # "hello from Uplevel::target()" | ||||
135 | |||||
136 | L</uid> and L</validate_uid> : | ||||
137 | |||||
138 | use Scope::Upper qw<uid validate_uid>; | ||||
139 | |||||
140 | my $uid; | ||||
141 | |||||
142 | { | ||||
143 | $uid = uid(); | ||||
144 | { | ||||
145 | if ($uid eq uid(UP)) { # yes | ||||
146 | ... | ||||
147 | } | ||||
148 | if (validate_uid($uid)) { # yes | ||||
149 | ... | ||||
150 | } | ||||
151 | } | ||||
152 | } | ||||
153 | |||||
154 | if (validate_uid($uid)) { # no | ||||
155 | ... | ||||
156 | } | ||||
157 | |||||
158 | =head1 DESCRIPTION | ||||
159 | |||||
160 | This module lets you defer actions I<at run-time> that will take place when the control flow returns into an upper scope. | ||||
161 | Currently, you can: | ||||
162 | |||||
163 | =over 4 | ||||
164 | |||||
165 | =item * | ||||
166 | |||||
167 | hook an upper scope end with L</reap> ; | ||||
168 | |||||
169 | =item * | ||||
170 | |||||
171 | localize variables, array/hash values or deletions of elements in higher contexts with respectively L</localize>, L</localize_elem> and L</localize_delete> ; | ||||
172 | |||||
173 | =item * | ||||
174 | |||||
175 | return values immediately to an upper level with L</unwind>, L</yield> and L</leave> ; | ||||
176 | |||||
177 | =item * | ||||
178 | |||||
179 | gather information about an upper context with L</want_at> and L</context_info> ; | ||||
180 | |||||
181 | =item * | ||||
182 | |||||
183 | execute a subroutine in the setting of an upper subroutine stack frame with L</uplevel> ; | ||||
184 | |||||
185 | =item * | ||||
186 | |||||
187 | uniquely identify contexts with L</uid> and L</validate_uid>. | ||||
188 | |||||
189 | =back | ||||
190 | |||||
191 | =head1 FUNCTIONS | ||||
192 | |||||
193 | In all those functions, C<$context> refers to the target scope. | ||||
194 | |||||
195 | You have to use one or a combination of L</WORDS> to build the C<$context> passed to these functions. | ||||
196 | This is needed in order to ensure that the module still works when your program is ran in the debugger. | ||||
197 | The only thing you can assume is that it is an I<absolute> indicator of the frame, which means that you can safely store it at some point and use it when needed, and it will still denote the original scope. | ||||
198 | |||||
199 | =cut | ||||
200 | |||||
201 | # spent 194µs (11+182) within Scope::Upper::BEGIN@201 which was called:
# once (11µs+182µs) by PONAPI::Server::BEGIN@13 at line 204 | ||||
202 | 1 | 400ns | require XSLoader; | ||
203 | 1 | 194µs | 1 | 182µs | XSLoader::load(__PACKAGE__, $VERSION); # spent 182µs making 1 call to XSLoader::load |
204 | 1 | 200µs | 1 | 194µs | } # spent 194µs making 1 call to Scope::Upper::BEGIN@201 |
205 | |||||
206 | =head2 C<reap> | ||||
207 | |||||
208 | reap { ... }; | ||||
209 | reap { ... } $context; | ||||
210 | &reap($callback, $context); | ||||
211 | |||||
212 | Adds a destructor that calls C<$callback> (in void context) when the upper scope represented by C<$context> ends. | ||||
213 | |||||
214 | =head2 C<localize> | ||||
215 | |||||
216 | localize $what, $value; | ||||
217 | localize $what, $value, $context; | ||||
218 | |||||
219 | Introduces a C<local> delayed to the time of first return into the upper scope denoted by C<$context>. | ||||
220 | C<$what> can be : | ||||
221 | |||||
222 | =over 4 | ||||
223 | |||||
224 | =item * | ||||
225 | |||||
226 | A glob, in which case C<$value> can either be a glob or a reference. | ||||
227 | L</localize> follows then the same syntax as C<local *x = $value>. | ||||
228 | For example, if C<$value> is a scalar reference, then the C<SCALAR> slot of the glob will be set to C<$$value> - just like C<local *x = \1> sets C<$x> to C<1>. | ||||
229 | |||||
230 | =item * | ||||
231 | |||||
232 | A string beginning with a sigil, representing the symbol to localize and to assign to. | ||||
233 | If the sigil is C<'$'>, L</localize> follows the same syntax as C<local $x = $value>, i.e. C<$value> isn't dereferenced. | ||||
234 | For example, | ||||
235 | |||||
236 | localize '$x', \'foo' => HERE; | ||||
237 | |||||
238 | will set C<$x> to a reference to the string C<'foo'>. | ||||
239 | Other sigils (C<'@'>, C<'%'>, C<'&'> and C<'*'>) require C<$value> to be a reference of the corresponding type. | ||||
240 | |||||
241 | When the symbol is given by a string, it is resolved when the actual localization takes place and not when L</localize> is called. | ||||
242 | Thus, if the symbol name is not qualified, it will refer to the variable in the package where the localization actually takes place and not in the one where the L</localize> call was compiled. | ||||
243 | For example, | ||||
244 | |||||
245 | { | ||||
246 | package Scope; | ||||
247 | sub new { localize '$tag', $_[0] => UP } | ||||
248 | } | ||||
249 | |||||
250 | { | ||||
251 | package Tool; | ||||
252 | { | ||||
253 | Scope->new; | ||||
254 | ... | ||||
255 | } | ||||
256 | } | ||||
257 | |||||
258 | will localize C<$Tool::tag> and not C<$Scope::tag>. | ||||
259 | If you want the other behaviour, you just have to specify C<$what> as a glob or a qualified name. | ||||
260 | |||||
261 | Note that if C<$what> is a string denoting a variable that wasn't declared beforehand, the relevant slot will be vivified as needed and won't be deleted from the glob when the localization ends. | ||||
262 | This situation never arises with C<local> because it only compiles when the localized variable is already declared. | ||||
263 | Although I believe it shouldn't be a problem as glob slots definedness is pretty much an implementation detail, this behaviour may change in the future if proved harmful. | ||||
264 | |||||
265 | =back | ||||
266 | |||||
267 | =head2 C<localize_elem> | ||||
268 | |||||
269 | localize_elem $what, $key, $value; | ||||
270 | localize_elem $what, $key, $value, $context; | ||||
271 | |||||
272 | Introduces a C<local $what[$key] = $value> or C<local $what{$key} = $value> delayed to the time of first return into the upper scope denoted by C<$context>. | ||||
273 | Unlike L</localize>, C<$what> must be a string and the type of localization is inferred from its sigil. | ||||
274 | The two only valid types are array and hash ; for anything besides those, L</localize_elem> will throw an exception. | ||||
275 | C<$key> is either an array index or a hash key, depending of which kind of variable you localize. | ||||
276 | |||||
277 | If C<$what> is a string pointing to an undeclared variable, the variable will be vivified as soon as the localization occurs and emptied when it ends, although it will still exist in its glob. | ||||
278 | |||||
279 | =head2 C<localize_delete> | ||||
280 | |||||
281 | localize_delete $what, $key; | ||||
282 | localize_delete $what, $key, $context; | ||||
283 | |||||
284 | Introduces the deletion of a variable or an array/hash element delayed to the time of first return into the upper scope denoted by C<$context>. | ||||
285 | C<$what> can be: | ||||
286 | |||||
287 | =over 4 | ||||
288 | |||||
289 | =item * | ||||
290 | |||||
291 | A glob, in which case C<$key> is ignored and the call is equivalent to C<local *x>. | ||||
292 | |||||
293 | =item * | ||||
294 | |||||
295 | A string beginning with C<'@'> or C<'%'>, for which the call is equivalent to respectively C<local $a[$key]; delete $a[$key]> and C<local $h{$key}; delete $h{$key}>. | ||||
296 | |||||
297 | =item * | ||||
298 | |||||
299 | A string beginning with C<'&'>, which more or less does C<undef &func> in the upper scope. | ||||
300 | It's actually more powerful, as C<&func> won't even C<exists> anymore. | ||||
301 | C<$key> is ignored. | ||||
302 | |||||
303 | =back | ||||
304 | |||||
305 | =head2 C<unwind> | ||||
306 | |||||
307 | unwind; | ||||
308 | unwind @values, $context; | ||||
309 | |||||
310 | Returns C<@values> I<from> the subroutine, eval or format context pointed by or just above C<$context>, and immediately restarts the program flow at this point - thus effectively returning C<@values> to an upper scope. | ||||
311 | If C<@values> is empty, then the C<$context> parameter is optional and defaults to the current context (making the call equivalent to a bare C<return;>) ; otherwise it is mandatory. | ||||
312 | |||||
313 | The upper context isn't coerced onto C<@values>, which is hence always evaluated in list context. | ||||
314 | This means that | ||||
315 | |||||
316 | my $num = sub { | ||||
317 | my @a = ('a' .. 'z'); | ||||
318 | unwind @a => HERE; | ||||
319 | # not reached | ||||
320 | }->(); | ||||
321 | |||||
322 | will set C<$num> to C<'z'>. | ||||
323 | You can use L</want_at> to handle these cases. | ||||
324 | |||||
325 | =head2 C<yield> | ||||
326 | |||||
327 | yield; | ||||
328 | yield @values, $context; | ||||
329 | |||||
330 | Returns C<@values> I<from> the context pointed by or just above C<$context>, and immediately restarts the program flow at this point. | ||||
331 | If C<@values> is empty, then the C<$context> parameter is optional and defaults to the current context ; otherwise it is mandatory. | ||||
332 | |||||
333 | L</yield> differs from L</unwind> in that it can target I<any> upper scope (besides a C<s///e> substitution context) and not necessarily a sub, an eval or a format. | ||||
334 | Hence you can use it to return values from a C<do> or a C<map> block : | ||||
335 | |||||
336 | my $now = do { | ||||
337 | local $@; | ||||
338 | eval { require Time::HiRes } or yield time() => HERE; | ||||
339 | Time::HiRes::time(); | ||||
340 | }; | ||||
341 | |||||
342 | my @uniq = map { | ||||
343 | yield if $seen{$_}++; # returns the empty list from the block | ||||
344 | ... | ||||
345 | } @things; | ||||
346 | |||||
347 | Like for L</unwind>, the upper context isn't coerced onto C<@values>. | ||||
348 | You can use the fifth value returned by L</context_info> to handle context coercion. | ||||
349 | |||||
350 | =head2 C<leave> | ||||
351 | |||||
352 | leave; | ||||
353 | leave @values; | ||||
354 | |||||
355 | Immediately returns C<@values> from the current block, whatever it may be (besides a C<s///e> substitution context). | ||||
356 | C<leave> is actually a synonym for C<yield HERE>, while C<leave @values> is a synonym for C<yield @values, HERE>. | ||||
357 | |||||
358 | Like for L</yield>, you can use the fifth value returned by L</context_info> to handle context coercion. | ||||
359 | |||||
360 | =head2 C<want_at> | ||||
361 | |||||
362 | my $want = want_at; | ||||
363 | my $want = want_at $context; | ||||
364 | |||||
365 | Like L<perlfunc/wantarray>, but for the subroutine, eval or format context located at or just above C<$context>. | ||||
366 | |||||
367 | It can be used to revise the example showed in L</unwind> : | ||||
368 | |||||
369 | my $num = sub { | ||||
370 | my @a = ('a' .. 'z'); | ||||
371 | unwind +(want_at(HERE) ? @a : scalar @a) => HERE; | ||||
372 | # not reached | ||||
373 | }->(); | ||||
374 | |||||
375 | will rightfully set C<$num> to C<26>. | ||||
376 | |||||
377 | =head2 C<context_info> | ||||
378 | |||||
379 | my ($package, $filename, $line, $subroutine, $hasargs, | ||||
380 | $wantarray, $evaltext, $is_require, $hints, $bitmask, | ||||
381 | $hinthash) = context_info $context; | ||||
382 | |||||
383 | Gives information about the context denoted by C<$context>, akin to what L<perlfunc/caller> provides but not limited only to subroutine, eval and format contexts. | ||||
384 | When C<$context> is omitted, it defaults to the current context. | ||||
385 | |||||
386 | The returned values are, in order : | ||||
387 | |||||
388 | =over 4 | ||||
389 | |||||
390 | =item * | ||||
391 | |||||
392 | I<(index 0)> : the namespace in use when the context was created ; | ||||
393 | |||||
394 | =item * | ||||
395 | |||||
396 | I<(index 1)> : the name of the file at the point where the context was created ; | ||||
397 | |||||
398 | =item * | ||||
399 | |||||
400 | I<(index 2)> : the line number at the point where the context was created ; | ||||
401 | |||||
402 | =item * | ||||
403 | |||||
404 | I<(index 3)> : the name of the subroutine called for this context, or C<undef> if this is not a subroutine context ; | ||||
405 | |||||
406 | =item * | ||||
407 | |||||
408 | I<(index 4)> : a boolean indicating whether a new instance of C<@_> was set up for this context, or C<undef> if this is not a subroutine context ; | ||||
409 | |||||
410 | =item * | ||||
411 | |||||
412 | I<(index 5)> : the context (in the sense of L<perlfunc/wantarray>) in which the context (in our sense) is executed ; | ||||
413 | |||||
414 | =item * | ||||
415 | |||||
416 | I<(index 6)> : the contents of the string being compiled for this context, or C<undef> if this is not an eval context ; | ||||
417 | |||||
418 | =item * | ||||
419 | |||||
420 | I<(index 7)> : a boolean indicating whether this eval context was created by C<require>, or C<undef> if this is not an eval context ; | ||||
421 | |||||
422 | =item * | ||||
423 | |||||
424 | I<(index 8)> : the value of the lexical hints in use when the context was created ; | ||||
425 | |||||
426 | =item * | ||||
427 | |||||
428 | I<(index 9)> : a bit string representing the warnings in use when the context was created ; | ||||
429 | |||||
430 | =item * | ||||
431 | |||||
432 | I<(index 10)> : a reference to the lexical hints hash in use when the context was created (only on perl 5.10 or greater). | ||||
433 | |||||
434 | =back | ||||
435 | |||||
436 | =head2 C<uplevel> | ||||
437 | |||||
438 | my @ret = uplevel { ...; return @ret }; | ||||
439 | my @ret = uplevel { my @args = @_; ...; return @ret } @args, $context; | ||||
440 | my @ret = &uplevel($callback, @args, $context); | ||||
441 | |||||
442 | Executes the code reference C<$callback> with arguments C<@args> as if it were located at the subroutine stack frame pointed by C<$context>, effectively fooling C<caller> and C<die> into believing that the call actually happened higher in the stack. | ||||
443 | The code is executed in the context of the C<uplevel> call, and what it returns is returned as-is by C<uplevel>. | ||||
444 | |||||
445 | sub target { | ||||
446 | faker(@_); | ||||
447 | } | ||||
448 | |||||
449 | sub faker { | ||||
450 | uplevel { | ||||
451 | map { 1 / $_ } @_; | ||||
452 | } @_ => CALLER(1); | ||||
453 | } | ||||
454 | |||||
455 | my @inverses = target(1, 2, 4); # @inverses contains (0, 0.5, 0.25) | ||||
456 | my $count = target(1, 2, 4); # $count is 3 | ||||
457 | |||||
458 | Note that if C<@args> is empty, then the C<$context> parameter is optional and defaults to the current context ; otherwise it is mandatory. | ||||
459 | |||||
460 | L<Sub::Uplevel> also implements a pure-Perl version of C<uplevel>. | ||||
461 | Both are identical, with the following caveats : | ||||
462 | |||||
463 | =over 4 | ||||
464 | |||||
465 | =item * | ||||
466 | |||||
467 | The L<Sub::Uplevel> implementation of C<uplevel> may execute a code reference in the context of B<any> upper stack frame. | ||||
468 | The L<Scope::Upper> version can only uplevel to a B<subroutine> stack frame, and will croak if you try to target an C<eval> or a format. | ||||
469 | |||||
470 | =item * | ||||
471 | |||||
472 | Exceptions thrown from the code called by this version of C<uplevel> will not be caught by C<eval> blocks between the target frame and the uplevel call, while they will for L<Sub::Uplevel>'s version. | ||||
473 | This means that : | ||||
474 | |||||
475 | eval { | ||||
476 | sub { | ||||
477 | local $@; | ||||
478 | eval { | ||||
479 | sub { | ||||
480 | uplevel { die 'wut' } CALLER(2); # for Scope::Upper | ||||
481 | # uplevel(3, sub { die 'wut' }) # for Sub::Uplevel | ||||
482 | }->(); | ||||
483 | }; | ||||
484 | print "inner block: $@"; | ||||
485 | $@ and exit; | ||||
486 | }->(); | ||||
487 | }; | ||||
488 | print "outer block: $@"; | ||||
489 | |||||
490 | will print "inner block: wut..." with L<Sub::Uplevel> and "outer block: wut..." with L<Scope::Upper>. | ||||
491 | |||||
492 | =item * | ||||
493 | |||||
494 | L<Sub::Uplevel> globally overrides the Perl keyword C<caller>, while L<Scope::Upper> does not. | ||||
495 | |||||
496 | =back | ||||
497 | |||||
498 | A simple wrapper lets you mimic the interface of L<Sub::Uplevel/uplevel> : | ||||
499 | |||||
500 | use Scope::Upper; | ||||
501 | |||||
502 | sub uplevel { | ||||
503 | my $frame = shift; | ||||
504 | my $code = shift; | ||||
505 | my $cxt = Scope::Upper::CALLER($frame); | ||||
506 | &Scope::Upper::uplevel($code => @_ => $cxt); | ||||
507 | } | ||||
508 | |||||
509 | Albeit the three exceptions listed above, it passes all the tests of L<Sub::Uplevel>. | ||||
510 | |||||
511 | =head2 C<uid> | ||||
512 | |||||
513 | my $uid = uid; | ||||
514 | my $uid = uid $context; | ||||
515 | |||||
516 | Returns an unique identifier (UID) for the context (or dynamic scope) pointed by C<$context>, or for the current context if C<$context> is omitted. | ||||
517 | This UID will only be valid for the life time of the context it represents, and another UID will be generated next time the same scope is executed. | ||||
518 | |||||
519 | my $uid; | ||||
520 | |||||
521 | { | ||||
522 | $uid = uid; | ||||
523 | if ($uid eq uid()) { # yes, this is the same context | ||||
524 | ... | ||||
525 | } | ||||
526 | { | ||||
527 | if ($uid eq uid()) { # no, we are one scope below | ||||
528 | ... | ||||
529 | } | ||||
530 | if ($uid eq uid(UP)) { # yes, UP points to the same scope as $uid | ||||
531 | ... | ||||
532 | } | ||||
533 | } | ||||
534 | } | ||||
535 | |||||
536 | # $uid is now invalid | ||||
537 | |||||
538 | { | ||||
539 | if ($uid eq uid()) { # no, this is another block | ||||
540 | ... | ||||
541 | } | ||||
542 | } | ||||
543 | |||||
544 | For example, each loop iteration gets its own UID : | ||||
545 | |||||
546 | my %uids; | ||||
547 | |||||
548 | for (1 .. 5) { | ||||
549 | my $uid = uid; | ||||
550 | $uids{$uid} = $_; | ||||
551 | } | ||||
552 | |||||
553 | # %uids has 5 entries | ||||
554 | |||||
555 | The UIDs are not guaranteed to be numbers, so you must use the C<eq> operator to compare them. | ||||
556 | |||||
557 | To check whether a given UID is valid, you can use the L</validate_uid> function. | ||||
558 | |||||
559 | =head2 C<validate_uid> | ||||
560 | |||||
561 | my $is_valid = validate_uid $uid; | ||||
562 | |||||
563 | Returns true if and only if C<$uid> is the UID of a currently valid context (that is, it designates a scope that is higher than the current one in the call stack). | ||||
564 | |||||
565 | my $uid; | ||||
566 | |||||
567 | { | ||||
568 | $uid = uid(); | ||||
569 | if (validate_uid($uid)) { # yes | ||||
570 | ... | ||||
571 | } | ||||
572 | { | ||||
573 | if (validate_uid($uid)) { # yes | ||||
574 | ... | ||||
575 | } | ||||
576 | } | ||||
577 | } | ||||
578 | |||||
579 | if (validate_uid($uid)) { # no | ||||
580 | ... | ||||
581 | } | ||||
582 | |||||
583 | =head1 CONSTANTS | ||||
584 | |||||
585 | =head2 C<SU_THREADSAFE> | ||||
586 | |||||
587 | True iff the module could have been built when thread-safety features. | ||||
588 | |||||
589 | =head1 WORDS | ||||
590 | |||||
591 | =head2 Constants | ||||
592 | |||||
593 | =head3 C<TOP> | ||||
594 | |||||
595 | my $top_context = TOP; | ||||
596 | |||||
597 | Returns the context that currently represents the highest scope. | ||||
598 | |||||
599 | =head3 C<HERE> | ||||
600 | |||||
601 | my $current_context = HERE; | ||||
602 | |||||
603 | The context of the current scope. | ||||
604 | |||||
605 | =head2 Getting a context from a context | ||||
606 | |||||
607 | For any of those functions, C<$from> is expected to be a context. | ||||
608 | When omitted, it defaults to the current context. | ||||
609 | |||||
610 | =head3 C<UP> | ||||
611 | |||||
612 | my $upper_context = UP; | ||||
613 | my $upper_context = UP $from; | ||||
614 | |||||
615 | The context of the scope just above C<$from>. | ||||
616 | |||||
617 | =head3 C<SUB> | ||||
618 | |||||
619 | my $sub_context = SUB; | ||||
620 | my $sub_context = SUB $from; | ||||
621 | |||||
622 | The context of the closest subroutine above C<$from>. | ||||
623 | Note that C<$from> is returned if it is already a subroutine context ; hence C<SUB SUB == SUB>. | ||||
624 | |||||
625 | =head3 C<EVAL> | ||||
626 | |||||
627 | my $eval_context = EVAL; | ||||
628 | my $eval_context = EVAL $from; | ||||
629 | |||||
630 | The context of the closest eval above C<$from>. | ||||
631 | Note that C<$from> is returned if it is already an eval context ; hence C<EVAL EVAL == EVAL>. | ||||
632 | |||||
633 | =head2 Getting a context from a level | ||||
634 | |||||
635 | Here, C<$level> should denote a number of scopes above the current one. | ||||
636 | When omitted, it defaults to C<0> and those functions return the same context as L</HERE>. | ||||
637 | |||||
638 | =head3 C<SCOPE> | ||||
639 | |||||
640 | my $context = SCOPE; | ||||
641 | my $context = SCOPE $level; | ||||
642 | |||||
643 | The C<$level>-th upper context, regardless of its type. | ||||
644 | |||||
645 | =head3 C<CALLER> | ||||
646 | |||||
647 | my $context = CALLER; | ||||
648 | my $context = CALLER $level; | ||||
649 | |||||
650 | The context of the C<$level>-th upper subroutine/eval/format. | ||||
651 | It kind of corresponds to the context represented by C<caller $level>, but while e.g. C<caller 0> refers to the caller context, C<CALLER 0> will refer to the top scope in the current context. | ||||
652 | |||||
653 | =head2 Examples | ||||
654 | |||||
655 | Where L</reap> fires depending on the C<$cxt> : | ||||
656 | |||||
657 | sub { | ||||
658 | eval { | ||||
659 | sub { | ||||
660 | { | ||||
661 | reap \&cleanup => $cxt; | ||||
662 | ... | ||||
663 | } # $cxt = SCOPE(0) = HERE | ||||
664 | ... | ||||
665 | }->(); # $cxt = SCOPE(1) = UP = SUB = CALLER(0) | ||||
666 | ... | ||||
667 | }; # $cxt = SCOPE(2) = UP UP = UP SUB = EVAL = CALLER(1) | ||||
668 | ... | ||||
669 | }->(); # $cxt = SCOPE(3) = SUB UP SUB = SUB EVAL = CALLER(2) | ||||
670 | ... | ||||
671 | |||||
672 | Where L</localize>, L</localize_elem> and L</localize_delete> act depending on the C<$cxt> : | ||||
673 | |||||
674 | sub { | ||||
675 | eval { | ||||
676 | sub { | ||||
677 | { | ||||
678 | localize '$x' => 1 => $cxt; | ||||
679 | # $cxt = SCOPE(0) = HERE | ||||
680 | ... | ||||
681 | } | ||||
682 | # $cxt = SCOPE(1) = UP = SUB = CALLER(0) | ||||
683 | ... | ||||
684 | }->(); | ||||
685 | # $cxt = SCOPE(2) = UP UP = UP SUB = EVAL = CALLER(1) | ||||
686 | ... | ||||
687 | }; | ||||
688 | # $cxt = SCOPE(3) = SUB UP SUB = SUB EVAL = CALLER(2) | ||||
689 | ... | ||||
690 | }->(); | ||||
691 | # $cxt = SCOPE(4), UP SUB UP SUB = UP SUB EVAL = UP CALLER(2) = TOP | ||||
692 | ... | ||||
693 | |||||
694 | Where L</unwind>, L</yield>, L</want_at>, L</context_info> and L</uplevel> point to depending on the C<$cxt>: | ||||
695 | |||||
696 | sub { | ||||
697 | eval { | ||||
698 | sub { | ||||
699 | { | ||||
700 | unwind @things => $cxt; # or yield @things => $cxt | ||||
701 | # or uplevel { ... } $cxt | ||||
702 | ... | ||||
703 | } | ||||
704 | ... | ||||
705 | }->(); # $cxt = SCOPE(0) = SCOPE(1) = HERE = UP = SUB = CALLER(0) | ||||
706 | ... | ||||
707 | }; # $cxt = SCOPE(2) = UP UP = UP SUB = EVAL = CALLER(1) (*) | ||||
708 | ... | ||||
709 | }->(); # $cxt = SCOPE(3) = SUB UP SUB = SUB EVAL = CALLER(2) | ||||
710 | ... | ||||
711 | |||||
712 | # (*) Note that uplevel() will croak if you pass that scope frame, | ||||
713 | # because it cannot target eval scopes. | ||||
714 | |||||
715 | =head1 EXPORT | ||||
716 | |||||
717 | The functions L</reap>, L</localize>, L</localize_elem>, L</localize_delete>, L</unwind>, L</yield>, L</leave>, L</want_at>, L</context_info> and L</uplevel> are only exported on request, either individually or by the tags C<':funcs'> and C<':all'>. | ||||
718 | |||||
719 | The constant L</SU_THREADSAFE> is also only exported on request, individually or by the tags C<':consts'> and C<':all'>. | ||||
720 | |||||
721 | Same goes for the words L</TOP>, L</HERE>, L</UP>, L</SUB>, L</EVAL>, L</SCOPE> and L</CALLER> that are only exported on request, individually or by the tags C<':words'> and C<':all'>. | ||||
722 | |||||
723 | =cut | ||||
724 | |||||
725 | 2 | 120µs | 2 | 126µs | # spent 69µs (11+58) within Scope::Upper::BEGIN@725 which was called:
# once (11µs+58µs) by PONAPI::Server::BEGIN@13 at line 725 # spent 69µs making 1 call to Scope::Upper::BEGIN@725
# spent 58µs making 1 call to base::import |
726 | |||||
727 | 1 | 400ns | our @EXPORT = (); | ||
728 | 1 | 4µs | our %EXPORT_TAGS = ( | ||
729 | funcs => [ qw< | ||||
730 | reap | ||||
731 | localize localize_elem localize_delete | ||||
732 | unwind yield leave | ||||
733 | want_at context_info | ||||
734 | uplevel | ||||
735 | uid validate_uid | ||||
736 | > ], | ||||
737 | words => [ qw<TOP HERE UP SUB EVAL SCOPE CALLER> ], | ||||
738 | consts => [ qw<SU_THREADSAFE> ], | ||||
739 | ); | ||||
740 | 1 | 5µs | our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; | ||
741 | 1 | 2µs | $EXPORT_TAGS{'all'} = [ @EXPORT_OK ]; | ||
742 | |||||
743 | =head1 CAVEATS | ||||
744 | |||||
745 | Be careful that local variables are restored in the reverse order in which they were localized. | ||||
746 | Consider those examples: | ||||
747 | |||||
748 | local $x = 0; | ||||
749 | { | ||||
750 | reap sub { print $x } => HERE; | ||||
751 | local $x = 1; | ||||
752 | ... | ||||
753 | } | ||||
754 | # prints '0' | ||||
755 | ... | ||||
756 | { | ||||
757 | local $x = 1; | ||||
758 | reap sub { $x = 2 } => HERE; | ||||
759 | ... | ||||
760 | } | ||||
761 | # $x is 0 | ||||
762 | |||||
763 | The first case is "solved" by moving the C<local> before the C<reap>, and the second by using L</localize> instead of L</reap>. | ||||
764 | |||||
765 | The effects of L</reap>, L</localize> and L</localize_elem> can't cross C<BEGIN> blocks, hence calling those functions in C<import> is deemed to be useless. | ||||
766 | This is an hopeless case because C<BEGIN> blocks are executed once while localizing constructs should do their job at each run. | ||||
767 | However, it's possible to hook the end of the current scope compilation with L<B::Hooks::EndOfScope>. | ||||
768 | |||||
769 | Some rare oddities may still happen when running inside the debugger. | ||||
770 | It may help to use a perl higher than 5.8.9 or 5.10.0, as they contain some context-related fixes. | ||||
771 | |||||
772 | Calling C<goto> to replace an L</uplevel>'d code frame does not work : | ||||
773 | |||||
774 | =over 4 | ||||
775 | |||||
776 | =item * | ||||
777 | |||||
778 | for a C<perl> older than the 5.8 series ; | ||||
779 | |||||
780 | =item * | ||||
781 | |||||
782 | for a C<DEBUGGING> C<perl> run with debugging flags set (as in C<perl -D ...>) ; | ||||
783 | |||||
784 | =item * | ||||
785 | |||||
786 | when the runloop callback is replaced by another module. | ||||
787 | |||||
788 | =back | ||||
789 | |||||
790 | In those three cases, L</uplevel> will look for a C<goto &sub> statement in its callback and, if there is one, throw an exception before executing the code. | ||||
791 | |||||
792 | Moreover, in order to handle C<goto> statements properly, L</uplevel> currently has to suffer a run-time overhead proportional to the size of the callback in every case (with a small ratio), and proportional to the size of B<all> the code executed as the result of the L</uplevel> call (including subroutine calls inside the callback) when a C<goto> statement is found in the L</uplevel> callback. | ||||
793 | Despite this shortcoming, this XS version of L</uplevel> should still run way faster than the pure-Perl version from L<Sub::Uplevel>. | ||||
794 | |||||
795 | =head1 DEPENDENCIES | ||||
796 | |||||
797 | L<perl> 5.6.1. | ||||
798 | |||||
799 | A C compiler. | ||||
800 | This module may happen to build with a C++ compiler as well, but don't rely on it, as no guarantee is made in this regard. | ||||
801 | |||||
802 | L<XSLoader> (core since perl 5.6.0). | ||||
803 | |||||
804 | =head1 SEE ALSO | ||||
805 | |||||
806 | L<perlfunc/local>, L<perlsub/"Temporary Values via local()">. | ||||
807 | |||||
808 | L<Alias>, L<Hook::Scope>, L<Scope::Guard>, L<Guard>. | ||||
809 | |||||
810 | L<Sub::Uplevel>. | ||||
811 | |||||
812 | L<Continuation::Escape> is a thin wrapper around L<Scope::Upper> that gives you a continuation passing style interface to L</unwind>. | ||||
813 | It's easier to use, but it requires you to have control over the scope where you want to return. | ||||
814 | |||||
815 | L<Scope::Escape>. | ||||
816 | |||||
817 | =head1 AUTHOR | ||||
818 | |||||
819 | Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>. | ||||
820 | |||||
821 | You can contact me by mail or on C<irc.perl.org> (vincent). | ||||
822 | |||||
823 | =head1 BUGS | ||||
824 | |||||
825 | Please report any bugs or feature requests to C<bug-scope-upper at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Scope-Upper>. | ||||
826 | I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. | ||||
827 | |||||
828 | =head1 SUPPORT | ||||
829 | |||||
830 | You can find documentation for this module with the perldoc command. | ||||
831 | |||||
832 | perldoc Scope::Upper | ||||
833 | |||||
834 | Tests code coverage report is available at L<http://www.profvince.com/perl/cover/Scope-Upper>. | ||||
835 | |||||
836 | =head1 ACKNOWLEDGEMENTS | ||||
837 | |||||
838 | Inspired by Ricardo Signes. | ||||
839 | |||||
840 | Thanks to Shawn M. Moore for motivation. | ||||
841 | |||||
842 | =head1 COPYRIGHT & LICENSE | ||||
843 | |||||
844 | Copyright 2008,2009,2010,2011,2012,2013 Vincent Pit, all rights reserved. | ||||
845 | |||||
846 | This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. | ||||
847 | |||||
848 | =cut | ||||
849 | |||||
850 | 1 | 5µs | 1; # End of Scope::Upper | ||
# spent 303ms within Scope::Upper::HERE which was called 100001 times, avg 3µs/call:
# 100001 times (303ms+0s) by Return::MultiLevel::__ANON__[/usr/local/share/perl/5.18.2/Return/MultiLevel.pm:25] at line 19 of Return/MultiLevel.pm, avg 3µs/call |