perl – 复制子程序

use Scalar::Util 'set_prototype';

sub foo {};
*bar = &;foo;
set_prototype(&;bar,'$');  # also modifes "foo"

我想要实现的目标可以通过goto& sub完成：

sub foo {};
sub bar($) {
    goto &foo;
}

但是,这会引入不必要的开销,我并不热衷于此.因此我的问题是：有没有办法制作子程序(CV)的(浅)副本,这样设置副本的原型不会影响原件？即就像是

use Scalar::Util 'set_prototype';

sub foo {};
*bar = magical_cv_copy(&;foo);
set_prototype(&;bar,'$');  # does not modify "foo"

我看了Sub:Clone,但它看起来已经过时了,如果没有强制它就不会安装在我的系统上.我不想为此编写XS代码.

测试用例以澄清我的要求：

use strict;
use warnings;
use Test::More tests => 7;
use Scalar::Util qw/refaddr set_prototype/;

sub foo {
    my ($x) = @_;
    return 40 + $x;
}
*bar = then_a_miracle_occurs(&;foo);

ok not(defined prototype &;foo),'foo has no prototype';
ok not(defined prototype &;bar),'bar has no prototype';
isnt refaddr(&;foo),refaddr(&;bar),'foo and bar are distinct';

set_prototype &;bar,'$';

ok not(defined prototype &;foo),'foo still has no prototype';
is prototype(&;bar),'$','bar has the correct prototype';

is foo(2),42,'foo has correct behavior';
is bar(2),'bar has correct behavior';

sub then_a_miracle_occurs {
    my ($cv) = @_;
    # what goes here?
    # return sub { goto &$cv }
}

避免X-Y问题：

我的X问题是第三方模块定义了一些没有原型的函数foo.明智地使用原型可以使这个功能更加优雅,所以我想创建该子的副本,除了它有一个原型.我不能对foo函数做任何假设 – 它也可能是一个XS子程序.

我无法直接设置foo的原型,因为我不希望干扰依赖foo原始行为的其他模块.

所以我们得出了我的Y问题：如何复制子程序.