forked from openkylin/libsub-uplevel-perl
171 lines
5.3 KiB
Plaintext
171 lines
5.3 KiB
Plaintext
NAME
|
|
Sub::Uplevel - apparently run a function in a higher stack frame
|
|
|
|
VERSION
|
|
version 0.2800
|
|
|
|
SYNOPSIS
|
|
use Sub::Uplevel;
|
|
|
|
sub foo {
|
|
print join " - ", caller;
|
|
}
|
|
|
|
sub bar {
|
|
uplevel 1, \&foo;
|
|
}
|
|
|
|
#line 11
|
|
bar(); # main - foo.plx - 11
|
|
|
|
DESCRIPTION
|
|
Like Tcl's uplevel() function, but not quite so dangerous. The idea is
|
|
just to fool caller(). All the really naughty bits of Tcl's uplevel()
|
|
are avoided.
|
|
|
|
THIS IS NOT THE SORT OF THING YOU WANT TO DO EVERYDAY
|
|
|
|
uplevel
|
|
uplevel $num_frames, \&func, @args;
|
|
|
|
Makes the given function think it's being executed $num_frames
|
|
higher than the current stack level. So when they use
|
|
caller($frames) it will actually give caller($frames + $num_frames)
|
|
for them.
|
|
|
|
"uplevel(1, \&some_func, @_)" is effectively "goto &some_func" but
|
|
you don't immediately exit the current subroutine. So while you
|
|
can't do this:
|
|
|
|
sub wrapper {
|
|
print "Before\n";
|
|
goto &some_func;
|
|
print "After\n";
|
|
}
|
|
|
|
you can do this:
|
|
|
|
sub wrapper {
|
|
print "Before\n";
|
|
my @out = uplevel 1, &some_func;
|
|
print "After\n";
|
|
return @out;
|
|
}
|
|
|
|
"uplevel" has the ability to issue a warning if $num_frames is more
|
|
than the current call stack depth, although this warning is disabled
|
|
and compiled out by default as the check is relatively expensive.
|
|
|
|
To enable the check for debugging or testing, you should set the
|
|
global $Sub::Uplevel::CHECK_FRAMES to true before loading
|
|
Sub::Uplevel for the first time as follows:
|
|
|
|
#!/usr/bin/perl
|
|
|
|
BEGIN {
|
|
$Sub::Uplevel::CHECK_FRAMES = 1;
|
|
}
|
|
use Sub::Uplevel;
|
|
|
|
Setting or changing the global after the module has been loaded will
|
|
have no effect.
|
|
|
|
EXAMPLE
|
|
The main reason I wrote this module is so I could write wrappers around
|
|
functions and they wouldn't be aware they've been wrapped.
|
|
|
|
use Sub::Uplevel;
|
|
|
|
my $original_foo = \&foo;
|
|
|
|
*foo = sub {
|
|
my @output = uplevel 1, $original_foo;
|
|
print "foo() returned: @output";
|
|
return @output;
|
|
};
|
|
|
|
If this code frightens you you should not use this module.
|
|
|
|
BUGS and CAVEATS
|
|
Well, the bad news is uplevel() is about 5 times slower than a normal
|
|
function call. XS implementation anyone? It also slows down every
|
|
invocation of caller(), regardless of whether uplevel() is in effect.
|
|
|
|
Sub::Uplevel overrides CORE::GLOBAL::caller temporarily for the scope of
|
|
each uplevel call. It does its best to work with any previously existing
|
|
CORE::GLOBAL::caller (both when Sub::Uplevel is first loaded and within
|
|
each uplevel call) such as from Contextual::Return or Hook::LexWrap.
|
|
|
|
However, if you are routinely using multiple modules that override
|
|
CORE::GLOBAL::caller, you are probably asking for trouble.
|
|
|
|
You should load Sub::Uplevel as early as possible within your program.
|
|
As with all CORE::GLOBAL overloading, the overload will not affect
|
|
modules that have already been compiled prior to the overload. One
|
|
module that often is unavoidably loaded prior to Sub::Uplevel is
|
|
Exporter. To forcibly recompile Exporter (and Exporter::Heavy) after
|
|
loading Sub::Uplevel, use it with the ":aggressive" tag:
|
|
|
|
use Sub::Uplevel qw/:aggressive/;
|
|
|
|
The private function "Sub::Uplevel::_force_reload()" may be passed a
|
|
list of additional modules to reload if ":aggressive" is not aggressive
|
|
enough. Reloading modules may break things, so only use this as a last
|
|
resort.
|
|
|
|
As of version 0.20, Sub::Uplevel requires Perl 5.6 or greater.
|
|
|
|
HISTORY
|
|
Those who do not learn from HISTORY are doomed to repeat it.
|
|
|
|
The lesson here is simple: Don't sit next to a Tcl programmer at the
|
|
dinner table.
|
|
|
|
THANKS
|
|
Thanks to Brent Welch, Damian Conway and Robin Houston.
|
|
|
|
See http://www.perl.com/perl/misc/Artistic.html
|
|
|
|
SEE ALSO
|
|
PadWalker (for the similar idea with lexicals), Hook::LexWrap, Tcl's
|
|
uplevel() at http://www.scriptics.com/man/tcl8.4/TclCmd/uplevel.htm
|
|
|
|
SUPPORT
|
|
Bugs / Feature Requests
|
|
Please report any bugs or feature requests through the issue tracker at
|
|
<https://github.com/Perl-Toolchain-Gang/Sub-Uplevel/issues>. You will be
|
|
notified automatically of any progress on your issue.
|
|
|
|
Source Code
|
|
This is open source software. The code repository is available for
|
|
public review and contribution under the terms of the license.
|
|
|
|
<https://github.com/Perl-Toolchain-Gang/Sub-Uplevel>
|
|
|
|
git clone https://github.com/Perl-Toolchain-Gang/Sub-Uplevel.git
|
|
|
|
AUTHORS
|
|
* Michael Schwern <mschwern@cpan.org>
|
|
|
|
* David Golden <dagolden@cpan.org>
|
|
|
|
CONTRIBUTORS
|
|
* Adam Kennedy <adamk@cpan.org>
|
|
|
|
* Alexandr Ciornii <alexchorny@gmail.com>
|
|
|
|
* David Golden <xdg@xdg.me>
|
|
|
|
* Graham Ollis <plicease@cpan.org>
|
|
|
|
* J. Nick Koston <nick@cpanel.net>
|
|
|
|
* Michael Gray <mg13@sanger.ac.uk>
|
|
|
|
COPYRIGHT AND LICENSE
|
|
This software is copyright (c) 2017 by Michael Schwern and David Golden.
|
|
|
|
This is free software; you can redistribute it and/or modify it under
|
|
the same terms as the Perl 5 programming language system itself.
|
|
|