comment on

Hello monks. I have a testing problem I'm trying to sort out. So I'm doing a high level test of my code, and I'm using a sqlite database to fake some database accesses. However, I need one of my modules to be able to access the real database.

Database is accessed through a handle class DB::Handle::RapTTR::Test and is accessed at many points in the code. The constructor for the real db handle is DB::Handle::RapTTR::Test->new. My plan was to do this in my test file (where RapTTR is the package needing access to the real db handle):

# added some debug output
*DB::Handle::RapTTR::Test::real_new = \&DB::Handle::RapTTR::Test::new;
*DB::Handle::RapTTR::Test::new =
  sub {
      print STDERR "CALLER (".join(',',caller()).")\n";
      if (caller() eq 'RapTTR') {
          print STDERR "RETURNING REAL_NEW.\n"; <STDIN>;
          return DB::Handle::RapTTR::Test->real_new;
      }

      print STDERR "RETURNING FAKE NEW.\n"; <STDIN>;
      cluck "TRACE:";
      return DB::Handle->new(
          connect_string => 'DBI:SQLite:dbname=./t/sqlite/rapttr',
          username => undef,
          password => undef
      );
  };
[download]

However, I'm finding that the call DB::Handle::RapTTR::Test->real_new is recursing back into this defined DB::Handle::RapTTR::Test::new subroutine. This is the output:

TRACE: at t/comprehensive_3digbn_8digtid.t line 54
        main::__ANON__('DB::Handle::RapTTR::Test') called at t/compreh
+ensive_3digbn_8digtid.t line 50
        main::__ANON__('DB::Handle::RapTTR::Test') called at /nfs/pdx/
+disks/nehalem.pde.077/projects/2.0_rapttr/RapTTR/blib/lib/RapTTR.pm l
+ine 688
        RapTTR::download_pcd_revision('RapTTR=HASH(0x26931a0)') called
+ at /nfs/pdx/disks/nehalem.pde.077/projects/2.0_rapttr/RapTTR/blib/li
+b/RapTTR.pm line 100
        RapTTR::harness('RapTTR=HASH(0x26931a0)') called at t/comprehe
+nsive_3digbn_8digtid.t line 63
DBD::SQLite::db prepare failed: no such table: pcf_master at /nfs/pdx/
+disks/nehalem.pde.077/perl/5.12.2/lib64/site_perl/DB/Handle.pm line 1
+65, <STDIN> line 2.
prepare failed with DBI error (1):no such table: pcf_master
 at /nfs/pdx/disks/nehalem.pde.077/perl/5.12.2/lib64/site_perl/DB/SQL/
