#1 Alter YAPE::Regex so it is extension friendly
This would store %pat in the YAPE::Regex object which directly exposes it to modification. This is the best solution but it requires japhy's cooperation if I want to avoid forking the source. (and I'd need to modify a method but that's unrelated to this post).

#2 Use PadWalker
This doesn't work because PadWalker doesn't actually dig out lexicals taken in closures and only really exposes lexicals created in the subroutine. Darn!

use YAPE::Regex;
my $p = YAPE::Regex->new(qr//);
$p->YAPE::Regex::Extensible::steal_pat;

package YAPE::Regex::Extensible;
use base 'YAPE::Regex';
use PadWalker 'peek_sub';
use Data::Dumper;

sub steal_pat {
    my $self = shift;
    $self->{'pat'} = peek_sub(\&YAPE::Regex::next)->{'%pat'};
}
[download]

#3 Grab it via Devel::LexAlias
Oops! This doesn't work either. In fact while PadWalker at least reported the existance of %pat, Devel::LexAlias doesn't even do that.

use YAPE::Regex;
my $p = YAPE::Regex->new(qr//);
$p->YAPE::Regex::Extensible::steal_pat;

package YAPE::Regex::Extensible;
use base 'YAPE::Regex';
use Devel::LexAlias 'lexalias';

sub steal_pat {
    my $self = shift;
    $self->{'pat'} = {};
    lexalias(\&YAPE::Regex::next, '%pat', $self->{'pat'});
}
[download]

#4 Be really evil and muck around with B and Devel::Pointer
Now this works but its exceedingly ugly and I can't help but think that there has got to be a better way than manually trolling around a pad for pointers.

use YAPE::Regex;
my $p = YAPE::Regex->new(qr//);
$p->YAPE::Regex::Extensible::steal_pat;

package YAPE::Regex::Extensible;
use base 'YAPE::Regex';
use B qw(svref_2object);
use Devel::Pointer;

sub steal_pat {
    my $self = shift;
    $self->{'pat'} = {};

    my $sub = \&YAPE::Regex::next;
    my $osub = svref_2object( $sub );

    # Unpack next()'s pad list into an array of names and values.
    my ($names, $values) = map [ $_->ARRAY ], $osub->PADLIST->ARRAY;

    # Fetch the first HV associated with the name '%pat'
    my $h;
    for my $i (0 .. $#$names) {
        if ( $names->[$i]->can('PV') and
             $names->[$i]->PV eq '%pat') {
            $h = $values->[$i];
            last;
        }
    }

    # $$h is the address of the hash
    # Use Devel::Pointer to construct a reference to it.
    $self->{'pat'} = unsmash_hv( $$h );
}
[download]