line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Module::New::Loader; |
2
|
|
|
|
|
|
|
|
3
|
7
|
|
|
7
|
|
19272
|
use strict; |
|
7
|
|
|
|
|
10
|
|
|
7
|
|
|
|
|
206
|
|
4
|
7
|
|
|
7
|
|
22
|
use warnings; |
|
7
|
|
|
|
|
11
|
|
|
7
|
|
|
|
|
127
|
|
5
|
7
|
|
|
7
|
|
34
|
use Carp; |
|
7
|
|
|
|
|
7
|
|
|
7
|
|
|
|
|
372
|
|
6
|
7
|
|
|
7
|
|
2596
|
use String::CamelCase qw( camelize ); |
|
7
|
|
|
|
|
2577
|
|
|
7
|
|
|
|
|
2449
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
sub new { |
9
|
33
|
|
|
33
|
1
|
2938
|
my ($class, @base) = @_; |
10
|
33
|
50
|
|
|
|
68
|
unless ( grep { $_ eq 'Module::New' } @base ) { |
|
30
|
|
|
|
|
132
|
|
11
|
33
|
|
|
|
|
67
|
push @base, 'Module::New'; |
12
|
|
|
|
|
|
|
} |
13
|
33
|
|
|
|
|
153
|
bless { _base => \@base }, $class; |
14
|
|
|
|
|
|
|
} |
15
|
|
|
|
|
|
|
|
16
|
160
|
|
|
160
|
|
188
|
sub _base { @{ shift->{_base} } } |
|
160
|
|
|
|
|
691
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub load_class { |
19
|
160
|
|
|
160
|
1
|
378
|
my ($self, @parts) = @_; |
20
|
|
|
|
|
|
|
|
21
|
220
|
|
|
|
|
1252
|
@parts = map { tr/a-zA-Z0-9_://cd; camelize( $_ ); } |
|
220
|
|
|
|
|
649
|
|
|
292
|
|
|
|
|
627
|
|
22
|
160
|
|
|
|
|
409
|
grep { defined } @parts; |
23
|
|
|
|
|
|
|
|
24
|
160
|
|
|
|
|
2204
|
foreach my $base ( $self->_base ) { |
25
|
294
|
|
|
|
|
679
|
my $package = join '::', $base, @parts; |
26
|
|
|
|
|
|
|
|
27
|
294
|
100
|
|
|
|
863
|
if ( $self->{_reload} ) { |
28
|
118
|
|
|
|
|
559
|
(my $file = $package) =~ s|::|/|g; |
29
|
118
|
|
|
|
|
387
|
delete $INC{"$file.pm"}; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
294
|
|
|
|
|
286
|
local $@; |
33
|
294
|
|
|
|
|
20680
|
eval "require $package; $package->import;"; |
34
|
294
|
100
|
|
|
|
2476
|
if ( $@ ) { |
35
|
134
|
50
|
|
|
|
935
|
next if $@ =~ /^Can't locate/; |
36
|
0
|
|
|
|
|
0
|
croak $@; |
37
|
|
|
|
|
|
|
} |
38
|
160
|
|
|
|
|
1147
|
return $package; |
39
|
|
|
|
|
|
|
} |
40
|
0
|
|
|
|
|
0
|
croak "Can't locate ".(join '::', @parts); |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub reload_class { |
44
|
59
|
|
|
59
|
1
|
75
|
my $self = shift; |
45
|
|
|
|
|
|
|
|
46
|
59
|
|
|
|
|
162
|
local $self->{_reload} = 1; |
47
|
|
|
|
|
|
|
|
48
|
59
|
|
|
|
|
215
|
$self->load_class(@_); |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub load { |
52
|
73
|
|
|
73
|
1
|
160
|
my ($self, $type, $name, @args) = @_; |
53
|
|
|
|
|
|
|
|
54
|
73
|
|
|
|
|
187
|
$self->load_class($type, $name)->new(@args); |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
1; |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
__END__ |