File Coverage

blib/lib/Test/Apocalypse/Kwalitee.pm
Criterion Covered Total %
statement 29 80 36.2
branch 5 32 15.6
condition 0 24 0.0
subroutine 8 11 72.7
pod 0 1 0.0
total 42 148 28.3


line stmt bran cond sub pod time code
1             #
2             # This file is part of Test-Apocalypse
3             #
4             # This software is copyright (c) 2014 by Apocalypse.
5             #
6             # This is free software; you can redistribute it and/or modify it under
7             # the same terms as the Perl 5 programming language system itself.
8             #
9 38     38   4945044 use strict; use warnings;
  38     38   87  
  38         1240  
  38         159  
  38         43  
  38         1876  
10             package Test::Apocalypse::Kwalitee;
11             $Test::Apocalypse::Kwalitee::VERSION = '1.006';
12             BEGIN {
13 38     38   496 $Test::Apocalypse::Kwalitee::AUTHORITY = 'cpan:APOCAL';
14             }
15              
16             # ABSTRACT: Plugin for Test::Kwalitee
17              
18 38     38   153 use Test::More;
  38         81  
  38         342  
19 38     38   25730 use Module::CPANTS::Analyse 0.95;
  38         5513752  
  38         230  
20 38     38   1888 use version 0.77;
  38         947  
  38         392  
