view release on metacpan or  search on metacpan

lib/Sub/Uplevel.pm  view on Meta::CPAN

#pod The main reason I wrote this module is so I could write wrappers
#pod around functions and they wouldn't be aware they've been wrapped.
#pod
#pod     use Sub::Uplevel;
#pod
#pod     my $original_foo = \&foo;
#pod
#pod     *foo = sub {
#pod         my @output = uplevel 1, $original_foo;
#pod         print "foo() returned:  @output";
#pod         return @output;
#pod     };
#pod
#pod If this code frightens you B<you should not use this module.>
#pod
#pod
#pod =head1 BUGS and CAVEATS
#pod
#pod Well, the bad news is uplevel() is about 5 times slower than a normal
#pod function call.  XS implementation anyone?  It also slows down every invocation
#pod of caller(), regardless of whether uplevel() is in effect.
#pod
#pod Sub::Uplevel overrides CORE::GLOBAL::caller temporarily for the scope of
#pod each uplevel call.  It does its best to work with any previously existing
#pod CORE::GLOBAL::caller (both when Sub::Uplevel is first loaded and within 
#pod each uplevel call) such as from Contextual::Return or Hook::LexWrap.  
#pod
#pod However, if you are routinely using multiple modules that override 
#pod CORE::GLOBAL::caller, you are probably asking for trouble.
#pod
#pod You B<should> load Sub::Uplevel as early as possible within your program.  As
#pod with all CORE::GLOBAL overloading, the overload will not affect modules that
#pod have already been compiled prior to the overload.  One module that often is
#pod unavoidably loaded prior to Sub::Uplevel is Exporter.  To forcibly recompile
#pod Exporter (and Exporter::Heavy) after loading Sub::Uplevel, use it with the
#pod ":aggressive" tag:
#pod
#pod     use Sub::Uplevel qw/:aggressive/;
#pod
#pod The private function C<Sub::Uplevel::_force_reload()> may be passed a list of
#pod additional modules to reload if ":aggressive" is not aggressive enough.  
#pod Reloading modules may break things, so only use this as a last resort.
#pod
#pod As of version 0.20, Sub::Uplevel requires Perl 5.6 or greater.
#pod
#pod =head1 HISTORY
#pod
#pod Those who do not learn from HISTORY are doomed to repeat it.
#pod
#pod The lesson here is simple:  Don't sit next to a Tcl programmer at the
#pod dinner table.
#pod
#pod =head1 THANKS
#pod
#pod Thanks to Brent Welch, Damian Conway and Robin Houston.
#pod
#pod See http://www.perl.com/perl/misc/Artistic.html
#pod
#pod =head1 SEE ALSO
#pod
#pod PadWalker (for the similar idea with lexicals), Hook::LexWrap, 
#pod Tcl's uplevel() at http://www.scriptics.com/man/tcl8.4/TclCmd/uplevel.htm
#pod
#pod =cut

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Sub::Uplevel - apparently run a function in a higher stack frame

=head1 VERSION

version 0.2800

=head1 SYNOPSIS

  use Sub::Uplevel;

  sub foo {
      print join " - ", caller;
  }

  sub bar {
      uplevel 1, \&foo;
  }

  #line 11
  bar();    # main - foo.plx - 11

=head1 DESCRIPTION

Like Tcl's uplevel() function, but not quite so dangerous.  The idea
is just to fool caller().  All the really naughty bits of Tcl's
uplevel() are avoided.

B<THIS IS NOT THE SORT OF THING YOU WANT TO DO EVERYDAY>

=over 4

=item B<uplevel>

  uplevel $num_frames, \&func, @args;

Makes the given function think it's being executed $num_frames higher
than the current stack level.  So when they use caller($frames) it
will actually give caller($frames + $num_frames) for them.

C<uplevel(1, \&some_func, @_)> is effectively C<goto &some_func> but
you don't immediately exit the current subroutine.  So while you can't
do this:

    sub wrapper {
        print "Before\n";
        goto &some_func;

lib/Sub/Uplevel.pm  view on Meta::CPAN

The main reason I wrote this module is so I could write wrappers
around functions and they wouldn't be aware they've been wrapped.

    use Sub::Uplevel;

    my $original_foo = \&foo;

    *foo = sub {
        my @output = uplevel 1, $original_foo;
        print "foo() returned:  @output";
        return @output;
    };

If this code frightens you B<you should not use this module.>

=head1 BUGS and CAVEATS

Well, the bad news is uplevel() is about 5 times slower than a normal
function call.  XS implementation anyone?  It also slows down every invocation
of caller(), regardless of whether uplevel() is in effect.

Sub::Uplevel overrides CORE::GLOBAL::caller temporarily for the scope of
each uplevel call.  It does its best to work with any previously existing
CORE::GLOBAL::caller (both when Sub::Uplevel is first loaded and within 
each uplevel call) such as from Contextual::Return or Hook::LexWrap.  

However, if you are routinely using multiple modules that override 
CORE::GLOBAL::caller, you are probably asking for trouble.

You B<should> load Sub::Uplevel as early as possible within your program.  As
with all CORE::GLOBAL overloading, the overload will not affect modules that
have already been compiled prior to the overload.  One module that often is
unavoidably loaded prior to Sub::Uplevel is Exporter.  To forcibly recompile
Exporter (and Exporter::Heavy) after loading Sub::Uplevel, use it with the
":aggressive" tag:

    use Sub::Uplevel qw/:aggressive/;

The private function C<Sub::Uplevel::_force_reload()> may be passed a list of
additional modules to reload if ":aggressive" is not aggressive enough.  
Reloading modules may break things, so only use this as a last resort.

As of version 0.20, Sub::Uplevel requires Perl 5.6 or greater.

=head1 HISTORY

Those who do not learn from HISTORY are doomed to repeat it.

The lesson here is simple:  Don't sit next to a Tcl programmer at the
dinner table.

=head1 THANKS

Thanks to Brent Welch, Damian Conway and Robin Houston.

See http://www.perl.com/perl/misc/Artistic.html

=head1 SEE ALSO

PadWalker (for the similar idea with lexicals), Hook::LexWrap, 
Tcl's uplevel() at http://www.scriptics.com/man/tcl8.4/TclCmd/uplevel.htm

=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan

=head1 SUPPORT

=head2 Bugs / Feature Requests

Please report any bugs or feature requests through the issue tracker
at L<https://github.com/Perl-Toolchain-Gang/Sub-Uplevel/issues>.
You will be notified automatically of any progress on your issue.

=head2 Source Code

This is open source software.  The code repository is available for
public review and contribution under the terms of the license.

L<https://github.com/Perl-Toolchain-Gang/Sub-Uplevel>

  git clone https://github.com/Perl-Toolchain-Gang/Sub-Uplevel.git

=head1 AUTHORS

=over 4

=item *

Michael Schwern <mschwern@cpan.org>

=item *

David Golden <dagolden@cpan.org>

=back

=head1 CONTRIBUTORS

=for stopwords Adam Kennedy Alexandr Ciornii David Golden Graham Ollis J. Nick Koston Michael Gray

=over 4

=item *

Adam Kennedy <adamk@cpan.org>

=item *

Alexandr Ciornii <alexchorny@gmail.com>

=item *

David Golden <xdg@xdg.me>

=item *

Graham Ollis <plicease@cpan.org>

=item *

J. Nick Koston <nick@cpanel.net>