Mercurial > pub > Impl
comparison lib/IMPL/require.pm @ 407:c6e90e02dd17 ref20150831
renamed Lib->lib
author | cin |
---|---|
date | Fri, 04 Sep 2015 19:40:23 +0300 |
parents | |
children | b0481c071bea |
comparison
equal
deleted
inserted
replaced
406:f23fcb19d3c1 | 407:c6e90e02dd17 |
---|---|
1 package IMPL::require; | |
2 use strict; | |
3 | |
4 #require IMPL::Code::Loader; | |
5 | |
6 use Carp qw(carp); | |
7 | |
8 our %PENDING; | |
9 our $LOADER_LOG; | |
10 | |
11 our $level = 0; | |
12 | |
13 sub import { | |
14 my ( $self, $aliases ) = @_; | |
15 | |
16 return unless $aliases; | |
17 | |
18 die "A hash reference is required" unless ref $aliases eq 'HASH'; | |
19 | |
20 my $caller = caller; | |
21 | |
22 $PENDING{$caller} = 1; | |
23 | |
24 no strict 'refs'; | |
25 | |
26 while ( my ( $alias, $class ) = each %$aliases ) { | |
27 _trace("$alias => $class"); | |
28 $level++; | |
29 | |
30 $class = _require($class); | |
31 | |
32 *{"${caller}::$alias"} = sub () { | |
33 $class; | |
34 }; | |
35 | |
36 $level--; | |
37 } | |
38 | |
39 delete $PENDING{$caller}; | |
40 } | |
41 | |
42 sub _require { | |
43 my ($class) = @_; | |
44 | |
45 if ( not $class =~ s/^-// ) { | |
46 ( my $file = $class ) =~ s/::|'/\//g; | |
47 _trace("already pending") and return $class | |
48 if $PENDING{$class}; | |
49 $PENDING{$class} = 1; | |
50 _trace("loading $file.pm"); | |
51 $level++; | |
52 require "$file.pm"; | |
53 $level--; | |
54 _trace("loaded $file.pm"); | |
55 delete $PENDING{$class}; | |
56 } | |
57 $class; | |
58 } | |
59 | |
60 sub _trace { | |
61 my ($message) = @_; | |
62 | |
63 $LOADER_LOG->print( "\t" x $level, "$message\n" ) if $LOADER_LOG; | |
64 | |
65 return 1; | |
66 } | |
67 | |
68 1; | |
69 | |
70 __END__ | |
71 | |
72 =pod | |
73 | |
74 =head1 NAME | |
75 | |
76 C<IMPL::require> загружает и назначет псевдонимы модулям. | |
77 | |
78 =head1 SYNOPSIS | |
79 | |
80 =begin code | |
81 | |
82 use IMPL::require { | |
83 TFoo => 'My::Nested::Package::Foo', | |
84 FS => 'File::Spec' | |
85 }; | |
86 | |
87 my $obj = My::Nested::Package::Foo->new('foo'); | |
88 $obj = TFoo->new('foo'); # ditto | |
89 | |
90 FS->catdir('one','two','three'); | |
91 | |
92 =end code | |
93 | |
94 =head1 DESCRIPTION | |
95 | |
96 Загружает модули с помощью C<require> и создает константы которые возвращаю полное имя модуля. | |
97 | |
98 | |
99 =cut |