+Query.pm line 114
        DB::SQL::Query::_prepare('DB::SQL::Query=HASH(0x29fa520)', 'DB
+::Handle=HASH(0x29fecf0)', 'SELECT job_name FROM pcf_master \x{a}WHER
+E revision = ?\x{a}') called at /nfs/pdx/disks/nehalem.pde.077/perl/5
+.12.2/lib64/site_perl/DB/SQL/Query.pm line 131
        DB::SQL::Query::_init_sth('DB::SQL::Query=HASH(0x29fa520)') ca
+lled at accessor sth defined at /nfs/pdx/disks/nehalem.pde.077/perl/5
+.12.2/lib64/site_perl/DB/SQL/Query.pm line 57
        DB::SQL::Query::sth('DB::SQL::Query=HASH(0x29fa520)') called a
+t /nfs/pdx/disks/nehalem.pde.077/perl/5.12.2/lib64/site_perl/DB/SQL/Q
+uery.pm line 85
        DB::SQL::Query::execute('DB::SQL::Query=HASH(0x29fa520)', 216)
+ called at /nfs/pdx/disks/nehalem.pde.077/projects/2.0_rapttr/RapTTR/
+blib/lib/RapTTR/Utils.pm line 571
        RapTTR::Utils::get_rapttr_db_data('Job Name', 'DB::Handle=HASH
+(0x29fecf0)', 'SELECT job_name FROM pcf_master \x{a}WHERE revision = 
+?\x{a}', 216) called at /nfs/pdx/disks/nehalem.pde.077/projects/2.0_r
+apttr/RapTTR/blib/lib/RapTTR.pm line 699
        RapTTR::download_pcd_revision('RapTTR=HASH(0x26931a0)') called
+ at /nfs/pdx/disks/nehalem.pde.077/projects/2.0_rapttr/RapTTR/blib/li
+b/RapTTR.pm line 100
        RapTTR::harness('RapTTR=HASH(0x26931a0)') called at t/comprehe
+nsive_3digbn_8digtid.t line 63
# Looks like you planned 24 tests but ran 2.
# Looks like your test exited with 2 just after 2.
[download]

So here is where it fails to find a table because it's accessing the sqlite db instead of the real one:

prepare failed with DBI error (1):no such table: pcf_master
 at /nfs/pdx/disks/nehalem.pde.077/perl/5.12.2/lib64/site_perl/DB/SQL/
+Query.pm line 114
[download]

and here is where it's calling back into itself on the callstack, where the original call comes from RapTTR.pm line 688 and the recursive call from the test file at line 50:

main::__ANON__('DB::Handle::RapTTR::Test') called at t/comprehensive_3
+digbn_8digtid.t line 50
        main::__ANON__('DB::Handle::RapTTR::Test') called at /nfs/pdx/
+disks/nehalem.pde.077/projects/2.0_rapttr/RapTTR/blib/lib/RapTTR.pm l
+ine 688
[download]

So it calls into the new redefined new from the RapTTR package. It then tries to get the real db handle, but ends up recursing back into itself. It then sees that it was not called from RapTTR any more, but from main in the test file, and returns the fake db handle. The code then fails with the wrong db handle.

I wrote up some short test code, and it seems to verify that you can save the original subroutine like I am and access the real subroutine from inside the faked subroutine:

use strict;
use warnings;

use lib 'C:\scripts';

package Foo;

sub bar {
    print "I am bar from Foo.\n";
}

package main;

no warnings 'redefine';
*Foo::real_bar = \&Foo::bar;
*Foo::bar = sub {
    print "I am bar NEW!\n";
    Foo->real_bar;
    *Foo::bar = \&Foo::real_bar;
};
&print_stuff;

sub print_stuff {
    &print_bar1;
    &print_bar2;
}

sub print_bar1 {
    Foo->bar;
}

sub print_bar2 {
    Foo->bar;
}

####################
OUTPUT:
plxc16479> $h2/scripts/tmp.pl
 # output from redefined sub
I am bar NEW!
 # output from original sub called from inside redefined sub
I am bar from Foo.
 # output from original sub after being redefined back
I am bar from Foo.
[download]

I don't see the recursing happening here. I am uncertain as to why the difference, but I'm guessing it has something to do with RapTTR being a Moose module and the way the new method is created for it.

So my actual questions: 1) what's going on here? 2) is there a better way to do what I'm trying to do?

As always, thanks for the time and I appreciate any and all insight!

UPDATE: As suggested by the kind anonymous monk below, I made a focused Moose based test case and do see the same problem there. Here is the Moose case:

#! /usr/intel/pkgs/perl/5.12.2/bin/perl
use strict;
use warnings;

package Foo;
use Moose;

package FakeFoo;
use Moose;

package main;

no warnings 'redefine';
*Foo::real_new = \&Foo::new;
*Foo::new = sub {
    if (caller() eq 'Bar') {
        print "Returning real Foo.\n";
        return Foo->real_new;
    }
    print "Returning fake Foo.\n";
    return FakeFoo->new;
};

my $obj = Foo->new;
print STDERR __PACKAGE__.": FOO IS (".ref($obj).")\n";

package Bar;

$obj = Foo->new;
print STDERR __PACKAGE__.": FOO IS (".ref($obj).")\n";

package Other;

$obj = Foo->new;
print STDERR __PACKAGE__.": FOO IS (".ref($obj).")\n";
[download]

I should see a real Foo for the package Bar Foo object, but I instead see the call recurse and return a FakeFoo instead.

In reply to Testing -- making a new constructor behave differently for one package by tj_thompson

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


more useful options
	PerlMonks