diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Sub/Uplevel.pod')
-rwxr-xr-x | Master/tlpkg/tlperl/lib/Sub/Uplevel.pod | 197 |
1 files changed, 197 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Sub/Uplevel.pod b/Master/tlpkg/tlperl/lib/Sub/Uplevel.pod new file mode 100755 index 00000000000..7ae447f9fb6 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Sub/Uplevel.pod @@ -0,0 +1,197 @@ +# Generated by Pod::WikiDoc version 0.18 + +=pod + +=head1 NAME + +Sub::Uplevel - apparently run a function in a higher stack frame + +=head1 VERSION + +This documentation describes version 0.22 + + +=head1 SYNOPSIS + + use Sub::Uplevel; + + sub foo { + print join " - ", caller; + } + + sub bar { + uplevel 1, \&foo; + } + + #line 11 + bar(); # main - foo.plx - 11 + +=head1 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. + +B<THIS IS NOT THE SORT OF THING YOU WANT TO DO EVERYDAY> + +=over 4 + +=item B<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. + +C<uplevel(1, \&some_func, @_)> is effectively C<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; + } + +C<uplevel> will issue a warning if C<$num_frames> is more than the current call +stack depth. + +=begin _private + +So it has to work like this: + + Call stack Actual uplevel 1 +CORE::GLOBAL::caller +Carp::short_error_loc 0 +Carp::shortmess_heavy 1 0 +Carp::croak 2 1 +try_croak 3 2 +uplevel 4 +function_that_called_uplevel 5 +caller_we_want_to_see 6 3 +its_caller 7 4 + +So when caller(X) winds up below uplevel(), it only has to use +CORE::caller(X+1) (to skip CORE::GLOBAL::caller). But when caller(X) +winds up no or above uplevel(), it's CORE::caller(X+1+uplevel+1). + +Which means I'm probably going to have to do something nasty like walk +up the call stack on each caller() to see if I'm going to wind up +before or after Sub::Uplevel::uplevel(). + +=end _private + +=begin _dagolden + +I found the description above a bit confusing. Instead, this is the logic +that I found clearer when CORE::GLOBAL::caller is invoked and we have to +walk up the call stack: + +* if searching up to the requested height in the real call stack doesn't find +a call to uplevel, then we can return the result at that height in the +call stack + +* if we find a call to uplevel, we need to keep searching upwards beyond the +requested height at least by the amount of upleveling requested for that +call to uplevel (from the Up_Frames stack set during the uplevel call) + +* additionally, we need to hide the uplevel subroutine call, too, so we search +upwards one more level for each call to uplevel + +* when we've reached the top of the search, we want to return that frame +in the call stack, i.e. the requested height plus any uplevel adjustments +found during the search + +=end _dagolden + +=back + +=head1 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 B<you should not use this module.> + + +=head1 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 B<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 forceably recompile +Exporter (and Exporter::Heavy) after loading Sub::Uplevel, use it with the +":aggressive" tag: + + use Sub::Uplevel qw/:aggressive/; + +The private function C<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. + +=head1 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. + +=head1 THANKS + +Thanks to Brent Welch, Damian Conway and Robin Houston. + +=head1 AUTHORS + +David A Golden E<lt>dagolden@cpan.orgE<gt> (current maintainer) + +Michael G Schwern E<lt>schwern@pobox.comE<gt> (original author) + +=head1 LICENSE + +Original code Copyright (c) 2001 to 2007 by Michael G Schwern. +Additional code Copyright (c) 2006 to 2008 by David A Golden. + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +See http://www.perl.com/perl/misc/Artistic.html + +=head1 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 + |