| 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 | Scope::Upper::HERE (xsub) |
| 1 | 1 | 1 | 12µs | 12µs | Scope::Upper::BEGIN@3 |
| 1 | 1 | 1 | 11µs | 194µs | Scope::Upper::BEGIN@201 |
| 1 | 1 | 1 | 11µs | 69µs | Scope::Upper::BEGIN@725 |
| 1 | 1 | 1 | 7µs | 10µs | Scope::Upper::BEGIN@6 |
| 1 | 1 | 1 | 6µs | 15µs | Scope::Upper::BEGIN@5 |
| 1 | 1 | 1 | 3µs | 3µs | Scope::Upper::BEGIN@19 |
| 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 |