Mercurial > pub > Impl
diff 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 |
line wrap: on
line diff
--- a/Lib/IMPL/Code/Loader.pm Fri May 18 18:43:00 2012 +0400 +++ b/Lib/IMPL/Code/Loader.pm Mon May 28 19:58:56 2012 +0400 @@ -2,32 +2,47 @@ use strict; use warnings; -my %packages; +use IMPL::lang qw(:declare :constants); + +use IMPL::declare { + require => { + Exception => 'IMPL::Exception', + ArgumentException => '-IMPL::InvalidArgumentException' + }, + base => { + 'IMPL::Object' => undef, + 'IMPL::Object::Autofill' => '@_' + } +}; -sub Provide { - my ($self,$package) = @_; - - my ($declaringPackage,$file) = caller(); - $packages{$package} = { declaringPackage => $declaringPackage, file => $file, evidence => 'provide' }; +my $default; +sub default { + $default ||= new IMPL::Code::Loader; } +my $safe; +sub safe { + $safe ||= new IMPL::Code::Loader(verifyNames => 1); +} + +BEGIN { + public property verifyNames => PROP_GET | PROP_OWNERSET; + public property prefix => PROP_GET | PROP_OWNERSET; +} + + sub Require { - my ($self,$package) = @_; + my ($this,$package) = @_; - return 1 if $packages{$package}; + if ($this->verifyNames) { + $package =~ m/^([a-zA-Z_0-9]+(?:::[a-zA-Z_0-9]+)*)$/ or die ArgumentException->new("package") ; + } - if (my $file = $INC{$package}) { - $packages{$package} = { file => $file, evidence => 'inc' }; - return 1; - } + $package = $this->prefix . $package if $this->prefix; - undef $@; + my $file = join('/', split(/::/,$package)) . ".pm"; - if ( eval "require $package; 1;" and not $packages{$package}) { - $packages{$package} = { file => $INC{$package}, evidence => 'inc' }; - }; - - die $@ if $@ and not $!; + require $file; } 1;