File Coverage

blib/lib/Mic/Implementation.pm
Criterion Covered Total %
statement 40 40 100.0
branch 2 2 100.0
condition 1 3 33.3
subroutine 11 11 100.0
pod 0 5 0.0
total 54 61 88.5


line stmt bran cond sub pod time code
1             package Mic::Implementation;
2              
3 33     33   12256 use strict;
  33         59  
  33         864  
4 33     33   176 use Mic::_Guts;
  33         56  
  33         559  
5 33     33   137 use Package::Stash;
  33         57  
  33         703  
6 33     33   189 use Params::Validate qw(:all);
  33         61  
  33         4870  
7 33     33   7330 use Readonly;
  33         74636  
  33         10952  
8              
9             sub import {
10 49     49   1987 my $class = shift;
11              
12 49         1018 my %arg = validate(@_, {
13             has => { type => HASHREF },
14             classmethod => { type => ARRAYREF, optional => 1 },
15             });
16              
17 49         422 strict->import();
18              
19 49         178 $arg{-caller} = (caller)[0];
20 49         646 $class->define(%arg);
21             }
22              
23             sub define {
24 49     49 0 170 my ($class, %arg) = @_;
25              
26 49   33     178 my $caller_pkg = delete $arg{-caller} || (caller)[0];
27 49         541 my $stash = Package::Stash->new($caller_pkg);
28              
29 49         180 $class->update_args(\%arg);
30 49         140 $class->add_attribute_syms(\%arg, $stash);
31              
32 49         292 $stash->add_symbol('%__meta__', \%arg);
33 49         155 $class->install_subs($stash);
34             }
35              
36             sub add_attribute_syms {
37 40     40 0 85 my ($class, $arg, $stash) = @_;
38              
39             my @slots = (
40 40         62 keys %{ $arg->{has} },
  40         133  
41             '', # semiprivate pkg
42             );
43 40         90 foreach my $slot ( @slots ) {
44 94         239 $class->add_obfu_name($arg, $stash, $slot);
45             }
46             }
47              
48             sub add_obfu_name {
49 94     94 0 209 my ($class, $arg, $stash, $slot) = @_;
50              
51             Readonly my $sym_val => sprintf(
52             "%s-$slot",
53 94         414 Mic::_Guts::attribute_sym($arg->{version}),
54             );
55 94         8875 $Mic::_Guts::obfu_name{$slot} = $sym_val;
56              
57 94         608 my $prefix = '';
58 94 100       210 if($slot eq '') {
59 40         82 $prefix = '__';
60             }
61             else {
62 54         127 $slot = uc $slot;
63             }
64 94         1116 $stash->add_symbol(
65             sprintf('$%s%s', $prefix, $slot),
66             \ $sym_val
67             );
68             }
69              
70       40 0   sub update_args {}
71              
72       49 0   sub install_subs {}
73              
74             1;
75              
76             __END__