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