Mercurial > pub > Impl
comparison Lib/IMPL/Code/Loader.pm @ 209:a8db61d0ed33
IMPL::Class::Meta refactoring
author | cin |
---|---|
date | Mon, 28 May 2012 19:58:56 +0400 |
parents | 4d0e1962161c |
children | 47f77e6409f7 |
comparison
equal
deleted
inserted
replaced
208:3d433a977e3b | 209:a8db61d0ed33 |
---|---|
1 package IMPL::Code::Loader; | 1 package IMPL::Code::Loader; |
2 use strict; | 2 use strict; |
3 use warnings; | 3 use warnings; |
4 | 4 |
5 my %packages; | 5 use IMPL::lang qw(:declare :constants); |
6 | 6 |
7 sub Provide { | 7 use IMPL::declare { |
8 my ($self,$package) = @_; | 8 require => { |
9 | 9 Exception => 'IMPL::Exception', |
10 my ($declaringPackage,$file) = caller(); | 10 ArgumentException => '-IMPL::InvalidArgumentException' |
11 $packages{$package} = { declaringPackage => $declaringPackage, file => $file, evidence => 'provide' }; | 11 }, |
12 base => { | |
13 'IMPL::Object' => undef, | |
14 'IMPL::Object::Autofill' => '@_' | |
15 } | |
16 }; | |
17 | |
18 my $default; | |
19 sub default { | |
20 $default ||= new IMPL::Code::Loader; | |
12 } | 21 } |
13 | 22 |
23 my $safe; | |
24 sub safe { | |
25 $safe ||= new IMPL::Code::Loader(verifyNames => 1); | |
26 } | |
27 | |
28 BEGIN { | |
29 public property verifyNames => PROP_GET | PROP_OWNERSET; | |
30 public property prefix => PROP_GET | PROP_OWNERSET; | |
31 } | |
32 | |
33 | |
14 sub Require { | 34 sub Require { |
15 my ($self,$package) = @_; | 35 my ($this,$package) = @_; |
16 | 36 |
17 return 1 if $packages{$package}; | 37 if ($this->verifyNames) { |
38 $package =~ m/^([a-zA-Z_0-9]+(?:::[a-zA-Z_0-9]+)*)$/ or die ArgumentException->new("package") ; | |
39 } | |
18 | 40 |
19 if (my $file = $INC{$package}) { | 41 $package = $this->prefix . $package if $this->prefix; |
20 $packages{$package} = { file => $file, evidence => 'inc' }; | |
21 return 1; | |
22 } | |
23 | 42 |
24 undef $@; | 43 my $file = join('/', split(/::/,$package)) . ".pm"; |
25 | 44 |
26 if ( eval "require $package; 1;" and not $packages{$package}) { | 45 require $file; |
27 $packages{$package} = { file => $INC{$package}, evidence => 'inc' }; | |
28 }; | |
29 | |
30 die $@ if $@ and not $!; | |
31 } | 46 } |
32 | 47 |
33 1; | 48 1; |
34 | 49 |