in reply to Re: What CODE typeglob slot is my anonymous sub in?
in thread What CODE typeglob slot is my anonymous sub in?

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.

Replies are listed 'Best First'.
Re^3: What CODE typeglob slot is my anonymous sub in?
by shmem (Chancellor) on Apr 24, 2007 at 10:30 UTC
    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}
[reply]
[d/l]

      Nope. When I call TEXT(), I'd like 'text' reported and when I call 'TINYTEXT()', I'd like 'tinytext' reported. However, I do like what you did. Gives me ideas for this.

      The reason I don't think my problem is really solvable is because I can assign an anonymous sub to thirteen different 'real' subs and I can't tell from the anonymous sub which is getting invoked at that time.

      Cheers,
      Ovid

      New address of my CGI Course.

[reply]

        update: proper link "Gives me ideas for this" since http://use.perl.org is on hiatus.

        Ah, now. What you ask for is a subroutine that knows its dispatching word. Something like... 
        #!/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;
    *$type = sub {
        warn "subtype: ",shift,"\n";
        warn "args: @_\n";
        warn "typeglob slot: ",Devel::Peek::CvGV($type_sub),"\n";
    };
    *$function = sub {
        &{$type}($function,@_);
    };
}
sub alias {
    my ($target, $source) = @_;
    no strict 'refs';
    *$target = sub { \&{lc $source}(lc $target,@_) };
} 

alias("TINYTEXT","TEXT");

TINYTEXT(3);

*text = sub { warn "wuff! @_\n" };
TINYTEXT("which spake the blue_cowdawg.");

__END__
subtype: tinytext
args: 3
typeglob slot: *main::TEXT
Subroutine main::text redefined at ovid.pl line 36.
wuff! tinytext which spake the blue_cowdawg.

        [download]

        Sort of "reverse curry" :-)

        You have lowercase subs which you enrich with the alias name, and wrap those into the uppercase sub. While the outer sub remains the same, you can massage the inner sub and have it changed for all aliases. While not a solution for Y, it's a solution for X :-)

        Well, you could overload the assignment operator, for typeglob assignments, also...

        --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}
[reply]
[d/l]

In Section Seekers of Perl Wisdom