annotate 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
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
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
5 use IMPL::lang qw(:declare :constants);
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
6
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' => '@_'
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
15 }
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
16 };
165
76515373dac0 Added Class::Template,
wizard
parents:
diff changeset
17
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
18 my $default;
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
19 sub default {
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
20 $default ||= new IMPL::Code::Loader;
165
76515373dac0 Added Class::Template,
wizard
parents:
diff changeset
21 }
76515373dac0 Added Class::Template,
wizard
parents:
diff changeset
22
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
23 my $safe;
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
24 sub safe {
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
25 $safe ||= new IMPL::Code::Loader(verifyNames => 1);
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
26 }
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
27
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
28 BEGIN {
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
29 public property verifyNames => PROP_GET | PROP_OWNERSET;
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
30 public property prefix => PROP_GET | PROP_OWNERSET;
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
31 }
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
32
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
33
165
76515373dac0 Added Class::Template,
wizard
parents:
diff changeset
34 sub Require {
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
35 my ($this,$package) = @_;
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
36
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
37 if ($this->verifyNames) {
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
38 $package =~ m/^([a-zA-Z_0-9]+(?:::[a-zA-Z_0-9]+)*)$/ or die ArgumentException->new("package") ;
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
39 }
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
40
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
41 $package = $this->prefix . $package if $this->prefix;
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
42
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
43 my $file = join('/', split(/::/,$package)) . ".pm";
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 165
diff changeset
44
209
a8db61d0ed33 IMPL::Class::Meta refactoring
cin
parents: 194
diff changeset
45 require $file;
165
76515373dac0 Added Class::Template,
wizard
parents:
diff changeset
46 }
76515373dac0 Added Class::Template,
wizard
parents:
diff changeset
47
76515373dac0 Added Class::Template,
wizard
parents:
diff changeset
48 1;
76515373dac0 Added Class::Template,
wizard
parents:
diff changeset
49