File Coverage

blib/lib/Class/DispatchToAll.pm

Criterion	Covered	Total	%
statement	28	29	96.5
branch	5	8	62.5
condition	1	3	33.3
subroutine	6	6	100.0
pod	1	1	100.0
total	41	47	87.2

#-----------------------------------------------------------------
# Class::DispatchToAll
#-----------------------------------------------------------------
# Copyright Thomas Klausner 2001, 2002, 2006
# You may use and distribute this module according to the same terms
# that Perl is distributed under.
#
# Thomas Klausner [e-mail] http://domm.plix.at
#
#-----------------------------------------------------------------
# Class::Data::DispatchToAll - dispatch a method call to all inherited methods
#-----------------------------------------------------------------
package Class::DispatchToAll;

use 5.006;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

our @EXPORT_OK = (qw(dispatch_to_all));

our $VERSION = '0.11';


#-----------------------------------------------------------------
# dispatch_to_all
#-----------------------------------------------------------------
sub dispatch_to_all {
    my $self=shift;
    my $method=shift;
    my $attributes=shift;
    my @result_set;

    my $data={
        self=>$self,
        class=>ref($self)||$self,
        method=>$method,
        attribs=>$attributes,
        result_set=>\@result_set,
    };

    _dispatcher($data,@_);
    return wantarray?@result_set:\@result_set;
}


#-----------------------------------------------------------------
# dispatcher
#-----------------------------------------------------------------
sub _dispatcher {
    my $data=shift;

    # dispatch to own package
    no strict "refs";
    my $call=$data->{'class'}."::".$data->{'method'};

    if ($data->{'attrib'}{'no_collect'}) {
        $call->($data->{'self'},@_) if *$call{CODE};
    } else {
        push(@{$data->{'result_set'}},$call->($data->{'self'},@_)) if *$call{CODE};
    }

    my @isa=eval "@".$data->{'class'}."::ISA";
    foreach my $parent (@isa) {
        $data->{'class'}=$parent;
        _dispatcher($data,@_);
    }
}

1;

__END__