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