如何为Perl对象实例的指定方法添加条件性前置包装子程序？

我有一个Perl类Foo，希望在不修改方法实现的前提下，条件性地自动包装该类部分对象实例的方法（而非类方法），使得调用这些方法前会先执行一段子程序。包装子程序需要能访问调用者传递给目标方法的参数。

示例代码 #

package Foo;

sub new {
    my $self = bless({}, shift);

    my $wrap = shift;

    # 希望在这里根据$wrap的值，条件性地包装当前bless引用的方法
    # 调用者可以决定是否包装自己的实例方法，如果包装，指定方法执行前会先运行一段子程序

    return $self;
}

sub method1 {
    return;
}

sub method2 {
    return;
}

# [...]

已尝试的方案 #

• Hook::LexWrap：能正常工作，但只能透明包装类方法（不符合仅包装特定实例方法的需求）；虽能包装匿名子程序，但会返回包装后的子程序引用，无法实现自动包装。
• Perinci::Sub::Wrapper：未实际尝试，但看起来同样会返回包装后的子程序引用。
• 还试过另一个记不起名称的模块，也存在上述两种问题之一。

解决方案 #

推荐模块：Object::Wrap #

这个模块专门针对单个Perl对象包装方法，不会影响类的其他实例，完全匹配需求。用法示例：

package Foo;

sub new {
    my $self = bless({}, shift);
    my $wrap = shift;

    if ($wrap) {
        require Object::Wrap;
        # 为指定方法添加前置包装逻辑
        Object::Wrap::wrap($self,
            method1 => sub {
                my $orig = shift;
                my ($self, @args) = @_;
                # 这里是前置执行的子程序，@args就是调用目标方法的参数
                print "执行method1前：", join(', ', @args), "\n";
                # 调用原方法
                return $self->$orig(@args);
            },
            method2 => sub {
                my $orig = shift;
                my ($self, @args) = @_;
                print "执行method2前：", join(', ', @args), "\n";
                return $self->$orig(@args);
            },
        );
    }

    return $self;
}

sub method1 { return "method1返回结果"; }
sub method2 { return "method2返回结果"; }

1;

测试代码：

use Foo;

# 未包装的实例
my $foo1 = Foo->new(0);
$foo1->method1('参数a', '参数b'); # 直接执行method1，无前置输出

# 已包装的实例
my $foo2 = Foo->new(1);
$foo2->method1('参数x', '参数y'); # 先打印前置信息，再执行原方法

手动实现思路（无第三方依赖） #

如果不想引入额外模块，可以用以下两种方式实现：

方式1：临时子类+AUTOLOAD

通过将目标实例重新bless到临时子类，利用AUTOLOAD拦截方法调用，添加前置逻辑：

package Foo;

sub new {
    my $self = bless({}, shift);
    my $wrap = shift;

    if ($wrap) {
        # 创建唯一临时子类
        my $temp_class = "Foo::Wrapped_" . int(rand(10000));
        no strict 'refs';
        @{"${temp_class}::ISA"} = (__PACKAGE__);

        # 定义AUTOLOAD处理包装逻辑
        *{"${temp_class}::AUTOLOAD"} = sub {
            my $self = shift;
            my @args = @_;
            our $AUTOLOAD;
            my $method = $AUTOLOAD =~ s/.*:://r;

            # 只处理指定方法
            return unless grep { $_ eq $method } qw(method1 method2);

            # 前置执行代码
            print "执行$method前：", join(', ', @args), "\n";

            # 调用原类的方法
            return $self->SUPER::$method(@args);
        };

        # 重新bless当前实例到临时子类
        bless $self, $temp_class;
    }

    return $self;
}

sub method1 { return; }
sub method2 { return; }

# 防止AUTOLOAD拦截DESTROY方法
sub DESTROY {}

1;

这种方式只会影响当前被重新bless的实例，其他实例不受影响。

方式2：实例存储原方法引用（注意类级影响）

通过给实例添加私有键存储原方法引用，动态替换类的方法定义：

package Foo;

sub new {
    my $self = bless({}, shift);
    my $wrap = shift;

    if ($wrap) {
        my @target_methods = qw(method1 method2);
        foreach my $method (@target_methods) {
            # 保存原方法引用到实例私有字段
            $self->{"_orig_$method"} = \&$method;
            # 动态替换类的方法定义
            no strict 'refs';
            *{ref($self) . "::$method"} = sub {
                my $self = shift;
                my @args = @_;
                # 前置执行代码
                print "执行$method前：", join(', ', @args), "\n";
                # 调用原方法
                return $self->{"_orig_$method"}->($self, @args);
            };
        }
    }

    return $self;
}

sub method1 { return; }
sub method2 { return; }

1;

⚠️ 注意：这种方式会修改类的符号表，后续创建的实例也会使用包装后的方法，仅适用于不需要区分后续实例的场景。

内容的提问来源于stack exchange，提问作者kos