Module Modification at Runtime

[diotalevi]

This is a seriously scary technique and you shouldn't use this for things that even pretend to require sanity. The idea is that instead of following code through the perl debugger or subclassing an OO module you just alter the function/method without touching the original source. I used this when doing some debugging regarding luke_repwalker.pl and HTML::TableExtract. I figured it was too much trouble to subclass HTML::TableExtract or do anything that required actual work so like a good perl hacker I did some lateral thinking and just taught the script to modify the code it was about to use.

Plan ahead I intend to add some debugging code to HTML::TableExtract::TableState::_taste_text and override HTML::TableExtract's exception handler (I discovered that it traps any die() calls somewhere and doesn't report them). All I want to do here is eval the guts of the subroutine as a block and check $@ afterward. I'm also adding some print() calls into the routine so I can debug some conditional code I've got questions about.

Deparse the method This is a simple oneline routine that deparses a single subroutine.

perl -MB::Deparse \
     -MHTML::TableExtract \
     -le 'print B::Deparse->new->coderef2text(\&HTML::TableExtract::Ta
+bleState::_taste_text)'

{
    package HTML::TableExtract::TableState;
    my($self, $text) = @_;
    my $sc = $self->_skew;
    if ($self->_terminus_trigger and $self->_column_wanted or $$self{'
+umbrella'}) {
        if (defined $text) {
            print STDERR "Add text '$text'\n" if $$self{'debug'} > 3;
            $self->_add_text($text, $sc);
        }
    }
    if (defined $text and $self->_any_headers and not $self->_any_htri
+gger) {
        $self->_htxt($text);
    }
    1;
}

Alter the source Assume for the moment that I've just captured the method to a variable $source_code. I'd like to wrap the entire method in an eval block like eval { ... }; print STDERR $@ if $@;die $@;. This is a simple text manipulation: $source_code = "eval { $source_code }; print STDERR $@ if $@; die $@;";. Now to add my debugging code after the assignment to $self.

$source_code =~ s/(\$self.*)$/$1

    print "skew: ".\$self->_skew."\\n"
        . "_terminus_trigger: ".\$self->_terminus_trigger."\\n"
        . "_column_wanted: ".\$self->_column_wanted."\\n"
        . "umbrella: \$\$self{'umbrella'}\\n"
        . "text: q[\$text]\\n";\n/ or die "Source patch failed";

Install the new codeThat'll add in some print statements to the next line after $self is first mentioned. From here the source is read to generate a new subroutine which is copied into the symbol table in the right place. My installation code is careful to check that eval worked because otherwise there's a bug in the source-altering section.

*HTML::TableExtract::TableState::_taste_text =
    eval "sub { package Package::Name; $source_code };" or die "Eval o
+f \$source_code failed: $@";

From here I just use the program like I normally do except that now I get some diagnostic output back and at a minimum of effort. Here's the complete patching code.

use B::Deparse ();

{   # Fetch the original source code
    my $source_code = B::Deparse->new->coderef2text( \&HTML::TableExtr
+act::TableState::_taste_text );

    # Alter the source to include error trapping and the diagnostics
    $source_code = 'eval { ' . $source_code . ' }; print STDERR $@ if 
+$@; die $@;';
    $source_code =~ s/(\$self.*)$/$1

    print "skew: ".\$self->_skew."\\n"
        . "_terminus_trigger: ".\$self->_terminus_trigger."\\n"
        . "_column_wanted: ".\$self->_column_wanted."\\n"
        . "umbrella: \$\$self{'umbrella'}\\n"
        . "text: q[\$text]\\n";\n/ or die "Source patch failed";

    # (updated - added a package declaration per 'theorbtwo')
    # Create and assign the new method into place.
    *HTML::TableExtract::TableState::_taste_test =
        eval "sub { package HTML::TableExtract::TableState; $source_co
+de; };"
            or die "Eval of \$source_code failed: $@\n$source_code";
}

_{Just as an aside, Louis_Wu and PodMaster suggested some alternate titles: "Deparse+eval: poking in the dark and hoping it all works out", "What's with all this B::Deparse stuff?" and "I want to be Damian Jr.".}

[adrianh]

Not that I don't admire the evilness of the technique, but wouldn't it be easier to do something like this?

{
    my $old = \&HTML::TableExtract::TableState::_taste_text;
    no warnings;
    *HTML::TableExtract::TableState::_taste_text = sub {
        local *HTML::TableExtract::TableState::_taste_text = $old;
        eval { shift->_taste_text(@_) }; 
        print STDERR $@ if $@; die $@;
    };
};

This would only fall down if _taste_text depended on the state of the call stack (which you could get around with Sub::Uplevel), or does different things if not called as a method (which you could get around with called_as_method from Devel::Caller).

[diotalevi]

When I was debugging the code I was inserting my code into the middle. Its only for this write-up that I move the inserted code to the ends. So it was right after ->_skew and right before the tests regarding ->_terminus and ->_column. I've also done your wrapper code as well but at the time I didn't want to copy/paste code all over the place.