Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Using delete package::{subroutine} to change resolution of subroutines

by pjf (Curate)
on Jun 22, 2008 at 05:09 UTC ( #693338=perlquestion: print w/ replies, xml ) Need Help??
pjf has asked for the wisdom of the Perl Monks concerning the following question:

Most learned monks,

I'm currently working on my port of autodie (a lexical pragma for do-or-die semantics) to Perl 5.8. I've got a rather clever trick that allows me to change how perl resolves subroutines, but I'm starting to hit problems with its scalability.

The trick looks like this:

use strict; open(my $fh, '<', $0); # Calls CORE::open BEGIN { *{main::open} = sub { print "Hi\n"; }; use subs 'open'; } open(my $fh2, '<', $0); # Prints Hi BEGIN { delete $main::{open}; } BEGIN { *{main::open} = sub { print "Ho\n"; }; use subs 'open'; } open(my $fh4, '<', $0); # Prints Ho! BEGIN { delete $main::{open}; } open(my $fh5, '<', $0); # Calls CORE::open __END__ Hi Ho

The code above works wonderfully, and maps very well to what I'm doing in autodie when I'm either inserting a subroutine, or deleting a subroutine.

Where it fails is when I'm trying to replace a subroutine that's already there. The reason is that each use of autodie maps to a single BEGIN block, and merging the two middle BEGIN blocks causes the trick to fail:

use strict; open(my $fh, '<', $0); # Calls CORE::open BEGIN { *{main::open} = sub { print "Hi\n"; }; use subs 'open'; } open(my $fh2, '<', $0); # Prints Hi BEGIN { # Deleting and remaking the sub fails! ;( delete $main::{open}; *{main::open} = sub { print "Ho\n"; }; use subs 'open'; } open(my $fh4, '<', $0); # Prints Ho! BEGIN { delete $main::{open}; } open(my $fh5, '<', $0); # Calls CORE::open __END__ Ambiguous use of *{main::open} resolved to *main::open at examples/bla +ck-magic.pl line 17. Subroutine main::open redefined at examples/black-magic.pl line 17. Ho

Unfortunately for me, this means that any operation that needs to replace a subroutine fails, since that involves a delete and an insert. Note that just trying to replace the sub without the magic delete trick doesn't help (Perl never resolves to the first sub declared).

Nesting the BEGIN blocks works fine, but isn't useful for my purposes, since I'm playing with subroutine resolution at every import(), and a BEGIN inside my import() will only run once.

So, does anyone have a trick, that works on Perl 5.8, which allows a subroutine to be replaced with limited scope (as per my first example), but involves only a single BEGIN to do that replacement? This isn't something which comes up every day. ;)

For those interested in learning more about autodie, I've been blogging about it, as well as having made a lightning talk about the idea. The code on CPAN currently works for all my core criteria, but it's the edges cases that are giving me the biggest headaches.

Many many thanks in advance for all your help,

Comment on Using delete package::{subroutine} to change resolution of subroutines
Select or Download Code
Re: Using delete package::{subroutine} to change resolution of subroutines
by ikegami (Pope) on Jun 22, 2008 at 06:56 UTC

    Two problems.

    • First, as the warning indicates, the main::open in

      *{main::open} = sub { print "Ho\n"; };

      is interpreted as a call to open. (Upd: Not sure how it's being interpreted anymore, but it's definitely not working as expected. ) You want

      my $glob_ref = do { no strict 'refs'; \*{'main::open'} }; *$glob_ref = sub { print "Ho\n"; };
    • Second, you delude yourself by putting the use subs at the bottom.

      BEGIN { # Deleting and remaking the sub fails! ;( delete $main::{open}; *{main::open} = sub { print "Ho\n"; }; use subs 'open'; }

      means

      BEGIN { # Deleting and remaking the sub fails! ;( delete $main::{open}; *{main::open} = sub { print "Ho\n"; }; BEGIN { require subs; import subs 'open'; } }

      which is compiled and executed as follows:

      1. "delete $main::{open};" is compiled.
      2. "*{main::open} = sub { print "Ho\n"; };" is compiled.
      3. "require subs;" is compiled.
      4. "import subs 'open';" is compiled.
      5. "require subs;" is executed. (The inner BEGIN is executed as soon as it's compiled.)
      6. "import subs 'open';" is executed.
      7. "delete $main::{open};" is executed. (The outer BEGIN is executed as soon as it's compiled.)
      8. "*{main::open} = sub { print "Ho\n"; };" is executed.

      "import subs 'open';" should not be executed before "delete $main::{open};".

    Fixed:

    use strict; use warnings; use subs qw( ); open(my $fh, '<', $0); # Calls CORE::open BEGIN { my $glob = do { no strict 'refs'; \*{'main::open'} }; *$glob = sub { print "Hi\n"; }; import subs 'open'; } open(my $fh2, '<', $0); # Prints Hi BEGIN { delete $main::{open}; my $glob = do { no strict 'refs'; \*{'main::open'} }; *$glob = sub { print "Ho\n"; }; import subs 'open'; } open(my $fh4, '<', $0); # Prints Ho BEGIN { delete $main::{open}; } open(my $fh5, '<', $0); # Calls CORE::open
Re: Using delete package::{subroutine} to change resolution of subroutines
by ikegami (Pope) on Jun 22, 2008 at 07:30 UTC

    By the way, if that BEGIN block will end up being use statement, use subs is not needed. For example,

    override.pm:

    use strict; use warnings; package override; sub import { my ($class, $sub_name, $sub) = @_; my $pkg_name = caller(); my $pkg_sym = _pkg_symtab($pkg_name); delete $pkg_sym->{$sub_name}; if ($sub) { no strict 'refs'; *{"${pkg_name}::$sub_name"} = $sub; } } sub _pkg_symtab { my ($pkg) = @_; my $p = \%::; $p = $p->{"${_}::"} for split /::/, $pkg; return $p; } 1;

    test.pl:

    use strict; use warnings; open(my $fh, '<', $0); # Calls CORE::open use override open => sub { print "Hi\n"; }; open(my $fh2, '<', $0); # Prints Hi use override open => sub { print "Ho\n"; }; open(my $fh4, '<', $0); # Prints Ho use override open => undef; open(my $fh5, '<', $0); # Calls CORE::open

    Output:

    >perl test.pl Hi Ho

    From there, I guess the idea is to make overrideautodie a lexical pragma. Shouldn't be too hard.

      ikegami, I cannot begin to express just how happy you've made me. Having simple, elegant, and understandable code that solves a problem that I've been beating my head against for days is stunningly good.

      You've been added with an appropriate attribution to the AUTHORS file, and you can expect a future release of autodie to be named in your honour. ;)

      Really, you rock. Thank-you so much for taking the time to show me a solution, it's exactly what I've been trying (and failing) to do.

      Yours most humbly,

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://693338]
Approved by pc88mxer
Front-paged by grinder
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (13)
As of 2014-10-22 13:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (118 votes), past polls