Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

What CODE typeglob slot is my anonymous sub in?

by Ovid (Cardinal)
on Apr 24, 2007 at 09:43 UTC ( #611673=perlquestion: print w/ replies, xml ) Need Help??
Ovid has asked for the wisdom of the Perl Monks concerning the following question:

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

Cheers,
Ovid

New address of my CGI Course.

Comment on What CODE typeglob slot is my anonymous sub in?
Select or Download Code
Re: What CODE typeglob slot is my anonymous sub in?
by BrowserUk (Pope) on Apr 24, 2007 at 10:07 UTC

    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?


    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.

      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.

Re: What CODE typeglob slot is my anonymous sub in?
by shmem (Canon) on Apr 24, 2007 at 10:14 UTC
    You want Devel::Peek:
    #!/usr/bin/perl use Devel::Peek; sub foo { @_ }; $sub = \&foo; print Devel::Peek::CvGV($sub); __END__ *main::foo

    --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}

      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?

      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.

        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}
Re: What CODE typeglob slot is my anonymous sub in?
by rhesa (Vicar) on Apr 24, 2007 at 11:11 UTC
    I'm curious: why do you need to alias when you have a perfectly working generator?

      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?
Re: What CODE typeglob slot is my anonymous sub in?
by Moron (Curate) on Apr 24, 2007 at 14:17 UTC
    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 })}}}( +@_ ); }
    __________________________________________________________________________________

    ^M Free your mind!

Re: What CODE typeglob slot is my anonymous sub in?
by bennymack (Pilgrim) on Apr 24, 2007 at 15:55 UTC

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

      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.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://611673]
Approved by BrowserUk
Front-paged by htoug
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (6)
As of 2014-12-20 12:14 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (95 votes), past polls