Perl 如何覆盖$dbh上的commit进行测试？

我试图修改我的测试，以便在完成时回滚任何数据库工作。然而，在我测试的代码中，似乎有人显式地调用了$dbh->commit。有没有一种方法可以覆盖DBI:：db对象的commit方法来完全转换提交

我尝试过使用Test:：MockObject:：Extends，但这似乎削弱了$dbh:

    $dbh = ConnectToDB();
    $dbh = Test::MockObject::Extends->new( $dbh );
    $dbh->mock( 'commit', sub { warn("Caught you committing.") } );

稍后，当我尝试使用$dbh做一些工作时，我得到：

无法通过包t:：MO:：st定位对象方法fetchrow_数组

看起来我用模拟的$dbh创建的$sth没有正确设置。有没有人有一个好方法可以完全关闭特定$dbh的提交

我正在连接的数据库是Oracle，不管它值多少钱

更新

---

事实证明，我们用一种与Axeman的答案非常相似的方法重写了&DBI:：db:：commit，但是，由于在我的测试运行期间调用的存储过程中出现了恶意提交，所以实际上发生了提交。

我相信您希望在连接时关闭。

单元测试实际上不应该与真正的数据库进行通信。一种常见的方法是用假的数据库驱动程序替换掉数据库驱动程序，或者使用为每个测试套件定制的独立测试数据，这些数据可以在每次运行后擦除和/或保存以供分析。

您可以这样做：

{
    my %old_commit;
    sub toggle_commit { 
        my $dbh   = shift;
        my $class = blessed( $dbh );
        if ( my $old_commit = $old_commit{ $class } ) {
            my $symb 
                = do { no strict 'refs'; 
                       \*{ "$class\::commit" };
                };

            *$symb = undef;
            unless ( $class->can( 'commit' )) { 
               *{ $symb } = $old_commit;
            }
            delete $old_commit{ $class };
        }
        else {
            $old_commit{ $class } = $class->can( 'commit' );
            {   no strict 'refs'; 
                *{ "$class\::commit" } = sub { say "Committed!" };
            }
        }

    }
} 

是的，这是相当程度的Perl黑魔法

---

你必须对它进行精神测试。因为这只应该在测试时使用，所以您应该能够对代码进行分区，这样在任何正在运行的代码中都不会出现这样的混乱

您可以使用截获并忽略提交方法调用。

抱歉，本应显示ConnectToDb的内容，但此$dbh上的自动提交已关闭。这与我们实际执行的操作非常接近。我们的测试模块中有一行代码，它只作为测试脚本的一部分使用：*DBI:：db:：commit=\&&u no\u commit；sub no_commit{confessCan't commit in a test script}@Ryan Olson，可能更简洁的想法是使用我的Adaptive mixin not on CPAN，它将引用重新发布到用于将行为推送到对象上的合成包中。该包继承自现有类，并可以回滚到其原始类中。您在github或其他平台上有这样的包吗？我当然想看看。