21              
22 0     0   0 sub _do_automated { 0 }
23              
24             # init CPANTS with the latest tarball
25             my $tarball;
26             sub _is_disabled {
27 37     37   222 $tarball = _get_tarball( '.' );
28 37 50       185 if ( ! defined $tarball ) {
29             # Dist::Zilla-specific code, the tarball we want is 3 levels up ( when using dzp::TestRelease :)
30             # [@Apocalyptic/TestRelease] Extracting /home/apoc/mygit/perl-pod-weaver-pluginbundle-apocalyptic/Pod-Weaver-PluginBundle-Apocalyptic-0.001.tar.gz to .build/MiNXla4CY7
31 37         74 $tarball = _get_tarball( '../../..' );
32 37 50       148 if ( ! defined $tarball ) {
33 37         222 return 'Distribution tarball not found, unable to run CPANTS Kwalitee tests!';
34             }
35             }
36             }
37              
38             # the following code was copied/plagarized/transformed from Test::Kwalitee, thanks!
39             # The reason why I didn't just use that module is because it doesn't print the kwalitee or consider extra metrics...
40             sub do_test {
41 0     0 0 0 my $analyzer = Module::CPANTS::Analyse->new({
42             'dist' => $tarball,
43             });
44              
45             # set the number of tests / run analyzer
46 0         0 my @indicators = $analyzer->mck()->get_indicators();
47 0         0 plan tests => scalar @indicators;
48 0         0 $analyzer->unpack;
49 0         0 $analyzer->analyse;
50 0         0 $analyzer->calc_kwalitee;
51 0         0 my $kwalitee_points = 0;
52 0         0 my $available_kwalitee = 0;
53              
54             # loop over the kwalitee metrics
55 0         0 foreach my $gen ( @{ $analyzer->mck()->generators() } ) {
  0         0  
56 0         0 foreach my $metric ( @{ $gen->kwalitee_indicators() } ) {
  0         0  
57             # get the result
58 0         0 my $result = $metric->{'code'}->( $analyzer->d(), $metric );
59 0         0 my $type = 'CORE';
60 0 0 0     0 if ( exists $metric->{'is_experimental'} and $metric->{'is_experimental'} ) {
61 0         0 $type = 'EXPERIMENTAL';
62             }
63 0 0 0     0 if ( exists $metric->{'is_extra'} and $metric->{'is_extra'} ) {
64 0         0 $type = 'EXTRA';
65             }
66              
67 0 0 0     0 if ( $type eq 'CORE' or $result ) {
68 0         0 ok( $result, "[$type] $metric->{'name'}" );
69             } else {
70 0 0       0 if ( ! $ENV{PERL_APOCALYPSE} ) {
71             # non-core tests PASS automatically for ease of use
72 0         0 pass( "[$type] $metric->{'name'} treated as PASS" );
73             } else {
74 0         0 fail( "[$type] $metric->{'name'}" );
75             }
76             }
77              
78             # print more diag if it failed
79 0 0 0     0 if ( ! $result && $ENV{TEST_VERBOSE} ) {
80 0         0 diag( '[' . $metric->{'name'} . '] error(' . $metric->{'error'} . ') remedy(' . $metric->{'remedy'} . ')' );
81 0 0 0     0 if ( $metric->{'name'} eq 'prereq_matches_use' or $metric->{'name'} eq 'build_prereq_matches_use' ) {
82 0         0 require Data::Dumper; ## no critic (Bangs::ProhibitDebuggingModules)
83 0         0 diag( "module information: " . Data::Dumper::Dumper( $analyzer->d->{'uses'} ) );
84             }
85             }
86              
87             # should we tally up the kwalitee?
88 0 0 0     0 if ( ! exists $metric->{'is_experimental'} || ! $metric->{'is_experimental'} ) {
89             # we increment available only for CORE, not extra
90 0 0 0     0 if ( ! exists $metric->{'is_extra'} || ! $metric->{'is_extra'} ) {
91 0         0 $available_kwalitee++;
92             }
93 0 0       0 if ( $result ) {
94 0         0 $kwalitee_points++;
95             }
96             }
97             }
98             }
99              
100             # for diag, print out the kwalitee of the module
101 0         0 diag( "Kwalitee rating: " . sprintf( "%.2f%%", 100 * ( $kwalitee_points / $available_kwalitee ) ) . " [$kwalitee_points / $available_kwalitee]" );
102              
103             # That piece of crap dumps files all over :(
104 0         0 _cleanup_debian_files();
105              
106 0         0 return;
107             }
108              
109             sub _get_tarball {
110 74     74   185 my $path = shift;
111              
112             # get our list of stuff, and try to find the latest tarball
113 74 50       3367 opendir( my $dir, $path ) or die "Unable to opendir: $!";
114 74         7733 my @dirlist = readdir( $dir );
115 74 50       1295 closedir( $dir ) or die "Unable to closedir: $!";
116              
117             # get the tarballs
118 74         185 @dirlist = grep { /(?:tar(?:\.gz|\.bz2)?|tgz|zip)$/ } @dirlist;
  1998         2738  
119              
120             # short-circuit
121 74 50       222 if ( scalar @dirlist == 0 ) {
122 74         259 return;
123             }
124              
125             # get the versions
126 0           @dirlist = map { [ $_, $_ ] } @dirlist;
  0            
127 0           for ( @dirlist ) {
128 0           $_->[0] =~ s/^.*\-([^\-]+)(?:tar(?:\.gz|\.bz2)?|tgz|zip)$/$1/;
129 0           $_->[0] = version->new( $_->[0] );
130             }
131              
132             # sort by version
133 0           @dirlist = reverse sort { $a->[0] <=> $b->[0] } @dirlist;
  0            
134              
135             # TODO should we use file::spec and stuff here?
136 0           return $path . '/' . $dirlist[0]->[1];
137             }
138              
139             # Module::CPANTS::Kwalitee::Distros suck!
140             #t/a_manifest..............1/1
141             ## Failed test at t/a_manifest.t line 13.
142             ## got: 1
143             ## expected: 0
144             ## The following files are not named in the MANIFEST file: /home/apoc/workspace/VCS-perl-trunk/VCS-2.12.2/Debian_CPANTS.txt
145             ## Looks like you failed 1 test of 1.
146             #t/a_manifest.............. Dubious, test returned 1 (wstat 256, 0x100)
147             sub _cleanup_debian_files {
148 0     0     foreach my $file ( qw( Debian_CPANTS.txt ../Debian_CPANTS.txt ) ) {
149 0 0 0       if ( -e $file and -f _ ) {
150 0           my $status = unlink( $file );
151 0 0         if ( ! $status ) {
152 0           warn "unable to unlink $file";
153             }
154             }
155             }
156              
157 0           return;
158             }
159              
160             1;
161              
162             __END__
163              
164             =pod
165              
166             =encoding UTF-8
167              
168             =for :stopwords Apocalypse Niebur Ryan kwalitee
169              
170             =for Pod::Coverage do_test
171              
172             =head1 NAME
173              
174             Test::Apocalypse::Kwalitee - Plugin for Test::Kwalitee
175              
176             =head1 VERSION
177              
178             This document describes v1.006 of Test::Apocalypse::Kwalitee - released October 25, 2014 as part of Test-Apocalypse.
179              
180             =head1 DESCRIPTION
181              
182             Encapsulates L<Test::Kwalitee> functionality. This plugin also processes the extra metrics, and prints out the kwalitee as a diag() for info.
183              
184             =head1 SEE ALSO
185              
186             Please see those modules/websites for more information related to this module.
187              
188             =over 4
189              
190             =item *
191              
192             L<Test::Apocalypse|Test::Apocalypse>
193              
194             =back
195              
196             =head1 AUTHOR
197              
198             Apocalypse <APOCAL@cpan.org>
199              
200             =head1 COPYRIGHT AND LICENSE
201              
202             This software is copyright (c) 2014 by Apocalypse.
203              
204             This is free software; you can redistribute it and/or modify it under
205             the same terms as the Perl 5 programming language system itself.
206              
207             The full text of the license can be found in the
208             F<LICENSE> file included with this distribution.
209              
210             =head1 DISCLAIMER OF WARRANTY
211              
212             THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
213             APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
214             HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
215             OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
216             THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
217             PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
218             IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
219             ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
220              
221             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
222             WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
223             THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
224             GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
225             USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
226             DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
227             PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
228             EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
229             SUCH DAMAGES.
230              
231             =cut