local-lib5/lib/perl5/Sub/Uplevel.pod

   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