Mercurial > pub > Impl
diff lib/IMPL/require.pm @ 425:c27434cdd611 ref20150831
sync
author | cin |
---|---|
date | Tue, 03 Apr 2018 19:30:01 +0300 |
parents | b0481c071bea |
children |
line wrap: on
line diff
--- a/lib/IMPL/require.pm Tue Apr 03 10:54:09 2018 +0300 +++ b/lib/IMPL/require.pm Tue Apr 03 19:30:01 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--; }