view release on metacpan or  search on metacpan

Delegate.pm  view on Meta::CPAN

package Class::Delegate;

=head1 NAME

Class::Delegate - easy-to-use implementation of object delegation.

=head1 SYNOPSIS

    require Class::Delegate;
    @ISA    = 'Class::Delegate';

    $self->add_delegate('some_name', $a);
    $self->add_delegate($b);
    $self->do_something_that_b_knows_how_to_do();
    $self->do_something_that_a_knows_how_to_do();

=head1 DESCRIPTION

This class provides transparent support for object delegation.  For more
information on delegation, see B<Design Patterns> by Erich Gamma, et al.

=cut

use strict;
use vars qw($VERSION $AUTOLOAD);


$VERSION = '0.06';


my $Debug   = 0;
sub _debug  { $Debug = shift }
sub _log    { print STDERR @_ if $Debug }



=head1 METHODS

=over 4

=item add_delegate([ $name, ] $delegate)

Assigns a delegate to your object.  Any delegate can be named or unnamed
(see the delegate() method for information on the usefulness of naming a
delegate).

=cut

sub add_delegate
{
    my ($self, @delegates)  = @_;

    _prepare($self);

    # Each entry is either a <name, object> pair, or just an <object>.
    # If it is a lone object, then we name it after its stringified value.
    # NOTE:  If you don't specify a name for a delegate, then there is no
    # documented API for accessing said delegate!
    while (@delegates) {
        my $name    = ref($delegates[0]) ? "$delegates[0]" : shift @delegates;
        my $object  = shift @delegates;

        die "Argument `$object' to add_delegate() is not an object\n"
            unless (ref($object) and $object =~ /=/);

        $$self{__delegates}{$name}  = $object;

        # If the delegate wants to know who its owner is, then tell it.
        $object->set_owner($self) if $object->can('set_owner');
    }

    return $self;
}


=item resolve($methodname, $delegatename)

Declare that calls to $methodname should be dispatched to the delegate
named $delegatename.  This is primarily for resolving ambiguities when