view release on metacpan or  search on metacpan

lib/Class/CompoundMethods.pm  view on Meta::CPAN

    # to clobber it if its just the hook method or if its already in
    # the list of things C::CM knows to call as a component.
    if (    defined &$method_name
        and ( __PACKAGE__ ne _function_package( \&$method_name ) )
        and not scalar grep { $_ == \&$method_name } @$methods_to_call )
    {
        ### Saving original method
        $existing_method->(
            {   stash    => $methods_to_call,
                method   => \&$method_name,
                package  => $package,
                filename => $filename,
                line     => $line
            }
        );
    }

    ### Saving original method
    $add_method->(
        {   stash    => $methods_to_call,
            method   => $method_to_install,
            package  => $package,
            filename => $filename,
            line     => $line
        }
    );

    # Install the hook if there isn't one there aleady.
    if ( __PACKAGE__ eq _function_package( \&$method_name ) ) {

        ### Ignoring pre-existing multi-method hook.
    }
    elsif ( 1 == @$methods_to_call ) {

        ### Installing the single method.
        *$method_name = $methods_to_call->[0];
    }
    elsif ( 1 < @$methods_to_call ) {

        ### Installing the multi-method hook.
        *$method_name = sub {
            my ($self) = shift;

            if (wantarray) {
                return map $self->$_(@_), @$methods_to_call;
            }
            elsif ( defined wantarray ) {
                return join( ' ', map $_->$_(@_), @$methods_to_call );
            }
            else {
                $self->$_(@_) for @$methods_to_call;
                return;
            }
        };
    }

    # Return the method as a convenience (for who knows what, I don't know)
    return \&{$method_name};
}

"Fine!  Since you're too busy playing with people's minds, I'll just go off to the other room to play with myself!";