Perl子例程属性装饰器问题：输出不符预期如何修正

我正在学习Perl中子例程的属性用法，希望通过属性实现子例程的前后处理。

预期输出：

before
middle
after
125

实际输出：

before
middle
after
middle
124

请问如何将属性用作主子例程的装饰器/覆盖层？

原代码 #

use Attribute::Handlers ;
use Data::Dumper ;

sub decorator( $\*&\@\@$$$ ):ATTR {
    my ( $package , $symbol, $referent, $attr , $data, $phase, $filename, $linenum ) = @_ ;
    my ( $before , $after ) = @$data ;

    # before processing
    $before->( @_ ) ;

    # decorated sub
    my $result = $referent->( ) ;

    # after processing
    $after->( $result )
}

sub c( $ ):decorator(
    # before
    sub( $\*&\@\@$$$ ) {
        warn 'before' ;
    } ,
    # after
    sub( $ ) {
        warn 'after' ;

        shift( @_ ) + 1
    }
) {
    warn 'middle' ;

    splice( @_ , 1 ) + 1
}

print( __PACKAGE__->c( 123 ) ) ;

问题分析与解决 #

你的核心问题是没有用装饰后的逻辑替换原有的子例程符号。Attribute::Handlers的ATTR子例程在编译阶段执行，原代码中只是在编译时跑了一遍before、原函数、after，但并没有修改*$symbol指向的子例程，所以运行时调用c还是执行原来的未装饰版本，导致重复输出middle且结果错误。

正确的做法是在装饰器中创建一个包装原函数的新子例程，然后将这个新子例程赋值给原符号，这样调用c时就会执行包含前后处理的逻辑。

修改后的代码 #

use Attribute::Handlers;

sub decorator :ATTR {
    my ( $package, $symbol, $referent, $attr, $data, $phase ) = @_;
    my ( $before, $after ) = @$data;

    # 创建包装后的子例程，封装完整的前后处理逻辑
    my $wrapped = sub {
        # 执行before处理，传递调用时的参数
        $before->(@_);
        # 执行原函数，传递调用参数
        my $result = $referent->(@_);
        # 执行after处理，并返回最终结果
        return $after->($result);
    };

    # 替换原符号指向的子例程，开启装饰效果
    no warnings 'redefine';
    *$symbol = $wrapped;
}

sub c($) :decorator(
    # before处理：简化逻辑，仅输出提示
    sub {
        warn 'before';
    },
    # after处理：接收原函数结果，返回+1后的值
    sub {
        warn 'after';
        shift() + 1;
    }
) {
    warn 'middle';
    # 原函数逻辑：接收参数并返回+1后的值
    shift() + 1;
}

print(__PACKAGE__->c(123));

修改说明 #

1. 移除了冗余的Data::Dumper和无意义的参数签名，简化装饰器的参数处理逻辑
2. 创建$wrapped子例程，完整封装before、原函数、after的执行流程，并传递调用时的参数
3. 通过*$symbol = $wrapped替换原有子例程，确保运行时调用c执行的是装饰后的逻辑
4. 简化了before/after子例程的逻辑，只保留必要的功能
5. 修正原函数c的参数处理逻辑，避免splice导致的歧义

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