File Coverage

blib/lib/Mic.pm
Criterion Covered Total %
statement 43 43 100.0
branch 3 6 50.0
condition 4 6 66.6
subroutine 10 10 100.0
pod 1 3 33.3
total 61 68 89.7


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__