Mercurial > pub > Impl
diff lib/IMPL/require.pm @ 427:09e0086a82a7 ref20150831 tip
Merge
author | cin |
---|---|
date | Tue, 15 May 2018 00:51:33 +0300 |
parents | c27434cdd611 |
children |
line wrap: on
line diff
--- a/lib/IMPL/require.pm Tue May 15 00:51:01 2018 +0300 +++ b/lib/IMPL/require.pm Tue May 15 00:51:33 2018 +0300 @@ -11,27 +11,50 @@ our $level = 0; sub import { - my ( $self, $aliases ) = @_; + my $self = shift; + + my $aliases; - return unless $aliases; - - die "A hash reference is required" unless ref $aliases eq 'HASH'; + if ( @_ == 1 ) { + my $aliases = shift; + die "A hash reference is required" unless ref $aliases eq 'HASH'; + } + else { + die "A list of pairs is expected" unless @_ % 2 == 0; + $aliases = {@_}; + } my $caller = caller; $PENDING{$caller} = 1; no strict 'refs'; + while ( my ( $alias, $spec ) = each %$aliases ) { + my ( $mode, $class ) = m/^(-|~)(.*)/; - while ( my ( $alias, $class ) = each %$aliases ) { - _trace("$alias => $class"); + _trace("$alias => $spec [$class]"); + + $class =~ s/^SELF(?=\W|$)/${caller}::/; $level++; - my $c = _require($class); - - *{"${caller}::$alias"} = sub () { - $c; - }; + if ( $mode eq '-' ) { + *{"${caller}::$alias"} = sub () { + $class; + }; + } + elsif ( $mode eq '~' ) { + *{"${caller}::$alias"} = sub () { + my $c = _require($class); + *{"${caller}::$alias"} = sub() { $c }; + return $c; + }; + } + else { + my $c = _require($class); + *{"${caller}::$alias"} = sub () { + $c; + }; + } $level--; }