What CODE typeglob slot is my anonymous sub in?

[Ovid]

I'm dynamically generating subroutines and assigning them to actual subs:

my @types = qw(
  date
  integer
  text
  timestamp
);

foreach my $type (@types) {
    my $function = uc $type;
    no strict 'refs';
    *$function = sub {
        if ( looks_like_number( $_[0] ) ) {
            die "Datatype '$type' does not require a numeric length '$
+_[0]'";
        }
        return { type => $type, @_ };
    };
}

However, sometimes I need to alias those subroutines:

*TINYTEXT = \&TEXT;

That cause a problem because the '$type' referred to in the error message should actually be the lower-cased name of the subroutine, not the original type that was generated. Both 'TINYTEXT(3)' and 'TEXT(3)' will generate an error message referring to 'text'.

I tried to use caller, but that doesn't work because it reports 'main::__ANON__' instead of which CODE slot in the typeglob that this anonymous sub is assigned to. Is there any way I can figure that out from within an anonymous sub?

(I can get around this in numerous ways by providing 'sub' to 'type' mappings or manually coding the aliased subroutines, but I'd much prefer to avoid the grunt work).

[shmem]

You want Devel::Peek:

#!/usr/bin/perl

use Devel::Peek;

sub foo { @_ };
$sub = \&foo;

print Devel::Peek::CvGV($sub);
__END__
*main::foo

[Ovid]

Nice idea, but that doesn't work. The following minimal test case prints '*main::__ANON__'.

#!/usr/bin/perl 

use strict;
use warnings;
use Devel::Peek;

my @types = qw(
  text
);

foreach my $type (@types) {
    my $function = uc $type;
    my $type_sub;
    $type_sub = sub {
        warn Devel::Peek::CvGV($type_sub);
    };
    no strict 'refs';
    *$function = $type_sub;
}
*TINYTEXT = \&TEXT;

TINYTEXT();

Did I misunderstand?

[shmem]

The other way round... you *first* have to allocate the typeglob, and *then* get a reference from it to pass into the closure:

#!/usr/bin/perl 

use strict;
use warnings;
use Devel::Peek;

my @types = qw(
  text
);

foreach my $type (@types) {
    my $function = uc $type;
    my $type_sub;

    no strict 'refs';
    $type_sub = \&$function;
    *$function = sub {
        warn Devel::Peek::CvGV($type_sub);
    };
}
*TINYTEXT = \&TEXT;

TINYTEXT();
__END__
*main::TEXT at ovid.pl line 18.

Is that what you want?

If you assign an anonymous sub to a scalar and stuff that into the code slot, it remains __ANON__.

[BrowserUk]

Your use of uc is what is causing your problem I think:

#! perl -slw
use strict;

my @types = qw(
  date
  integer
  text
  timestamp
);

foreach my $type (@types) {
    my $function = uc $type;
    no strict 'refs';
    *$function = sub {
        # line 1 "$type.anon"
        if ( looks_like_number( $_[0] ) ) {
            die "Datatype '$type' does not require a numeric length '$
+_[0]'";
        }
        return { type => $type, @_ };
    };
    print *$function;
}
__END__
C:\test>junk6
*main::DATE
*main::INTEGER
*main::TEXT
*main::TIMESTAMP

Remove it and you get:

C:\test>junk6
*main::date
*main::integer
*main::text
*main::timestamp

Is that what you are after?

[Ovid]

See shmem's response below, and my response in turn. It doesn't solve my problem, but it's a lot closer. I'm not sure if my problem can be solved.

[rhesa]

I'm curious: why do you need to alias when you have a perfectly working generator?

[Ovid]

Because if I have 'tinytext' in the list, then the type returned is { type => 'tinytext' }, and that's invalid. I need both TEXT() and TINYTEXT() to return a type of 'text', but the error message needs to report the actual subroutine called. If this were a one-off, I wouldn't care. However, I need multiple aliases which return identical types but whose error message needs to return which alias was called.

Update: I know it's easy to modify the generator to do this and that's what I'll do (a hash mapping instead of a list). It just bugs me that if an anonymous sub is assigned to a CODE slot in a type glob and I call the actual sub, I can't figure out which one it is.

[shmem]

It just bugs me that if an anonymous sub is assigned to a CODE slot in a type glob and I call the actual sub, I can't figure out which one it is.

That's because you don't call, it - perl does. You just name it... ;-) But then, I guess there is a way with some XS devilry involved. Devel::Peek's "CvGV($cv)" returns one of the globs associated to a subroutine reference, so I deem it possible to get at the right one. Haven't got time right now to find out how Ilya did it.

[dragonchild]

Have you considered asking stvn if Moose provides this information? I know he was doing a lot of work early on in providing appropriate meta-information for subroutines and methods.

[Moron]

I would have gone in some different directions earlier on.

# alternative handling schematic (untested)

use strict;
use warnings;

our $Inject = { # sort datatypes into groups
    tinytext => text,
    text => text,
    int => int,
    tinyint => int,
    etc.
}

our $Dispatch = { # define the dispatch code per group
    text => sub { my $self = shift; etc. },
    int => sub { my $self = shift; etc. ),
    etc.
}

sub dispatch { # dispatch by unsorted datatype
    my $self = shift;
    $self -> { $Dispatch -> { $Inject -> { lc( $self -> { TYPE })}}}( 
+@_ );
}

[bennymack]

I'm not sure if this is what you're looking for but I've found this tip from "Perl Hacks" useful on many occasions.

perl -MCarp -e '
my $sub = sub {
        local *__ANON__ = "Some::Sub";
        Carp::cluck "clucks when called";
};
$sub->();
'

It won't help with you're aliasing problem but then you're probably just better of generating two subs identical except for their $__ANON__.

[Ovid]

FYI: If you check the front of the book, you'll find I wrote that tip for Perl Hacks :)