Commit | Line | Data |
3fea05b9 |
1 | # Generated by Pod::WikiDoc version 0.18 |
2 | |
3 | =pod |
4 | |
5 | =head1 NAME |
6 | |
7 | Sub::Uplevel - apparently run a function in a higher stack frame |
8 | |
9 | =head1 VERSION |
10 | |
11 | This documentation describes version 0.22 |
12 | |
13 | |
14 | =head1 SYNOPSIS |
15 | |
16 | use Sub::Uplevel; |
17 | |
18 | sub foo { |
19 | print join " - ", caller; |
20 | } |
21 | |
22 | sub bar { |
23 | uplevel 1, \&foo; |
24 | } |
25 | |
26 | #line 11 |
27 | bar(); # main - foo.plx - 11 |
28 | |
29 | =head1 DESCRIPTION |
30 | |
31 | Like Tcl's uplevel() function, but not quite so dangerous. The idea |
32 | is just to fool caller(). All the really naughty bits of Tcl's |
33 | uplevel() are avoided. |
34 | |
35 | B<THIS IS NOT THE SORT OF THING YOU WANT TO DO EVERYDAY> |
36 | |
37 | =over 4 |
38 | |
39 | =item B<uplevel> |
40 | |
41 | uplevel $num_frames, \&func, @args; |
42 | |
43 | Makes the given function think it's being executed $num_frames higher |
44 | than the current stack level. So when they use caller($frames) it |
45 | will actually give caller($frames + $num_frames) for them. |
46 | |
47 | C<uplevel(1, \&some_func, @_)> is effectively C<goto &some_func> but |
48 | you don't immediately exit the current subroutine. So while you can't |
49 | do this: |
50 | |
51 | sub wrapper { |
52 | print "Before\n"; |
53 | goto &some_func; |
54 | print "After\n"; |
55 | } |
56 | |
57 | you can do this: |
58 | |
59 | sub wrapper { |
60 | print "Before\n"; |
61 | my @out = uplevel 1, &some_func; |
62 | print "After\n"; |
63 | return @out; |
64 | } |
65 | |
66 | C<uplevel> will issue a warning if C<$num_frames> is more than the current call |
67 | stack depth. |
68 | |
69 | =begin _private |
70 | |
71 | So it has to work like this: |
72 | |
73 | Call stack Actual uplevel 1 |
74 | CORE::GLOBAL::caller |
75 | Carp::short_error_loc 0 |
76 | Carp::shortmess_heavy 1 0 |
77 | Carp::croak 2 1 |
78 | try_croak 3 2 |
79 | uplevel 4 |
80 | function_that_called_uplevel 5 |
81 | caller_we_want_to_see 6 3 |
82 | its_caller 7 4 |
83 | |
84 | So when caller(X) winds up below uplevel(), it only has to use |
85 | CORE::caller(X+1) (to skip CORE::GLOBAL::caller). But when caller(X) |
86 | winds up no or above uplevel(), it's CORE::caller(X+1+uplevel+1). |
87 | |
88 | Which means I'm probably going to have to do something nasty like walk |
89 | up the call stack on each caller() to see if I'm going to wind up |
90 | before or after Sub::Uplevel::uplevel(). |
91 | |
92 | =end _private |
93 | |
94 | =begin _dagolden |
95 | |
96 | I found the description above a bit confusing. Instead, this is the logic |
97 | that I found clearer when CORE::GLOBAL::caller is invoked and we have to |
98 | walk up the call stack: |
99 | |
100 | * if searching up to the requested height in the real call stack doesn't find |
101 | a call to uplevel, then we can return the result at that height in the |
102 | call stack |
103 | |
104 | * if we find a call to uplevel, we need to keep searching upwards beyond the |
105 | requested height at least by the amount of upleveling requested for that |
106 | call to uplevel (from the Up_Frames stack set during the uplevel call) |
107 | |
108 | * additionally, we need to hide the uplevel subroutine call, too, so we search |
109 | upwards one more level for each call to uplevel |
110 | |
111 | * when we've reached the top of the search, we want to return that frame |
112 | in the call stack, i.e. the requested height plus any uplevel adjustments |
113 | found during the search |
114 | |
115 | =end _dagolden |
116 | |
117 | =back |
118 | |
119 | =head1 EXAMPLE |
120 | |
121 | The main reason I wrote this module is so I could write wrappers |
122 | around functions and they wouldn't be aware they've been wrapped. |
123 | |
124 | use Sub::Uplevel; |
125 | |
126 | my $original_foo = \&foo; |
127 | |
128 | *foo = sub { |
129 | my @output = uplevel 1, $original_foo; |
130 | print "foo() returned: @output"; |
131 | return @output; |
132 | }; |
133 | |
134 | If this code frightens you B<you should not use this module.> |
135 | |
136 | |
137 | =head1 BUGS and CAVEATS |
138 | |
139 | Well, the bad news is uplevel() is about 5 times slower than a normal |
140 | function call. XS implementation anyone? It also slows down every invocation |
141 | of caller(), regardless of whether uplevel() is in effect. |
142 | |
143 | Sub::Uplevel overrides CORE::GLOBAL::caller temporarily for the scope of |
144 | each uplevel call. It does its best to work with any previously existing |
145 | CORE::GLOBAL::caller (both when Sub::Uplevel is first loaded and within |
146 | each uplevel call) such as from Contextual::Return or Hook::LexWrap. |
147 | |
148 | However, if you are routinely using multiple modules that override |
149 | CORE::GLOBAL::caller, you are probably asking for trouble. |
150 | |
151 | You B<should> load Sub::Uplevel as early as possible within your program. As |
152 | with all CORE::GLOBAL overloading, the overload will not affect modules that |
153 | have already been compiled prior to the overload. One module that often is |
154 | unavoidably loaded prior to Sub::Uplevel is Exporter. To forceably recompile |
155 | Exporter (and Exporter::Heavy) after loading Sub::Uplevel, use it with the |
156 | ":aggressive" tag: |
157 | |
158 | use Sub::Uplevel qw/:aggressive/; |
159 | |
160 | The private function C<Sub::Uplevel::_force_reload()> may be passed a list of |
161 | additional modules to reload if ":aggressive" is not aggressive enough. |
162 | Reloading modules may break things, so only use this as a last resort. |
163 | |
164 | As of version 0.20, Sub::Uplevel requires Perl 5.6 or greater. |
165 | |
166 | =head1 HISTORY |
167 | |
168 | Those who do not learn from HISTORY are doomed to repeat it. |
169 | |
170 | The lesson here is simple: Don't sit next to a Tcl programmer at the |
171 | dinner table. |
172 | |
173 | =head1 THANKS |
174 | |
175 | Thanks to Brent Welch, Damian Conway and Robin Houston. |
176 | |
177 | =head1 AUTHORS |
178 | |
179 | David A Golden E<lt>dagolden@cpan.orgE<gt> (current maintainer) |
180 | |
181 | Michael G Schwern E<lt>schwern@pobox.comE<gt> (original author) |
182 | |
183 | =head1 LICENSE |
184 | |
185 | Original code Copyright (c) 2001 to 2007 by Michael G Schwern. |
186 | Additional code Copyright (c) 2006 to 2008 by David A Golden. |
187 | |
188 | This program is free software; you can redistribute it and/or modify it |
189 | under the same terms as Perl itself. |
190 | |
191 | See http://www.perl.com/perl/misc/Artistic.html |
192 | |
193 | =head1 SEE ALSO |
194 | |
195 | PadWalker (for the similar idea with lexicals), Hook::LexWrap, |
196 | Tcl's uplevel() at http://www.scriptics.com/man/tcl8.4/TclCmd/uplevel.htm |
197 | |