Mercurial > pub > Impl
annotate lib/IMPL/require.pm @ 424:87af445663d7 ref20150831
IMPL::Object::_Base
| author | cin |
|---|---|
| date | Tue, 03 Apr 2018 10:54:09 +0300 |
| parents | b0481c071bea |
| children | c27434cdd611 |
| rev | line source |
|---|---|
| 407 | 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 | |
|
422
b0481c071bea
IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents:
407
diff
changeset
|
30 my $c = _require($class); |
| 407 | 31 |
| 32 *{"${caller}::$alias"} = sub () { | |
|
422
b0481c071bea
IMPL::Config::Container tests, YAMLConfiguration now works and tested
cin
parents:
407
diff
changeset
|
33 $c; |
| 407 | 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 |