Using caller to determine the namespace of an anonymous subroutine

[rrwo]

I'm trying to figure out how to determine the package that an anonymous subroutine belongs to by using the caller function.

The difficulty I'm having is that when classes use something like Class::Accessor to create accessors for classes, the namespace of the methods is Class::Accessor (or whatever class created them) rather than the actual class it belongs to.

I've not found any clear documentation on this. From a bit of netsurfing I saw an article refer to the package that caller returned being the package that the subroutine was compiled in. Which sounds like an accurate description of what this is.

So my question is: is there a way for Perl to determine the actual package that called a subroutine, rather than the package where the call to the subroutine was compiled?

Some cample code to illustrate my question is below. The code prints "Creator::__ANON__" as the namespace, rather than "TracedCreatee::foo".

package Tracer;

sub new {
  my $class = shift || __PACKAGE__;
  my $self = { };
  bless $self, $class;
}

sub STORE {
  print STDERR "\n\x23 ", (caller(1))[3], "\n";
  my $self = shift;
  my $key  = shift;
  my $val  = shift;
  $self->{$key} = $val;
}

sub FETCH {
  print STDERR "\n\x23 ", (caller(1))[3], "\n";
  my $self = shift;
  my $key  = shift;
  $self->{$key};
}

1;

package Creator;

use strict;
use warnings;

sub create {
  my $caller = (caller(0))[0]; # $caller =~ s/::(((?!::).)+)$//;
  my $field = shift;
  no strict 'refs';
  *{$caller."::".$field} = sub {
    my $self = shift;
    if (@_) {
      return $self->STORE($field,@_);
    } else {
      return $self->FETCH($field);
    }
  };
}

1;

package TracedCreatee;

our @ISA = qw( Tracer );


Creator::create("foo");


1;

package main;

use strict;
use warnings;

my $obj = TracedCreatee->new();

$obj->foo(1);

The purpose of this question is for improving Class::Tie::InsideOut, which is a proof-of-concept package for using tied hashes to implement inside-out objects. A downside in that is one cannot use Class::Accessor to create methods.

[chromatic]

Perl Hacks has a tip from Ovid that shows how to get around this. Add one line of code to Creator::create():

*{$caller."::".$field} = sub
{
    local *__ANON__ = "${caller}::${field}";
    my $self = shift;
    return $self->STORE( $field, @_ ) if @_;
    return $self->FETCH( $field );
};

[rrwo]

Great idea. Thanks!

(Now to patch Class::Accessor and related modules and convince the authors to accept the patches...)

[stvn]

As an alternate to what chromatic said, I have found the Sub::Name module to be very helpful in these kinds of situations (I used it in my module Class::MOP, whenever I am adding a method to a class). Again, it needs to be within the code for Creator::create, but IMO it is much less "magical".

my $full_name = $caller."::".$field;
*{$fullname} = Sub::Name::subname $full_name => sub { ... }

After this, not only will the sub show up correctly in the output of caller(), but is also shows up correctly when you poke at it with any of the B modules too. This is because Sub::Name will actually set the STASH and NAME attributes for the CV itself using XS.

[rrwo]

Sub::Name might be a better solution, since I don't need access to the innards of the coderef. Though I'm not sure I'd call it less magical, since I still need to assign the subroutine name to the coderef.

Thanks again!