comparison lib/IMPL/require.pm @ 427:09e0086a82a7 ref20150831 tip

Merge
author cin
date Tue, 15 May 2018 00:51:33 +0300
parents c27434cdd611
children
comparison
equal deleted inserted replaced
426:eed50c01e758 427:09e0086a82a7
9 our $LOADER_LOG; 9 our $LOADER_LOG;
10 10
11 our $level = 0; 11 our $level = 0;
12 12
13 sub import { 13 sub import {
14 my ( $self, $aliases ) = @_; 14 my $self = shift;
15 15
16 return unless $aliases; 16 my $aliases;
17 17
18 die "A hash reference is required" unless ref $aliases eq 'HASH'; 18 if ( @_ == 1 ) {
19 my $aliases = shift;
20 die "A hash reference is required" unless ref $aliases eq 'HASH';
21 }
22 else {
23 die "A list of pairs is expected" unless @_ % 2 == 0;
24 $aliases = {@_};
25 }
19 26
20 my $caller = caller; 27 my $caller = caller;
21 28
22 $PENDING{$caller} = 1; 29 $PENDING{$caller} = 1;
23 30
24 no strict 'refs'; 31 no strict 'refs';
32 while ( my ( $alias, $spec ) = each %$aliases ) {
33 my ( $mode, $class ) = m/^(-|~)(.*)/;
25 34
26 while ( my ( $alias, $class ) = each %$aliases ) { 35 _trace("$alias => $spec [$class]");
27 _trace("$alias => $class"); 36
37 $class =~ s/^SELF(?=\W|$)/${caller}::/;
28 $level++; 38 $level++;
29 39
30 my $c = _require($class); 40 if ( $mode eq '-' ) {
31 41 *{"${caller}::$alias"} = sub () {
32 *{"${caller}::$alias"} = sub () { 42 $class;
33 $c; 43 };
34 }; 44 }
45 elsif ( $mode eq '~' ) {
46 *{"${caller}::$alias"} = sub () {
47 my $c = _require($class);
48 *{"${caller}::$alias"} = sub() { $c };
49 return $c;
50 };
51 }
52 else {
53 my $c = _require($class);
54 *{"${caller}::$alias"} = sub () {
55 $c;
56 };
57 }
35 58
36 $level--; 59 $level--;
37 } 60 }
38 61
39 delete $PENDING{$caller}; 62 delete $PENDING{$caller};