SPOILER: 'What does this code do?' Quiz

At 12:05 PM 6/27/2007, Shlomi Fish wrote:
>Hi all!
>
>Here's another "What does this code do?" Quiz.
><<<<<<<<<<<<<<<<<<<<<
>use strict;
>use warnings;
>
>use List::MoreUtils (qw(uniq));
>
>our %_t = ();
>
>sub t
>{
>     my $c = shift;
>
>     if (exists($_t{$c}))
>     {
>         return $_t{$c};
>     }
>
>     no strict 'refs';
>
>     my @h = $c;
>     my @d = @{$c. '::ISA'};
>
>     while (my $p = shift(@d))
>     {
>         push @h, $p;
>         push @d, @{$p. '::ISA'};
>     }
>
>     my @u = uniq(@h);
>
>     return $_t{$c} =
>         [
>             sort
>             {
>                   $a->isa($b) ? -1
>                 : $b->isa($a) ? +1
>                 :               0
>             }
>             @u
>         ];
>}
>
>sub z
>{
>     my ($self, $args) = @_;
>
>     my $mn = $args->{mn};
>
>     my $c = ((ref($self) eq "") ? $self : ref($self));
>
>     my $h= t($c);
>
>     my @r;
>     foreach my $i (@$h)
>     {
>         no strict 'refs';
>         my $m = ${$i . "::"}{$mn};   # ****
>         if (defined($m))
>         {
>             push @r, @{$m->($self)}; # %%%%
>         }
>     }
>     return \@r;
>}
> >>>>>>>>>>>>>>>>>>>>>

$object_or_class->z( { mn => 'funcname' } ) will return a reference to 
an array of all the list-context results of calling the 'funcname' 
method in the class of $object_or_class and its ancestors in parental 
order, assuming that each such method returns an arrayref, and that the 
above code is present in or inherited by the class of $object_or_class.

However, it checks to see only if the glob 'funcname' is defined, not 
whether there is a subroutine of that name.  It will generate a warning 
if another slot in the glob is used instead.  I would rewrite the **** 
line above as

         my $m = *{$i . "::$mn"}{CODE};

and to be on the safe side, rewrite the %%%% line as

             push @r, @{ ref $m->($self) eq 'ARRAY' ? $m->($self) : [] };

-- 
Peter Scott
Pacific Systems Design Technologies
http://www.perldebugged.com/
http://www.perlmedic.com/