File Coverage

blib/lib/Module/CPANTS/Kwalitee.pm
Criterion Covered Total %
statement 46 84 54.7
branch 12 34 35.2
condition 3 3 100.0
subroutine 12 25 48.0
pod 9 11 81.8
total 82 157 52.2


line stmt bran cond sub pod time code
1             package Module::CPANTS::Kwalitee;
2 8     8   64998 use 5.006;
  8         38  
3 8     8   46 use strict;
  8         17  
  8         172  
4 8     8   40 use warnings;
  8         17  
  8         309  
5 8     8   47 use base qw(Class::Accessor::Fast);
  8         16  
  8         1526  
6 8     8   2992 use Carp;
  8         18  
  8         501  
7 8     8   3561 use Module::Find qw(usesub);
  8         10555  
  8         7280  
8              
9             our $VERSION = '1.00';
10             $VERSION =~ s/_//; ## no critic
11              
12             __PACKAGE__->mk_accessors(qw(_available _total));
13              
14             my @Plugins;
15             my @SearchPaths = ('Module::CPANTS::Kwalitee');
16             my @Indicators;
17             my %IndicatorHash;
18             my $Total;
19             my $Available;
20              
21             sub import {
22 8     8   26 my ($class, @search_paths) = @_;
23 8         3419 for my $path (@search_paths) {
24 0 0       0 next unless $path =~ /^[A-Za-z][A-Za-z0-9_]*(::[A-Za-z][A-Za-z0-9_]*)*$/;
25 0 0       0 push @SearchPaths, $path =~ /^Module::CPANTS::/ ? $path : "Module::CPANTS::$path";
26              
27 0         0 my %seen;
28 0         0 @SearchPaths = grep {!$seen{$_}++} @SearchPaths;
  0         0  
29             }
30             }
31              
32             sub _load_plugins {
33 15     15   70 my $class = shift;
34 15 100       92 unless (@Plugins) {
35 7         30 my %seen;
36 329 50       966 @Plugins = sort {$a->order <=> $b->order or $a cmp $b}
37 112         613 grep {!$seen{$_}++}
38 7         56 map {usesub $_} @SearchPaths;
  7         78  
39 7         62 $class->_cache_indicators;
40             }
41             }
42              
43             # I suppose nobody wants to change the generators dynamically though
44             sub _cache_indicators {
45 7     7   21 my $class = shift;
46 7         22 @Indicators = ();
47 7         19 $Total = $Available = 0;
48 7         24 for my $plugin (@Plugins) {
49 112         154 for my $indicator (@{$plugin->kwalitee_indicators}) {
  112         543  
50 235         429 $indicator->{defined_in} = $plugin;
51 235 100 100     669 $indicator->{is_core} = 1 if !$indicator->{is_extra} and !$indicator->{is_experimental};
52 235         347 push @Indicators, $indicator;
53 235 100       434 $Total++ unless $indicator->{is_experimental};
54 235 100       481 $Available++ if $indicator->{is_core};
55             }
56             }
57             }
58              
59 0     0 0 0 sub plugins { @Plugins }
60              
61             sub new {
62 15     15 1 166 my $class = shift;
63 15         156 $class->_load_plugins;
64 15         980 bless {}, $class;
65             }
66              
67             sub generators {
68 12     12 0 139 my $self = shift;
69 12 50       102 return \@Plugins unless @_;
70 0         0 @Plugins = @{$_[0]};
  0         0  
71 0         0 $self->_cache_indicators;
72 0         0 \@Plugins;
73             }
74              
75             sub get_indicators {
76 11     11 1 142 my ($self, $type) = @_;
77 11 50       41 unless ($type) { # almost always true
78 11 50       233 return wantarray ? @Indicators : \@Indicators;
79             }
80              
81 0 0         $type = 'is_core' if $type eq 'core';
82 0 0         $type = 'is_extra' if $type eq 'optional';
83 0 0         $type = 'is_experimental' if $type eq 'experimental';
84              
85 0           my @indicators;
86 0           for my $indicator (@Indicators) {
87 0 0         next if !$indicator->{$type};
88 0           push @indicators, $indicator;
89             }
90              
91 0 0         return wantarray ? @indicators : \@indicators;
92             }
93              
94             sub get_indicators_hash {
95 0     0 1   my $self = shift;
96 0 0         return \%IndicatorHash if %IndicatorHash;
97              
98 0           foreach my $ind (@Indicators) {
99 0           $IndicatorHash{$ind->{name}} = $ind;
100             }
101 0           return \%IndicatorHash;
102             }
103              
104 0     0 1   sub available_kwalitee { $Available }
105              
106 0     0 1   sub total_kwalitee { $Total }
107              
108             sub _indicator_names {
109 0     0     my ($self, $coderef) = @_;
110 0           my @names = map { $_->{name} } grep {$coderef->($_)} $self->get_indicators;
  0            
  0            
111 0 0         return wantarray ? @names : \@names;
112             }
113              
114 0     0 1   sub all_indicator_names { shift->_indicator_names(sub {1}) }
  0     0      
115              
116             sub core_indicator_names {
117 0     0 1   shift->_indicator_names(sub {$_->{is_core}});
  0     0      
118             }
119              
120             sub optional_indicator_names {
121 0     0 1   shift->_indicator_names(sub {$_->{is_extra}});
  0     0      
122             }
123              
124             sub experimental_indicator_names {
125 0     0 1   shift->_indicator_names(sub {$_->{is_experimental}});
  0     0      
126             }
127              
128             q{Favourite record of the moment:
129             Jahcoozi: Pure Breed Mongrel};
130              
131             __END__