git.maemo.org Git - pkg-perl/blob - deb-src/libsub-uplevel-perl/libsub-uplevel-perl-0.1901/lib/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.1901
  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
  67 =begin _private
  68
  69 So it has to work like this:
  70
  71     Call stack               Actual     uplevel 1
  72 CORE::GLOBAL::caller
  73 Carp::short_error_loc           0
  74 Carp::shortmess_heavy           1           0
  75 Carp::croak                     2           1
  76 try_croak                       3           2
  77 uplevel                         4
  78 function_that_called_uplevel    5
  79 caller_we_want_to_see           6           3
  80 its_caller                      7           4
  81
  82 So when caller(X) winds up below uplevel(), it only has to use
  83 CORE::caller(X+1) (to skip CORE::GLOBAL::caller).  But when caller(X)
  84 winds up no or above uplevel(), it's CORE::caller(X+1+uplevel+1).
  85
  86 Which means I'm probably going to have to do something nasty like walk
  87 up the call stack on each caller() to see if I'm going to wind up
  88 before or after Sub::Uplevel::uplevel().
  89
  90 =end _private
  91
  92 =begin _dagolden
  93
  94 I found the description above a bit confusing.  Instead, this is the logic
  95 that I found clearer when CORE::GLOBAL::caller is invoked and we have to
  96 walk up the call stack:
  97
  98 * if searching up to the requested height in the real call stack doesn't find
  99 a call to uplevel, then we can return the result at that height in the
 100 call stack
 101
 102 * if we find a call to uplevel, we need to keep searching upwards beyond the
 103 requested height at least by the amount of upleveling requested for that
 104 call to uplevel (from the Up_Frames stack set during the uplevel call)
 105
 106 * additionally, we need to hide the uplevel subroutine call, too, so we search
 107 upwards one more level for each call to uplevel
 108
 109 * when we've reached the top of the search, we want to return that frame
 110 in the call stack, i.e. the requested height plus any uplevel adjustments
 111 found during the search
 112
 113 =end _dagolden
 114
 115 =back
 116
 117 =head1 EXAMPLE
 118
 119 The main reason I wrote this module is so I could write wrappers
 120 around functions and they wouldn't be aware they've been wrapped.
 121
 122     use Sub::Uplevel;
 123
 124     my $original_foo = \&foo;
 125
 126     *foo = sub {
 127         my @output = uplevel 1, $original_foo;
 128         print "foo() returned:  @output";
 129         return @output;
 130     };
 131
 132 If this code frightens you B<you should not use this module.>
 133
 134
 135 =head1 BUGS and CAVEATS
 136
 137 Well, the bad news is uplevel() is about 5 times slower than a normal
 138 function call.  XS implementation anyone?
 139
 140 Sub::Uplevel overrides CORE::GLOBAL::caller temporarily for the scope of
 141 each uplevel call.  It does its best to work with any previously existing
 142 CORE::GLOBAL::caller (both when Sub::Uplevel is first loaded and within
 143 each uplevel call) such as from Contextual::Return or Hook::LexWrap.
 144
 145 However, if you are routinely using multiple modules that override
 146 CORE::GLOBAL::caller, you are probably asking for trouble.
 147
 148 =head1 HISTORY
 149
 150 Those who do not learn from HISTORY are doomed to repeat it.
 151
 152 The lesson here is simple:  Don't sit next to a Tcl programmer at the
 153 dinner table.
 154
 155 =head1 THANKS
 156
 157 Thanks to Brent Welch, Damian Conway and Robin Houston.
 158
 159 =head1 AUTHORS
 160
 161 David A Golden E<lt>dagolden@cpan.orgE<gt> (current maintainer)
 162
 163 Michael G Schwern E<lt>schwern@pobox.comE<gt> (original author)
 164
 165 =head1 LICENSE
 166
 167 Original code Copyright (c) 2001 to 2007 by Michael G Schwern.
 168 Additional code Copyright (c) 2006 to 2008 by David A Golden.
 169
 170 This program is free software; you can redistribute it and/or modify it
 171 under the same terms as Perl itself.
 172
 173 See http://www.perl.com/perl/misc/Artistic.html
 174
 175 =head1 SEE ALSO
 176
 177 PadWalker (for the similar idea with lexicals), Hook::LexWrap,
 178 Tcl's uplevel() at http://www.scriptics.com/man/tcl8.4/TclCmd/uplevel.htm
 179