1NAME 2 Sub::Uplevel - apparently run a function in a higher stack frame 3 4VERSION 5 version 0.2800 6 7SYNOPSIS 8 use Sub::Uplevel; 9 10 sub foo { 11 print join " - ", caller; 12 } 13 14 sub bar { 15 uplevel 1, \&foo; 16 } 17 18 #line 11 19 bar(); # main - foo.plx - 11 20 21DESCRIPTION 22 Like Tcl's uplevel() function, but not quite so dangerous. The idea is 23 just to fool caller(). All the really naughty bits of Tcl's uplevel() 24 are avoided. 25 26 THIS IS NOT THE SORT OF THING YOU WANT TO DO EVERYDAY 27 28 uplevel 29 uplevel $num_frames, \&func, @args; 30 31 Makes the given function think it's being executed $num_frames 32 higher than the current stack level. So when they use 33 caller($frames) it will actually give caller($frames + $num_frames) 34 for them. 35 36 "uplevel(1, \&some_func, @_)" is effectively "goto &some_func" but 37 you don't immediately exit the current subroutine. So while you 38 can't do this: 39 40 sub wrapper { 41 print "Before\n"; 42 goto &some_func; 43 print "After\n"; 44 } 45 46 you can do this: 47 48 sub wrapper { 49 print "Before\n"; 50 my @out = uplevel 1, &some_func; 51 print "After\n"; 52 return @out; 53 } 54 55 "uplevel" has the ability to issue a warning if $num_frames is more 56 than the current call stack depth, although this warning is disabled 57 and compiled out by default as the check is relatively expensive. 58 59 To enable the check for debugging or testing, you should set the 60 global $Sub::Uplevel::CHECK_FRAMES to true before loading 61 Sub::Uplevel for the first time as follows: 62 63 #!/usr/bin/perl 64 65 BEGIN { 66 $Sub::Uplevel::CHECK_FRAMES = 1; 67 } 68 use Sub::Uplevel; 69 70 Setting or changing the global after the module has been loaded will 71 have no effect. 72 73EXAMPLE 74 The main reason I wrote this module is so I could write wrappers around 75 functions and they wouldn't be aware they've been wrapped. 76 77 use Sub::Uplevel; 78 79 my $original_foo = \&foo; 80 81 *foo = sub { 82 my @output = uplevel 1, $original_foo; 83 print "foo() returned: @output"; 84 return @output; 85 }; 86 87 If this code frightens you you should not use this module. 88 89BUGS and CAVEATS 90 Well, the bad news is uplevel() is about 5 times slower than a normal 91 function call. XS implementation anyone? It also slows down every 92 invocation of caller(), regardless of whether uplevel() is in effect. 93 94 Sub::Uplevel overrides CORE::GLOBAL::caller temporarily for the scope of 95 each uplevel call. It does its best to work with any previously existing 96 CORE::GLOBAL::caller (both when Sub::Uplevel is first loaded and within 97 each uplevel call) such as from Contextual::Return or Hook::LexWrap. 98 99 However, if you are routinely using multiple modules that override 100 CORE::GLOBAL::caller, you are probably asking for trouble. 101 102 You should load Sub::Uplevel as early as possible within your program. 103 As with all CORE::GLOBAL overloading, the overload will not affect 104 modules that have already been compiled prior to the overload. One 105 module that often is unavoidably loaded prior to Sub::Uplevel is 106 Exporter. To forcibly recompile Exporter (and Exporter::Heavy) after 107 loading Sub::Uplevel, use it with the ":aggressive" tag: 108 109 use Sub::Uplevel qw/:aggressive/; 110 111 The private function "Sub::Uplevel::_force_reload()" may be passed a 112 list of additional modules to reload if ":aggressive" is not aggressive 113 enough. Reloading modules may break things, so only use this as a last 114 resort. 115 116 As of version 0.20, Sub::Uplevel requires Perl 5.6 or greater. 117 118HISTORY 119 Those who do not learn from HISTORY are doomed to repeat it. 120 121 The lesson here is simple: Don't sit next to a Tcl programmer at the 122 dinner table. 123 124THANKS 125 Thanks to Brent Welch, Damian Conway and Robin Houston. 126 127 See http://www.perl.com/perl/misc/Artistic.html 128 129SEE ALSO 130 PadWalker (for the similar idea with lexicals), Hook::LexWrap, Tcl's 131 uplevel() at http://www.scriptics.com/man/tcl8.4/TclCmd/uplevel.htm 132 133SUPPORT 134 Bugs / Feature Requests 135 Please report any bugs or feature requests through the issue tracker at 136 <https://github.com/Perl-Toolchain-Gang/Sub-Uplevel/issues>. You will be 137 notified automatically of any progress on your issue. 138 139 Source Code 140 This is open source software. The code repository is available for 141 public review and contribution under the terms of the license. 142 143 <https://github.com/Perl-Toolchain-Gang/Sub-Uplevel> 144 145 git clone https://github.com/Perl-Toolchain-Gang/Sub-Uplevel.git 146 147AUTHORS 148 * Michael Schwern <mschwern@cpan.org> 149 150 * David Golden <dagolden@cpan.org> 151 152CONTRIBUTORS 153 * Adam Kennedy <adamk@cpan.org> 154 155 * Alexandr Ciornii <alexchorny@gmail.com> 156 157 * David Golden <xdg@xdg.me> 158 159 * Graham Ollis <plicease@cpan.org> 160 161 * J. Nick Koston <nick@cpanel.net> 162 163 * Michael Gray <mg13@sanger.ac.uk> 164 165COPYRIGHT AND LICENSE 166 This software is copyright (c) 2017 by Michael Schwern and David Golden. 167 168 This is free software; you can redistribute it and/or modify it under 169 the same terms as the Perl 5 programming language system itself. 170 171