#!/usr/bin/perl

use Devel::Peek;

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

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

_($_=" "x(1<<5)."?\n".q·/)Oo.  G°\        /
                              /\_¯/(q    /
----------------------------  \__(m.====·.(_("always off the crowd"))."·
");sub _{s./.($e="'Itrs `mnsgdq Gdbj O`qkdq")=~y/"-y/#-z/;$e.e && print}

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();
[download]

Did I misunderstand?

Cheers,
Ovid

New address of my CGI Course.

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.
[download]

Is that what you want?

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

--shmem

_($_=" "x(1<<5)."?\n".q·/)Oo.  G°\        /
                              /\_¯/(q    /
----------------------------  \__(m.====·.(_("always off the crowd"))."·
");sub _{s./.($e="'Itrs `mnsgdq Gdbj O`qkdq")=~y/"-y/#-z/;$e.e && print}

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
[download]

Remove it and you get:

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

Is that what you are after?

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.

Cheers,
Ovid

New address of my CGI Course.

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.

Cheers,
Ovid

New address of my CGI Course.

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.

--shmem

_($_=" "x(1<<5)."?\n".q·/)Oo.  G°\        /
                              /\_¯/(q    /
----------------------------  \__(m.====·.(_("always off the crowd"))."·
");sub _{s./.($e="'Itrs `mnsgdq Gdbj O`qkdq")=~y/"-y/#-z/;$e.e && print}

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.

---

My criteria for good software:

1. Does it work?
2. Can someone else come in, make a change, and be reasonably certain no bugs were introduced?

# 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 })}}}( 
+@_ );
}
[download]

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->();
'
[download]

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__.

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

Cheers,
Ovid

New address of my CGI Course.