annotate Lib/IMPL/Code/Loader.pm @ 393:69a1f1508696

minor security refactoring
author cin
date Fri, 14 Feb 2014 16:41:12 +0400
parents 4ddb27ff4a0b
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
165
76515373dac0 Added Class::Template,
wizard
parents:
diff changeset
1 package IMPL::Code::Loader;
76515373dac0 Added Class::Template,
wizard
parents:
diff changeset
2 use strict;
76515373dac0 Added Class::Template,
wizard
parents:
diff changeset
3 use warnings;
76515373dac0 Added Class::Template,
wizard
parents:
diff changeset
4
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
5 use IMPL::Const qw(:prop);
274
8d36073411b1 +Added AutoDispose class
cin
parents: 230
diff changeset
6 use File::Spec;
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
7 use IMPL::declare {
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
8 require => {
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
9 Exception => 'IMPL::Exception',
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
10 ArgumentException => '-IMPL::InvalidArgumentException'
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
11 },
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
12 base => {
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
13 'IMPL::Object' => undef,
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
14 'IMPL::Object::Autofill' => '@_'
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
15 },
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
16 props => [
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
17 verifyNames => PROP_RO,
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
18 prefix => PROP_RO,
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
19 _pending => PROP_RW
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
20 ]
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
21 };
165
76515373dac0 Added Class::Template,
wizard
parents:
diff changeset
22
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
23 my $default;
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
24 sub default {
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
25 $default ||= new IMPL::Code::Loader;
165
76515373dac0 Added Class::Template,
wizard
parents:
diff changeset
26 }
76515373dac0 Added Class::Template,
wizard
parents:
diff changeset
27
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
28 my $safe;
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
29 sub safe {
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
30 $safe ||= new IMPL::Code::Loader(verifyNames => 1);
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
31 }
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
32
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
33 sub CTOR {
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
34 my ($this) = @_;
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
35
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
36 $this->_pending({});
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
37 }
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
38
165
76515373dac0 Added Class::Template,
wizard
parents:
diff changeset
39 sub Require {
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
40 my ($this,$package) = @_;
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
41
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
42 if ($this->verifyNames) {
229
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
43 $package =~ m/^([a-zA-Z_0-9]+(?:::[a-zA-Z_0-9]+)*)$/
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
44 or die ArgumentException->new(package => 'Invalid package name') ;
278
4ddb27ff4a0b core refactoring
cin
parents: 274
diff changeset
45 $package = $1;
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
46 }
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
47
229
47f77e6409f7 heavily reworked the resource model of the web application:
sergey
parents: 209
diff changeset
48 $package = $this->prefix . '::' . $package if $this->prefix;
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
49
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
50 my $file = join('/', split(/::/,$package)) . ".pm";
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
51
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
52 require $file;
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
53
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
54 return $package;
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
55 }
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
56
274
8d36073411b1 +Added AutoDispose class
cin
parents: 230
diff changeset
57 sub ModuleExists {
8d36073411b1 +Added AutoDispose class
cin
parents: 230
diff changeset
58 my ($this,$package) = @_;
8d36073411b1 +Added AutoDispose class
cin
parents: 230
diff changeset
59
8d36073411b1 +Added AutoDispose class
cin
parents: 230
diff changeset
60 my $file = join('/', split(/::/,$this->GetFullName($package))) . ".pm";
8d36073411b1 +Added AutoDispose class
cin
parents: 230
diff changeset
61
8d36073411b1 +Added AutoDispose class
cin
parents: 230
diff changeset
62 -f File::Spec->catfile($_,$file) and return 1 foreach @INC;
8d36073411b1 +Added AutoDispose class
cin
parents: 230
diff changeset
63
8d36073411b1 +Added AutoDispose class
cin
parents: 230
diff changeset
64 return 0;
8d36073411b1 +Added AutoDispose class
cin
parents: 230
diff changeset
65 }
8d36073411b1 +Added AutoDispose class
cin
parents: 230
diff changeset
66
230
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
67 sub GetFullName {
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
68 my ($this,$package) = @_;
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
69
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
70 if ($this->verifyNames) {
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
71 $package =~ m/^([a-zA-Z_0-9]+(?:::[a-zA-Z_0-9]+)*)$/
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
72 or die ArgumentException->new(package => 'Invalid package name') ;
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
73 }
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
74
6d8092d8ce1b *reworked IMPL::Security
sergey
parents: 229
diff changeset
75 return $this->prefix . '::' . $package if $this->prefix;
165
76515373dac0 Added Class::Template,
wizard
parents:
diff changeset
76 }
76515373dac0 Added Class::Template,
wizard
parents:
diff changeset
77
76515373dac0 Added Class::Template,
wizard
parents:
diff changeset
78 1;
76515373dac0 Added Class::Template,
wizard
parents:
diff changeset
79