view release on metacpan or  search on metacpan

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

            my $meth = "$caller\::$send";
            my @lines =  (
                # Copy @_ to @args to ensure same args passed to all methods.
                "#line $line $filename",
                "sub { local \*__ANON__ = '$meth';",
                'my ($self, @args) = @_;',
                'my @ret;',
            );
            my @array = (
                'return (',
            );
            my @scalar = (
                ') if wantarray;',
                'return [',
            );

            while (@$to) {
                my $t = shift @$to;
                my $m = shift @$as || $send;
                push @scalar, "scalar \$self->$t->$m(\@args),";
                push @array,  "[\$self->$t->$m(\@args)],";
            }
            no strict 'refs';
            *{$meth} = eval join "\n", @lines, @array, @scalar, ']', '}';

        } else {
            my $as = ($_[0] || '') eq 'as'
              ? (shift, ref $_[0] ? shift : [shift])
              : [];
            $send = [$send] unless ref $send;

            while (@$send) {
                my $s    = shift @$send;
                my $m    = shift @$as || $s;
                my $meth = "$caller\::$s";
                no strict 'refs';
                *{$meth} = eval qq{#line $line $filename
                    sub {
                        local \*__ANON__ = '$meth';
                        shift->$to->$m(\@_);
                    };
                };
            }
        }
    }
}

sub _die {
    require Carp;
    Carp::croak(@_);
}

##############################################################################

=head1 Benchmarks

I whipped up a quick script to compare the performance of Class::Delegator to
Class::Delegation and a manually-installed delegation method (the control).
I'll let the numbers speak for themselves:

  Benchmark: timing 1000000 iterations of Class::Delegation, Class::Delegator, Manually...
  Class::Delegation: 106 wallclock secs (89.03 usr +  2.09 sys = 91.12 CPU) @ 10974.54/s  (n=1000000)
  Class::Delegator:    3 wallclock secs ( 3.44 usr +  0.02 sys =  3.46 CPU) @ 289017.34/s (n=1000000)
           Control:    3 wallclock secs ( 3.01 usr +  0.02 sys =  3.03 CPU) @ 330033.00/s (n=1000000)

=head1 Bugs

Please send bug reports to <bug-class-delegator@rt.cpan.org> or report them
via the CPAN Request Tracker at
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Class-Delegator>.

=head1 Author

=begin comment

Fake-out Module::Build. Delete if it ever changes to support =head1 headers
other than all uppercase.

=head1 AUTHOR

=end comment

David Wheeler <david@kineticode.com>

=head1 See Also

=over

=item L<Class::Delegation|Class::Delegation>

Damian Conway's brilliant module does ten times what this one does--and does
it ten times slower.

=item L<Class::Delegate|Class::Delegate>

Kurt Starsinic's module uses inheritance to manage delegation, and has a
somewhat more complex interface.

=item L<Class::HasA|Class::HasA>

Simon Cozen's delegation module takes the same approach as this module, but
provides no method for resolving method name clashes the way this module's
C<as> parameter does.

=back

=head1 Copyright and License

Copyright (c) 2005-2008 David Wheeler. Some Rights Reserved.

This module is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut