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/nGntIXQ@xxxxxxxxxxxxxxxx
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
|
