如何在不禁用 strict 'refs' 的情况下重命名 perl ANON sub？

Question

我找到了在 Perl 中重命名匿名 sub 的解决方案 here。它涉及临时修改符号 table 以插入所需的名称。此解决方案使用硬编码符号 table 名称进行替换。我的问题是我想在运行时动态选择符号 table 名称。像这样：

   $pkg = 'MyPkg::ModA::';
   $name = 'subname';
   ...
   no strict 'refs';
   local *{"${pkg}__ANON__"} = "$name [anon]";
   strict refs;

让它工作的唯一方法是禁用严格引用。如果未禁用它们，脚本将失败并显示以下消息：

Can't use string ("MyPkg::ModA::__ANON__") as a symbol ref while "strict refs" in use at /path/to/source/File.pm line xx

请注意，可以使用等效语句

   local ${$pkg}{__ANON__} = "$name [anon]";

出现类似的错误信息：

Can't use string ("MyPkg::ModA::") as a HASH ref while "strict refs" in use at /path/to/source/File.pm line xx

是否可以在不禁用严格引用的情况下做同样的事情？

TMI/DNR:
如果您有兴趣，这里有一个完整的示例。具有讽刺意味的是，我的解决方案使用匿名子重命名给定的匿名子。

ModA.pm

package MyPkg::ModA;

use strict;
use warnings;
use MyPkg::Util;

# Create a new instance.
sub new
{
   my ($type, $class, $self);

   # allow for both ModA::new and $moda->new
   $type = shift;
   $class = ref $type || $type;
   $self = {@_};
   bless $self, $class;

   # use exported Util::anon sub here
   $self->{func} = anon sub
   {
      my ($arg);

      $arg = shift;

      debug "$arg: $arg";
   };

   return $self;

} # new

1;
__END__

ModB.pm

package MyPkg::ModB;

use strict;
use warnings;
use MyPkg::ModA;

# Create a new instance.
sub new
{
   my ($type, $class, $self);

   # allow for both ModB::new and $modb->new
   $type = shift;
   $class = ref $type || $type;
   $self = {@_};
   bless $self, $class;

   $self->{modA} = MyPkg::ModA->new;

   return $self;

} # new

# Do something with ModA.
sub doit
{
   my ($self);

   $self = shift;

   $self->{modA}->{func}->('What is your quest?');

} # doit

1;
__END__

Util.pm

package MyPkg::Util;

use strict;
use warnings;
require Exporter;

our (@ISA, @EXPORT);

@ISA = qw(Exporter);
@EXPORT = qw(
   anon
   debug);

# Temporarily mangle symbol table to replace '__ANON__'.
sub anon
{
   my ($func, $sub, $pkg, $name);

   $func = shift;

   $sub = (caller 1)[3];
   $sub =~ /(.*::)(.+)/;
   $pkg = ;
   $name = ;

   return sub
   {
      # TODO How to do this w/o disabling strict?
      #no strict 'refs';
      # temp symbol table mangling here
      # ${$pkg}{__ANON__} is equivalent to *{"${pkg}__ANON__"}
      local *{"${pkg}__ANON__"} = "$name [anon]";
      use strict;
      $func->(@_);
   };

} # anon

# Print a debug message. 
sub debug
{
   my($fname, $line, $sub);

   ($fname, $line) = (caller 0)[1,2];
   $fname =~ s/.+\///;

   $sub = (caller 1)[3] || 'main';
   $sub =~ s/.*::(.+)//;

   printf STDERR "%-10s %s(%s) - \"%s\"\n", $fname, $sub, $line, "@_";

} # debug

1;
__END__

mytest.pl

#! /usr/bin/perl

use strict;
use warnings;
use MyPkg::ModB;

# Stuff happens here.
my ($modB);

$modB = MyPkg::ModB->new;
$modB->doit;

Answer 1

您可以使用核心模块 Sub::Util 的 set_subname。

use Sub::Util qw( set_subname );

sub anon {
   ...
   return set_subname("$name [anon]", $func);
 }

如何在不禁用 strict 'refs' 的情况下重命名 perl ANON sub？

How to rename perl ANON sub without disabling strict 'refs'?

perl

reference

strict

anonymous-function

symbol-table

如何在不禁用 strict 'refs' 的情况下重命名 perl __ANON__ sub？

How to rename perl __ANON__ sub without disabling strict 'refs'?

perl

reference

strict

anonymous-function

symbol-table

如何在不禁用 strict 'refs' 的情况下重命名 perl ANON sub？

How to rename perl ANON sub without disabling strict 'refs'?