Mercurial > pub > Impl
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}; |