File Coverage

blib/lib/Sub/Alias.pm

Criterion	Covered	Total	%
statement	41	41	100.0
branch	6	6	100.0
condition	3	6	50.0
subroutine	10	10	100.0
pod	1	1	100.0
total	61	64	95.3

package Sub::Alias;
use warnings;
use strict;
use 5.008;

use Sub::Exporter -setup => {
    exports => [ 'alias' ],
    groups => { default => [ 'alias' ] }
};

use Devel::BeginLift qw(alias);

use Devel::Declare qw();

our $VERSION = '0.03';

sub alias {
    my ($new_name, $old_name) = @_;
    my $caller = caller;

    if (defined($new_name) && defined($old_name)) {
        _alias($new_name, $old_name, $caller);
    }
    else {
        my $line = Devel::Declare::get_linestr;
        my $offset = Devel::Declare::get_linestr_offset;

        my $line2 = $line;
        if ($line2 =~ s/alias/Sub::Alias::_alias/) {
            substr($line, $offset, 0) = $line2;
            Devel::Declare::set_linestr($line);
        }
    }
    return 1;
}


sub _alias {
    my ($new_name, $old_name, $caller) = @_;
    $caller ||= caller;

    no strict;
    no warnings;
    *{"$caller\::${new_name}"} = ref($old_name) ? $old_name : *{"$caller\::${old_name}"};

    return 1;
}

1;

__END__