5

I found a solution to renaming anonymous subs in Perl here. It involves temporarily mangling the symbol table to insert the desired name. This solution uses a hard-coded symbol table name to be replaced. My problem is that I would like to dynamically choose the symbol table name at runtime. Something like this:

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

The only way to make it work is to disable strict refs. If they are not disabled, the script fails with this message:

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

Note that the equivalent statement could be used

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

with the similar error message:

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

Is it possible to do the same thing without disabling strict refs?

TMI/DNR:
Here is a complete example in case you're interested. Ironically, my solution uses an anonymous sub to rename the given anonymous sub.

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 = $1;
   $name = $2;

   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/.*::(.+)/$1/;

   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;

1 Answer 1

7

You can use core module Sub::Util's set_subname.

use Sub::Util qw( set_subname );

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

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.