File Coverage

blib/lib/abbreviation.pm

Criterion	Covered	Total	%
statement	26	26	100.0
branch	6	8	75.0
condition	1	3	33.3
subroutine	5	5	100.0
pod			n/a
total	38	42	90.4

package abbreviation;

use strict;
use vars qw($VERSION);
$VERSION = '0.02';

sub import {
    my($class, @pkg) = @_;
    return unless @pkg;

    for my $pkg (@pkg) {
	eval qq(require $pkg);
	die if $@ && $@ !~ /^Can't locate .*? at \(eval /; #';
	my $abbr = _abbr($pkg) or next;
	no strict 'refs';
	*{$abbr . '::'} = *{$pkg . '::'};
    }
}

sub _abbr {
    my $pkg = shift;

    # Top level => nothing
    return unless $pkg =~ /::/;

    my @pkg = split /::/, $pkg;
    my $lastone = pop @pkg;

    # Mission:
    # Foo::Bar::Baz -> F::B::Baz
    # Foo::bar::Baz -> F::b::Baz
    # FooBar::Bar::Baz -> FB::B::Baz
    # FOO::Bar -> F::Bar
    return join '::', (map {
	s/^([A-Z])[A-Z0-9]+$/$1/; # FOO -> F
	tr/A-Z0-9//cd;
	$_;
    } @pkg), $lastone;
}

1;

__END__