BEGIN{die "No. You should not be using this code.";} package YAPE::Regex::EvilPatch; use YAPE::Regex (); use B qw(svref_2object); use Devel::Pointer qw(unsmash_sv unsmash_hv); use B::Deparse (); sub patch { return if $_[0]->{'pat'} or %YAPE::Regex::pat; my $var; # Copy the lexicals into globals. Also throw away the # compiled versions of all of the regular expressions. $var = fetch_pad_var( \ &YAPE::Regex::_ok_class, '$valid_POSIX' ); $YAPE::Regex::valid_POSIX = ''.unsmash_sv( $$var ); $var = fetch_pad_var( \ &YAPE::Regex::_ok_class, '$ok_cc_REx' ); $YAPE::Regex::ok_cc_REx = ''.unsmash_sv( $$var ); $var = fetch_pad_var( \&YAPE::Regex::next, '%pat' ); %YAPE::Regex::pat = map "$_", %{unsmash_hv( $$var )}; my $deparse = B::Deparse->new; # Patch the ->new method so it copies %YAPE::Regex::pat my $new_m = $deparse->coderef2text( \ &YAPE::Regex::new ); $new_m =~ s/(?<=bless\({)/'PAT', {%pat},/ or die "Couldn't add PAT to new"; $new_m = "sub $new_m;"; *YAPE::Regex::new = eval $new_m; # Alter ->next so it fetches from $self->{'PAT'} my $next = $deparse->coderef2text(\&YAPE::Regex::next); $next =~ s/(?<=\$)pat(?=\{)/self->{'PAT'}/g; *YAPE::Regex::next = eval "sub $next;"; # Same thin for ->_get_quant my $quant = $deparse->coderef2text(\ &YAPE::Regex::_get_quant); $quant =~ s/(?<=\$)pat(?=\{)/self->{'PAT'}/g; *YAPE::Regex::_get_quant = eval "sub $quant"; # _ok_class uses all three lexicals. Same deal. } sub fetch_pad_var { my $cv = shift; my $var = shift; my $ocv = svref_2object( $cv ); my ($names, $values) = map [ $_->ARRAY ], $ocv->PADLIST->ARRAY; my $h; for my $i (0 .. $#$names) { if ( $names->[$i]->can('PV') and $names->[$i]->PV eq $var ) { return $values->[$i]; } } return (); }