view release on metacpan or  search on metacpan

lib/Class/Method/Delegate.pm  view on Meta::CPAN

our $VERSION = '1.03';

sub import {
  my $class = shift;
  no strict 'refs';

  my $caller = caller;
  # Wants delegate
  *{"${caller}::delegate"} = sub { delegate($caller, @_) };

  strict->import;
}

sub delegate {
  my $class = shift;
  my $options = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {};
  my ($methods, $object, $handlers);

  if (exists $options->{'methods'}) {
    $methods = $options->{'methods'};
    croak 'methods undefined' unless $methods;

lib/Class/Method/Delegate.pm  view on Meta::CPAN

    *{"${class}::$method"} = sub {
      my $self = shift;
      my $delegation_object = &$object($self);
      croak "You are trying to delegate to something that is not an object" unless blessed( $delegation_object );
      if($delegation_object->can('delegated_by')) {
        $delegation_object->delegated_by($self);
      }
      $delegation_object->$handler(@_);
    }
  }
  strict->import;
}

1;
__END__

=head1 NAME

Class::Method::Delegate - Perl extension to help you add delegation to your classes

=head1 SYNOPSIS