File Coverage

blib/lib/HO/mixin.pm
Criterion Covered Total %
statement 48 55 87.2
branch 9 16 56.2
condition 7 11 63.6
subroutine 8 9 88.8
pod n/a
total 72 91 79.1


line stmt bran cond sub pod time code
1             package HO::mixin;
2             # ******************
3             our $VERSION = '0.02';
4             # ********************
5 1     1   470 ; use strict; use warnings
  1         2  
  1         29  
6              
7 1     1   9 ; use Carp ()
  1         2  
  1         23  
8 1     1   4 ; use Package::Subroutine ()
  1         2  
  1         12  
9 1     1   21 ; use Data::Dumper
  1         1  
  1         17  
10              
11 1     1   4 ; our $class
  1         2  
  1         549  
12              
13             ; sub import
14 3     3   37 { my ($self, $mixin, @args) = @_
15 3   33     16 ; my $class = $HO::mixin::class || CORE::caller
16 3         6 ; my ($without,$only)
17 3         8 ; while(@args)
18 1         2 { my $arg = shift @args
19 1 50       3 ; if( $arg eq 'without' )
20 1         2 { my %skip = map { $_ => 1 } @{shift(@args)}
  1         5  
  1         2  
21 2     2   6 ; $without = sub { !$skip{$_[0]} }
22 1         4 }
23 1 50       3 ; if( $arg eq 'only' )
24 0         0 { my %only = map { $_ => 1 } @{shift(@args)}
  0         0  
  0         0  
25 0     0   0 ; $only = sub { $only{$_[0]} }
26 0         0 }
27             }
28 3 50       10 ; unless (defined $mixin)
29 0         0 { Carp::croak("Which class do you want to mix into ${self}?")
30             }
31 3 50 33     7 ; if($only && $without)
32 0         0 { Carp::croak "Option 'without' and 'only' can't be used together in mixin $class."
33             }
34 3         178 ; eval "require $mixin"
35              
36 3 50       20 ; if($HO::class::class_args{$mixin})
37             { $HO::class::mixin_classes{$class} = [] unless
38 3 50       11 defined $HO::class::mixin_classes{$class}
39 3         3 ; push @{$HO::class::mixin_classes{$class}}, @{$HO::class::class_args{$mixin}}
  3         7  
  3         7  
40             }
41 2     2   4 ; my $filter = $only || $without || sub { 1 }
42              
43 3   100     20 ; $HO::accessor::classes{$class} = [] unless
44 3 100       8 defined $HO::accessor::classes{$class}
45 3         4 ; my $mix = $HO::accessor::classes{$mixin}
46 3 50       9 ; $mix = [] unless ref $mix
47 3         3 ; push @{$HO::accessor::classes{$class}}, @$mix
  3         8  
48 3         9 ; my %acc = @$mix
49             ; my @methods =
50 4         8 grep { $filter->($_) }
51 11   100     50 grep { !(/^(init|new)$/ || defined($acc{$_})) }
52 3         11 grep { ! $HO::class::class_methods{$mixin}{$_} }
  14         131  
53             Package::Subroutine->findsubs( $mixin )
54 3         11 ; Package::Subroutine->export_to($class)->($mixin,@methods)
55             }
56              
57             ; 1
58              
59             __END__