3

我有一个 Perl 库，它在操作过程中使用了一些（大约 3 或 4 个）类的许多对象。

在测试代​​码时，我想确保它不会太多（我不是在谈论内存泄漏，我知道如何检查）。为此，我认为我可以计算每个使用的对象，并检查测试数据运行期间使用的最大值。然后，我会将获得的数字与一些关于库应该使用多少对象的猜测进行比较。

但是，我在实现这一点时遇到了问题。我想到了两种可能的方法：

  • 拦截Package::new和Package::DESTROY。然而，这有一个小问题，在那个包中，new并不总是返回一个新对象。有时，它使用一个预先存在的对象（这些对象被用作不可变对象，所以它应该无关紧要）。所以我必须跟踪每个单独的对象，看看它之前是否存在。

  • 拦截Package::bless和Package::DESTROY。这应该可行，但似乎有点不正统。

问题是，哪种方式更有可能成功（可能是在类似情况下常用的方式），其次，我什至如何实现第二种方式（我必须覆盖Package::bless所有有问题的包还是只覆盖基类ETC。）。

4

4 回答 4

2

存储所见对象 ID 的哈希值，以确保您只计算每个对象一次。您可以使用Hash::Util::FieldHash或Object::ID来做到这一点。

idhash 的优点是它不会人为地使对象保持活动状态。随着每个对象被销毁，它的条目将从 idhash 中删除。它还具有跨线程工作的好处。

package Foo;

use strict;
use warnings;
use v5.10;

use Hash::Util::FieldHash qw(idhash register id);

idhash my %objects;

sub new {
    my $self = bless {}, shift;
    register $self, \%objects;
    $objects{$self} = 1;

    say "Creating ".id $self;

    my $num_objects = keys %objects;
    say "There are now $num_objects alive.";

    return $self;
}

sub DESTROY {
    my $self = shift;

    my $num_objects = keys(%objects) - 1;

    say "Destroying ".id $self;
    say "There are $num_objects left alive.";
}


{
    my $obj1 = Foo->new;            # 1 object
    my $obj2 = Foo->new;            # 2 objects
    {
        my $obj3 = Foo->new;        # 3 objects
    } # 2 objects
    my $obj4 = Foo->new;            # 3 objects
} # 0 objects
__END__
Creating 4303384168
There are now 1 alive.
Creating 4303542768
There are now 2 alive.
Creating 4303545192
There are now 3 alive.
Destroying 4303545192
There are 2 left alive.
Creating 4303638136
There are now 3 alive.
Destroying 4303542768
There are 2 left alive.
Destroying 4303384168
There are 1 left alive.
Destroying 4303638136
There are 0 left alive.

或者，由于创建的每个对象都将被销毁，因此仅在对象被销毁时才计数。

于 2012-11-04T02:41:52.700 回答
2

关于如何拦截 bless（不是 Package::bless，bless 是内置的，不是某种方法），大多数内置是可覆盖的（参见http://perldoc.perl.org/perlsub.html#Overriding-Built-函数内）。替换 bless 函数将执行您的跟踪（如果将一个对象祝福到您的目标类中），然后调用 CORE::bless 来实际执行祝福。

于 2012-11-04T07:29:49.157 回答
2

尝试这样的事情（未经测试）：

my $Package_objects = {};
my $override_new = *Package::new{CODE};
*Package::new = sub {
    my $self = $override_new->(@_);
    # Interpolate $self as string to get "HASH(0x12345)"; save package name
    $Package_objects->{ "$self" } = 'Package';
    return $self;
};
my $override_dest = *Package::DESTROY{CODE};
*Package::DESTROY = sub {
    delete $Package_objects->{ "$_[0]" };
    $override_dest->(@_);
};

可能这是最野蛮的方法，但必须在没有 3rd 方模块的情况下工作；）

于 2012-11-04T08:21:22.427 回答
1

看看使用的技术

开发泄漏对象 1.01

我使用 ADAMK 的代码作为收集各种对象创建/销毁统计信息的基础。

于 2012-11-04T15:37:41.767 回答