I thought I had this working earlier today, did something else for a while, then when I came back to it found that the call in the replacement sub is calling itself. The code below demonstrates the problm:

use strict;
use warnings;

use Test::More tests => 1;

my $new;

BEGIN {
    require MIME::Lite;
    $new = MIME::Lite->can ("new");
    undef &MIME::Lite::new;
}

sub MIME::Lite::new {
    print "Validating MIME::Lite::new params\n";
    #goto $new;
    #return $new->(@_);
    return &$new;
}


ok (checkSub (), 'Match existing path');


sub checkSub {
    my $msg = MIME::Lite->new ((To => 'to', ));
    my $result = eval {$msg->send};
}
[download]

For my current tests it's not essential that the original code be called so I can simply return a success value. However that will not always be appropriate. Any idea what I am doing wrong?

None of the "return" variants affect the behaviour.

I'm not 100% sure I can explain what's going on, but the good news is that it's easily fixed. :)

use strict;
use warnings;

use Test::More tests => 1;

my $new;

BEGIN {
    require MIME::Lite;
    $new = MIME::Lite->can ("new");
    no warnings 'redefine';
    *MIME::Lite::new = \&MIME_Lite_new_wrapper;
}

sub MIME_Lite_new_wrapper {
    print "Validating MIME::Lite::new params\n";
    goto $new;
}

ok (checkSub (), 'Match existing path');

sub checkSub {
    my $msg = MIME::Lite->new ((To => 'to', ));
    my $result = eval {$msg->send};
}
[download]

In your original code, you're redefining MIME::Lite::new(). I'm leaving that function alone, creating a new function, MIME_LITE_new_wrapper(), and then updating the symbol table (*MIME::Lite::new{CODE}) to point to my function. In that way, perl doesn't redefine MIME::Lite::new() to your local sub.

I don't know enough about the perl guts to understand why the reference to the original in $new isn't sufficient to maintain the original code definition.

Perhaps someone with more of a clue can chime in. Most of my knowledge of this stuff is cobbled together from perldoc perlref, old posts on c.l.p.m, and looking at the code of various modules that do tricky things with symbol tables.

Cheers,

Thank you. That is exactly the sort of solution I was looking for.

Since this is a test module, it may be better to use a goto, rather than just making the call to the old method. If the test module is also testing error conditions that generate messages with any sort of stack trace, then just using return could cause those tests to fail.

How about some sample code? While I understand tye's sample, I fail to see how I can replace return $new->( @_ }; with a goto to accomplish the same result. How would the following change?

sub MIME::Lite::new {
    my ($self, %params) = @_;

    ok (exists $params{To}, 'To address present');
    ok ($params{To} eq 'wibble@wobble', 'To address correct');
    ...
    return $new->( @_ );
}
[download]

---

DWIM is Perl's answer to Gödel

It wouldn't change much:

sub MIME::Lite::new {
    my ($self, %params) = @_;
    ok (exists $params{To}, 'To address present');
    ok ($params{To} eq 'wibble@wobble', 'To address correct');
    ...
    goto $new;   # <--------------
}
[download]

You'd be making use of the goto &NAME functionality (see perldoc -f goto), where your wrapper for Mime::Lite::new() gets replaced on the call stack with the real Mime::Lite::new, which was saved in $new. The goto-ed function is called with the contents of @_. According to the perldoc:

    After the "goto", not even "caller" will be able to
    tell that this routine was called first.
[download]

The consequence of using goto makes your wrapper function, which does the testing, invisible to the script being tested. That reduces the possibility where addition of a wrapper function inadvertantly causes a bug (that only manifests itself while running under the test-suite, making it harder to find), or causes a test to fail that wouldn't otherwise fail.

Does that clarify things?

Cheers,