annotate lib/IMPL/Code/Loader.pm @ 417:3ed0c58e9da3 ref20150831

working on di container, tests
author cin
date Mon, 02 Nov 2015 01:56:53 +0300
parents ee36115f6a34
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
407
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
1 package IMPL::Code::Loader;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
2 use strict;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
3 use warnings;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
4
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
5 use IMPL::Const qw(:prop);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
6 use File::Spec;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
7 use IMPL::declare {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
8 require => {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
9 Exception => 'IMPL::Exception',
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
10 ArgumentException => '-IMPL::InvalidArgumentException'
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
11 },
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
12 base => {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
13 'IMPL::Object' => undef,
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
14 },
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
15 props => [
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
16 verifyNames => PROP_RO,
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
17 prefix => PROP_RO,
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
18 _pending => PROP_RW
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
19 ]
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
20 };
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
21
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
22 my $default;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
23 sub default {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
24 $default ||= new IMPL::Code::Loader;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
25 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
26
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
27 my $safe;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
28 sub safe {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
29 $safe ||= new IMPL::Code::Loader(verifyNames => 1);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
30 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
31
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
32 sub CTOR {
411
cin
parents: 407
diff changeset
33 my ($this, %params) = @_;
cin
parents: 407
diff changeset
34
cin
parents: 407
diff changeset
35 $this->verifyNames($params{verifyNames}) if $params{verifyNames};
cin
parents: 407
diff changeset
36 $this->prefix($params{prefix}) if $params{prefix};
cin
parents: 407
diff changeset
37
407
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
38
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
39 $this->_pending({});
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
40 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
41
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
42 sub Require {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
43 my ($this,$package) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
44
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
45 if ($this->verifyNames) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
46 $package =~ m/^([a-zA-Z_0-9]+(?:::[a-zA-Z_0-9]+)*)$/
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
47 or die ArgumentException->new(package => 'Invalid package name') ;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
48 $package = $1;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
49 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
50
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
51 $package = $this->prefix . '::' . $package if $this->prefix;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
52
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
53 my $file = join('/', split(/::/,$package)) . ".pm";
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
54
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
55 require $file;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
56
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
57 return $package;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
58 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
59
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
60 sub ModuleExists {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
61 my ($this,$package) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
62
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
63 my $file = join('/', split(/::/,$this->GetFullName($package))) . ".pm";
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
64
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
65 -f File::Spec->catfile($_,$file) and return 1 foreach @INC;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
66
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
67 return 0;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
68 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
69
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
70 sub GetFullName {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
71 my ($this,$package) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
72
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
73 if ($this->verifyNames) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
74 $package =~ m/^([a-zA-Z_0-9]+(?:::[a-zA-Z_0-9]+)*)$/
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
75 or die ArgumentException->new(package => 'Invalid package name') ;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
76 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
77
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
78 return $this->prefix . '::' . $package if $this->prefix;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
79 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
80
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
81 1;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
82