Mercurial > pub > Impl

comparison lib/IMPL/Code/Loader.pm @ 407:c6e90e02dd17 ref20150831

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children ee36115f6a34
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
1 package IMPL::Code::Loader;
2 use strict;
3 use warnings;
4
5 use IMPL::Const qw(:prop);
6 use File::Spec;
7 use IMPL::declare {
8 require => {
9 Exception => 'IMPL::Exception',
10 ArgumentException => '-IMPL::InvalidArgumentException'
11 },
12 base => {
13 'IMPL::Object' => undef,
14 'IMPL::Object::Autofill' => '@_'
15 },
16 props => [
17 verifyNames => PROP_RO,
18 prefix => PROP_RO,
19 _pending => PROP_RW
20 ]
21 };
22
23 my $default;
24 sub default {
25 $default ||= new IMPL::Code::Loader;
26 }
27
28 my $safe;
29 sub safe {
30 $safe ||= new IMPL::Code::Loader(verifyNames => 1);
31 }
32
33 sub CTOR {
34 my ($this) = @_;
35
36 $this->_pending({});
37 }
38
39 sub Require {
40 my ($this,$package) = @_;
41
42 if ($this->verifyNames) {
43 $package =~ m/^([a-zA-Z_0-9]+(?:::[a-zA-Z_0-9]+)*)$/
44 or die ArgumentException->new(package => 'Invalid package name') ;
45 $package = $1;
46 }
47
48 $package = $this->prefix . '::' . $package if $this->prefix;
49
50 my $file = join('/', split(/::/,$package)) . ".pm";
51
52 require $file;
53
54 return $package;
55 }
56
57 sub ModuleExists {
58 my ($this,$package) = @_;
59
60 my $file = join('/', split(/::/,$this->GetFullName($package))) . ".pm";
61
62 -f File::Spec->catfile($_,$file) and return 1 foreach @INC;
63
64 return 0;
65 }
66
67 sub GetFullName {
68 my ($this,$package) = @_;
69
70 if ($this->verifyNames) {
71 $package =~ m/^([a-zA-Z_0-9]+(?:::[a-zA-Z_0-9]+)*)$/
72 or die ArgumentException->new(package => 'Invalid package name') ;
73 }
74
75 return $this->prefix . '::' . $package if $this->prefix;
76 }
77
78 1;
79