Mercurial > pub > Impl

comparison Lib/IMPL/require.pm @ 251:9f394b27dccf

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
require can handle recursive module references
author sergey
date Fri, 16 Nov 2012 16:44:16 +0400
parents b8c724f6de36
children 34a3f8668b58
comparison
equal deleted inserted replaced
250:129e48bb5afb 251:9f394b27dccf
1 package IMPL::require; 1 package IMPL::require;
2 use Scalar::Util qw(set_prototype); 2 use Scalar::Util qw(set_prototype);
3 use strict; 3 use strict;
4 require IMPL::Code::Loader; 4 #require IMPL::Code::Loader;
5
6 our %PENDING;
7 our $LOADER_LOG;
8
9 our $level = 0;
5 10
6 sub import { 11 sub import {
7 my ($self, $aliases) = @_; 12 my ($self, $aliases) = @_;
8 13
9 return unless $aliases; 14 return unless $aliases;
13 my $caller = caller; 18 my $caller = caller;
14 19
15 no strict 'refs'; 20 no strict 'refs';
16 21
17 while( my ($alias, $class) = each %$aliases ) { 22 while( my ($alias, $class) = each %$aliases ) {
23 _trace("$alias => $class");
24 $level++;
25
18 $class = _require($class); 26 $class = _require($class);
19 27
20 *{"${caller}::$alias"} = set_prototype(sub { 28 *{"${caller}::$alias"} = set_prototype(sub {
21 $class 29 $class
22 }, ''); 30 }, '');
31
32 $level--;
23 } 33 }
24 } 34 }
25 35
26 sub _require { 36 sub _require {
27 my ($class) = @_; 37 my ($class) = @_;
28 38
29 if ( not $class =~ s/^-// ) { 39 if ( not $class =~ s/^-// ) {
30 ( my $file = $class ) =~ s/::|'/\//g; 40 ( my $file = $class ) =~ s/::|'/\//g;
41 _trace("already pending") and return
42 if $PENDING{$class};
43 $PENDING{$class} = 1;
44 _trace("loading $file.pm");
45 $level++;
31 require "$file.pm"; 46 require "$file.pm";
47 $level--;
48 _trace("loaded $file.pm");
49 delete $PENDING{$class};
32 } 50 }
33 $class; 51 $class;
52 }
53
54 sub _trace {
55 my ($message) = @_;
56
57 $LOADER_LOG->print("\t" x $level ,"$message\n") if $LOADER_LOG;
58
59 return 1;
34 } 60 }
35 61
36 1; 62 1;
37 63
38 __END__ 64 __END__