Re: SPOILER: 'What does this code do?' Quiz

On Wednesday 27 June 2007, Peter Scott wrote:
> 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.
>

That's right.

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

Well, the thing is that it is very unlikely, I will create a different glob 
with the name "$mn", which will be different than a subroutine. But point 
taken.

> and to be on the safe side, rewrite the %%%% line as
>
>              push @r, @{ ref $m->($self) eq 'ARRAY' ? $m->($self) : [] };

If it returns anything except an array ref, then I'd like to know about it. So 
I can assume that the contract of the function will be that, and that the 
functions of those names will be dedicated for them.

As for the origin: this code is originally based on a concept that Damian 
Conway introduced in Class::Std ( http://search.cpan.org/dist/Class-Std/ ) - 
the "CUMULATIVE" methods. I believe I read about it in his Perl Best 
Practices book.

I later implemented this feature in a somewhat different way in Test::Run 
(without making use of any of Damian's original Class::Std code), and this 
code here is based on the Test::Run code.

Regards,

	Shlomi Fish

---------------------------------------------------------------------
Shlomi Fish      shlomif-ik1l9ssToec+JF/[email protected]
Homepage:        http://www.shlomifish.org/

If it's not in my E-mail it doesn't happen. And if my E-mail is saying
one thing, and everything else says something else - E-mail will conquer.
    -- An Israeli Linuxer