Mercurial > pub > Impl
diff lib/IMPL/Code/Loader.pm @ 407:c6e90e02dd17 ref20150831
renamed Lib->lib
author | cin |
---|---|
date | Fri, 04 Sep 2015 19:40:23 +0300 |
parents | |
children | ee36115f6a34 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/IMPL/Code/Loader.pm Fri Sep 04 19:40:23 2015 +0300 @@ -0,0 +1,79 @@ +package IMPL::Code::Loader; +use strict; +use warnings; + +use IMPL::Const qw(:prop); +use File::Spec; +use IMPL::declare { + require => { + Exception => 'IMPL::Exception', + ArgumentException => '-IMPL::InvalidArgumentException' + }, + base => { + 'IMPL::Object' => undef, + 'IMPL::Object::Autofill' => '@_' + }, + props => [ + verifyNames => PROP_RO, + prefix => PROP_RO, + _pending => PROP_RW + ] +}; + +my $default; +sub default { + $default ||= new IMPL::Code::Loader; +} + +my $safe; +sub safe { + $safe ||= new IMPL::Code::Loader(verifyNames => 1); +} + +sub CTOR { + my ($this) = @_; + + $this->_pending({}); +} + +sub Require { + my ($this,$package) = @_; + + if ($this->verifyNames) { + $package =~ m/^([a-zA-Z_0-9]+(?:::[a-zA-Z_0-9]+)*)$/ + or die ArgumentException->new(package => 'Invalid package name') ; + $package = $1; + } + + $package = $this->prefix . '::' . $package if $this->prefix; + + my $file = join('/', split(/::/,$package)) . ".pm"; + + require $file; + + return $package; +} + +sub ModuleExists { + my ($this,$package) = @_; + + my $file = join('/', split(/::/,$this->GetFullName($package))) . ".pm"; + + -f File::Spec->catfile($_,$file) and return 1 foreach @INC; + + return 0; +} + +sub GetFullName { + my ($this,$package) = @_; + + if ($this->verifyNames) { + $package =~ m/^([a-zA-Z_0-9]+(?:::[a-zA-Z_0-9]+)*)$/ + or die ArgumentException->new(package => 'Invalid package name') ; + } + + return $this->prefix . '::' . $package if $this->prefix; +} + +1; +