具有 DB 访问权限的 perl Test::MockModule

Question

我开始使用 Perl 进行单元测试。这是我的问题：我在 Perl 中有一个类（我正在使用 Moo BTW），并且这个类有 3 个属性（我将把代码放在下面）。其中一个属性是一个数组，它是在构造函数中自动生成的。要生成数组，我需要访问数据库并执行一个查询。

package Customer;
use 5.010;
use Data::Dumper;
use Moo;
use TT::SQL;

has id => (
  is=>'ro',
  required=>1,
);

has type => (
  is=>'ro',
);

has emails => (
  is=>'rw',
  default => sub {
     my ($self) = @_;
     return $self->getEmails();
  },
  lazy=> 1,
);

sub getEmails
{               
                my $self=shift;
                #obtaining the DB handler
                my $db2 = $self->get_db_handler();
                my $fmuser=$self->id;
                my $type=$self->type;
                my $query;
                #checking the customer type to perform the query
                if ($type eq "tshop")
                {
                $query="SELECT email from XXXXXXX WHERE XXXXX=? and XXXXXXXX=1 and XXXXXXX =1'";
                }
                else
                {
                $query="SELECT email from XXXXXXXX WHERE XXXXX=? and XXXXXXXX=1 and XXXXXXX =1";
                }
                my $ref = $db2->execute($query,$fmuser);
                my @emails;
                #retrieving emails
                while ( my $row = $ref->fetchrow_hashref  ) {
                       @emails=(@emails,"$row->{email}\n");
                  }
                return \@emails;
}

sub get_db_handler
{
        my $user = "XXXXXXX";
    my $password = 'XXXXXXX';
    my $host = "XXXXX";
    my $driver = "Pg";
    my $timezone = "America/New_York";

    my $dsn = "DBI:$driver:database=fm;host=$host";
    my $db = DBI->connect($dsn,$user,$password) or die("Cannot connect to the DB !!");
    return $db;

}

1;

现在我想运行单元测试来检查上一个类的行为。到目前为止，我使用 Test::MockModule 作为下一个：

use diagnostics; # this gives you more debugging information
use warnings;    # this warns you of bad practices
use strict;      # this prevents silly errors
use Moo;
use Data::Dumper;
use Test::More tests => 2; # for the is() and isnt() functions
use Customer;
use FindBin qw/$RealBin/;
use Test::Deep;
use Test::MockModule;
use DBI;
my $dbh = DBI->connect("dbi:SQLite:dbname=$RealBin/test-cutomer.db","","") or die $DBI::errstr;
$dbh->do("
CREATE TABLE IF NOT EXISTS table (
    id INTEGER PRIMARY KEY AUTOINCREMENT,
    field1 INTEGER,
    field2 INTEGER,
    field3 TEXT,
    field4 INTEGER,
    field5 INTEGER
)
");

$dbh->do('
        INSERT INTO table (field1,field2,field3,field4,field5) VALUES 
        (?,?,?,?,?)',undef,undef,92,'XXXXXXXX@XXXXXXXXX',1,1
);

END {
    unlink "$RealBin/test-customer.db";
}

{

my $mock = Test::MockModule->new("Customer");
$mock->mock("get_db_handler", sub { return $dbh });

my $customer=Customer->new(id=>92,type=>'other');

ok(defined $customer);
my $e=$customer->emails;
my @emails=@$e;
my $length=@emails;
is($length,1, 'the emails are OK');
}

我想模拟 get_db_handler 方法来检索 test-customer.db 处理程序并在此本地数据库上运行查询。 到目前为止，我收到以下错误：

1..2
ok 1
Can't locate object method "execute" via package "DBI::db" at Customer.pm line
    46 (#1)
    (F) You called a method correctly, and it correctly indicated a package
    functioning as a class, but that package doesn't define that particular
    method, nor does any of its base classes.  See perlobj.

Uncaught exception from user code:
    Can't locate object method "execute" via package "DBI::db" at Customer.pm line 46.
 at Customer.pm line 46
    Customer::getEmails('Customer=HASH(0x11359c8)') called at Customer.pm line 23
    Customer::__ANON__('Customer=HASH(0x11359c8)') called at (eval 23) line 18
    Customer::emails('Customer=HASH(0x11359c8)') called at t/stc.t line 66
# Looks like you planned 2 tests but ran 1.
# Looks like your test exited with 2 just after 1.

脚本运行正常，我的意思是，代码没有问题。 测试有问题。你能看看这个吗？我会很感激的。提前致谢。

Answer 1

您收到该错误的原因是您的生产代码在数据库句柄上调用execute，而不是在语句句柄上。您必须先prepare 查询，然后才能execute 它。

my $sth = $db2->prepare($query);
my $ref = $sth->execute($fmuser);

为您的 DBI 变量使用诸如 $dbh、$sth 和 $res 之类的传统名称将有助于更容易地发现这一点。

---

Test::MockModule 不是您正在做的事情的正确工具。如果您想模拟其他模块中的依赖关系，或者可能只是其中的一部分，这很有用。

但是现在你有一个内部依赖。你想做的是依赖注入，但是你的代码并没有为此做好准备，所以你需要另辟蹊径。

我建议使用Sub::Override 来完成这项工作。这很简单。它覆盖了词法范围内的 sub。这就是你真正需要的。

use Sub::Override;

my $sub = Sub::Override->new('frobnicate' => sub { return 'foo' });

因此，如果您使用它，您的代码将如下所示。请注意，我为第二个测试用例整理了一些行。

use strict;
use warnings;

use Test::More;
use Sub::Override;    # this line is new

use DBI;
use FindBin qw/$RealBin/;

#                                                          typo here
my $dbh = DBI->connect( "dbi:SQLite:dbname=$RealBin/test-customer.db", "", "" )
    or die $DBI::errstr;
$dbh->do(<<'EOSQL');
CREATE TABLE IF NOT EXISTS table (
    id INTEGER PRIMARY KEY AUTOINCREMENT,
    field1 INTEGER,
    field2 INTEGER,
    field3 TEXT,
    field4 INTEGER,
    field5 INTEGER
)
EOSQL

$dbh->do(<<'EOSQL');
        INSERT INTO table (field1,field2,field3,field4,field5) VALUES
        (?,?,?,?,?), undef, undef, 92, 'XXXXXXXX@XXXXXXXXX', 1, 1 );
EOSQL

{
    # this makes $customer->get_db_handler temporarily return 
    # our $dbh from outside
    my $sub = Sub::Override->new( 'Customer::get_db_handler' => sub {
        return $dbh 
    });

    my $customer = Customer->new( id => 92, type => 'other' );

    # this test-case is pretty useless        
    ok defined $customer, 'Customer is defined';    

    is scalar @{ $customer->emails }, 1, 
        '... and the emails were fetched form the DB';
}

END {
    unlink "$RealBin/test-customer.db";
}