line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Mic; |
2
|
|
|
|
|
|
|
|
3
|
34
|
|
|
34
|
|
443217
|
use strict; |
|
34
|
|
|
|
|
104
|
|
|
34
|
|
|
|
|
950
|
|
4
|
34
|
|
|
34
|
|
898
|
use 5.008_005; |
|
34
|
|
|
|
|
118
|
|
5
|
34
|
|
|
34
|
|
202
|
use Carp; |
|
34
|
|
|
|
|
59
|
|
|
34
|
|
|
|
|
2497
|
|
6
|
34
|
|
|
34
|
|
19509
|
use Params::Validate qw(:all); |
|
34
|
|
|
|
|
334534
|
|
|
34
|
|
|
|
|
7127
|
|
7
|
34
|
|
|
34
|
|
17930
|
use Mic::Assembler; |
|
34
|
|
|
|
|
161
|
|
|
34
|
|
|
|
|
17377
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our $VERSION = '0.001004'; |
10
|
|
|
|
|
|
|
$VERSION = eval $VERSION; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
my $Class_count = 0; |
13
|
|
|
|
|
|
|
our %Bound_implementation_of; |
14
|
|
|
|
|
|
|
our %Contracts_for; |
15
|
|
|
|
|
|
|
our %Spec_for; |
16
|
|
|
|
|
|
|
our %Util_class; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub import { |
19
|
2
|
|
|
2
|
|
187
|
strict->import(); |
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub load_class { |
23
|
2
|
|
|
2
|
1
|
108
|
my ($class, $spec) = @_; |
24
|
|
|
|
|
|
|
|
25
|
2
|
|
66
|
|
|
10
|
$spec->{name} ||= "Mic::Class_${\ ++$Class_count }"; |
|
1
|
|
|
|
|
8
|
|
26
|
2
|
|
|
|
|
7
|
$class->assemble($spec); |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub assemble { |
30
|
51
|
|
|
51
|
0
|
372
|
my (undef, $spec) = @_; |
31
|
|
|
|
|
|
|
|
32
|
51
|
|
|
|
|
293
|
my $assembler = Mic::Assembler->new(-spec => $spec); |
33
|
51
|
|
|
|
|
114
|
my $cls_stash; |
34
|
51
|
100
|
|
|
|
204
|
if ( ! $spec->{name} ) { |
35
|
49
|
|
|
|
|
102
|
my $depth = 0; |
36
|
49
|
|
|
|
|
99
|
my $caller_pkg = ''; |
37
|
49
|
|
|
|
|
98
|
my $pkg = __PACKAGE__; |
38
|
|
|
|
|
|
|
|
39
|
49
|
|
|
|
|
90
|
do { |
40
|
93
|
|
|
|
|
1581
|
$caller_pkg = (caller $depth++)[0]; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
while $caller_pkg =~ /^$pkg\b/; |
43
|
49
|
|
|
|
|
680
|
$spec = $assembler->load_spec_from($caller_pkg); |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
51
|
|
|
|
|
183
|
_check_imp_aliases($spec); |
47
|
51
|
|
|
|
|
181
|
my @args = %$spec; |
48
|
51
|
|
|
|
|
2242
|
validate(@args, { |
49
|
|
|
|
|
|
|
interface => { type => HASHREF | SCALAR }, |
50
|
|
|
|
|
|
|
implementation => { type => SCALAR }, |
51
|
|
|
|
|
|
|
name => { type => SCALAR, optional => 1 }, |
52
|
|
|
|
|
|
|
}); |
53
|
51
|
|
|
|
|
471
|
return $assembler->assemble; |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
sub _check_imp_aliases { |
57
|
51
|
|
|
51
|
|
120
|
my ($spec) = @_; |
58
|
|
|
|
|
|
|
|
59
|
51
|
|
|
|
|
145
|
my @imp_aliases = qw[via impl]; |
60
|
51
|
|
|
|
|
128
|
foreach my $k (@imp_aliases) { |
61
|
101
|
50
|
66
|
|
|
351
|
if (! exists $spec->{implementation} && exists $spec->{$k}) { |
62
|
1
|
|
|
|
|
2
|
$spec->{implementation} = $spec->{$k}; |
63
|
1
|
|
|
|
|
2
|
delete @{$spec}{ @imp_aliases }; |
|
1
|
|
|
|
|
3
|
|
64
|
1
|
|
|
|
|
2
|
last; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
*setup_class = \&assemble; |
70
|
|
|
|
|
|
|
*define_class = \&assemble; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
sub builder_for { |
73
|
54
|
|
|
54
|
0
|
307
|
my ($class) = @_; |
74
|
|
|
|
|
|
|
|
75
|
54
|
0
|
|
|
|
268
|
return $Util_class{ $class } |
76
|
|
|
|
|
|
|
or confess "Unknown class: $class"; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
1; |
80
|
|
|
|
|
|
|
__END__ |