The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package CURRENT;

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

$VERSION = '0.01';

sub AUTOLOAD {
    my ($self) = @_;

    my $caller_class = caller;
    my ($wanted_method) = $CURRENT::AUTOLOAD =~ m{.*::(.*)}g;

    my $object_method = $caller_class->can($wanted_method);
    goto $object_method if $object_method;

    if ( my $autoload = $caller_class->can('AUTOLOAD') ) {
        require B;
        my $autoload_class = B::svref_2object($autoload)->GV->STASH->NAME;

        no strict 'refs';
        ${"${autoload_class}::AUTOLOAD"} = "${caller_class}::$wanted_method";

        goto $autoload;
    }

    croak(
        qq{Can't locate object method "$wanted_method"},
        qq{ via package "$caller_class"},
    );
}

1;
__END__

=head1 NAME

CURRENT - Alias of current class

=head1 SYNOPSIS

    package LONG::LONG::LONG::LONG::Class;

    require CURRENT;

    sub _my_method {}

    $self->CURRENT::_my_method();
    # same as
    $self->LONG::LONG::LONG::LONG::Class::_my_method();

=head1 DESCRIPTION

CURRENT.pm adds class C<CURRENT>. When a method C<m> is called as
C<< $self->CURRENT::m >>, C<__PACKAGE__::m> is called.

Note that C<CURRENT> only supports calling method.

This helps calling a local method in a long name class.

CURRENT.pm supports C<AUTOLOAD>, also.

=head1 AUTHOR

Yuji Tamashiro, E<lt>yuji@tamashiro.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2007 by Yuji Tamashiro

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

=cut