The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
NAME
    Class::Delegation::Simple - Simple delegation for Perl

SYNOPSIS
      package Delegator1;

      use strict;
      use warnings 'all';
      use Class::Delegation::Simple {
          send => 'steer',
          to   => 'wheel',
          as   => 'turn',
        },
        {
          send => 'wipe',
          to   => [qw/ left_wiper right_wiper /]
        };

      sub new
      {
        my ($class, %args) = @_;
    
        return bless {
          wheel       => Echo->new('wheel'),
          left_wiper  => Echo->new('left_wiper'),
          right_wiper => Echo->new('right_wiper'),
        }, $class;
      }# end new()

    The "Echo" class:

      package Echo;

      sub new
      {
        my ($class, $name) = @_;
        return bless { name => $name }, $class;
      }# end new()

      sub AUTOLOAD
      {
        my ($s, @args) = @_;
        our $AUTOLOAD;
        my ($method) = $AUTOLOAD =~ m/::([^:]+)$/;
        return "Method '$method'(@args) called on '$s->{name}'!";
      }# end AUTOLOAD()

      sub DESTROY { }

    The test script:

      #!perl -w
  
      use strict;
      use warnings 'all';
      use Delegator1;
  
      my $del = Delegator1->new();
  
      $del->steer('right');  # "Method 'steer'(right) called on 'wheel'!"
      $del->steer('left');   # "Method 'steer'(left) called on 'wheel'!"
      $del->wipe('medium');  # "Method 'wipe'(medium) called on 'left_wiper'! Method 'wipe'(medium) called on 'right_wiper'!"

DESCRIPTION
    Class delegation is simply a way to get around some of the problems
    presented by class inheritance.

    You can specify that you want some method calls to be handled by one or
    more attributes of your own choosing.

    This is much cleaner than constantly hacking out the following:

      sub steer
      {
        my ($s) = shift;
        $s->{wheel}->steer( @_ );
      }
  
      sub wipe
      {
        my ($s) = shift;
        my @result = (
          $s->{left_wiper}->wipe( @_ ),
          $s->{right_wiper}->wipe( @_ )
        );
        return @result;
      }

BUT DOES IT WORK IN MOD_PERL?
    Yes - it works in mod_perl. Unlike some other Perl Delegation modules on
    CPAN, this module does not depend on the "INIT" phase to get the work
    done. This means that it should work just fine in persistent
    environments such as mod_perl.

COPYRIGHT
    Copyright 2008 John Drago jdrago_999@yahoo.com

LICENSE
    This software is Free software and may be used and redistributed under
    the same terms as perl itself.