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