File Coverage

blib/lib/DMOSS/Plugin/VerifyChanges.pm
Criterion Covered Total %
statement 15 62 24.1
branch 0 28 0.0
condition 0 9 0.0
subroutine 5 11 45.4
pod 6 6 100.0
total 26 116 22.4


line stmt bran cond sub pod time code
1             package DMOSS::Plugin::VerifyChanges;
2             $DMOSS::Plugin::VerifyChanges::VERSION = '0.01_2';
3             # ABSTRACT: DMOSS changes plugin
4 1     1   7 use parent qw/DMOSS::Plugin/;
  1         2  
  1         6  
5 1     1   61 use strict;
  1         2  
  1         31  
6 1     1   5 use warnings;
  1         2  
  1         98  
7              
8 1     1   7 use File::Slurp qw/read_file/;
  1         10  
  1         68  
9 1     1   6 use Data::Dumper;
  1         2  
  1         1040  
10              
11             our @types = qw/CHANGES/;
12              
13 0     0 1   sub name { 'Verify Changes' }
14              
15             sub process {
16 0     0 1   my ($self, $dmoss, $file) = @_;
17 0           my @local = localtime;
18 0           my $current = $local[5]+1900;
19              
20 0           open(my $fh, '<', $file->fullpath);
21 0           $/ = '';
22 0           my $years;
23 0           while (<$fh>) {
24 0           my ($year, $ver);
25 0 0         $year = $1 if $_ =~ m/(\d{4})/;
26 0 0 0       next unless ($year and $year > 1970 and $year <= $current);
      0        
27              
28 0 0         $ver = $1 if $_ =~ m/(\d+\.\d+)/;
29              
30 0 0         if ($ver) { push @{$years->{$year}}, $ver; }
  0            
  0            
31 0 0         else { $years->{$year} = [] unless $years->{$year}; }
32             }
33              
34 0           my @years = sort {$b<=>$a} keys %$years;
  0            
35 0           my $last = shift @years;
36              
37 0           $dmoss->add_attr('changes', {years=>$years, last=>$last} );
38             }
39              
40             sub reduce {
41 0     0 1   my ($self, $dmoss, $attr) = @_;
42              
43 0           $dmoss->add_attr('links', $attr->value);
44             }
45              
46             sub report {
47 0     0 1   my ($self, $dmoss, $attr) = @_;
48 0 0 0       return unless ($attr->value and keys %{$attr->value});
  0            
49              
50 0           my $final;
51 0           foreach (sort {$b<=>$a} keys %{ $attr->value->{years} }) {
  0            
  0            
52 0 0         next unless $attr->value->{years}->{$_};
53 0           my @l = @{$attr->value->{years}->{$_}};
  0            
54 0 0         push @$final, [ $_, @l ? join(', ', @l) : 'Unknown' ];
55             }
56              
57 0           return $final;
58             }
59              
60             sub report_headers {
61 0     0 1   my ($self, $dmoss) = @_;
62              
63 0           return ['Year', 'Versions'];
64             }
65              
66             sub grade {
67 0     0 1   my ($self, $dmoss, $attr) = @_;
68 0 0         return 0 unless $attr;
69              
70 0           my $last = $attr->value->{last};
71 0 0         return 0 unless $last;
72 0           my @local = localtime;
73 0           my $current = $local[5]+1900;
74 0 0         return 0 unless $current;
75              
76 0 0         return 1 if ($last == $current);
77 0 0         return 0.9 if ($last+1 == $current);
78 0 0         return 0.5 if ($last < $current);
79 0           return 0;
80             }
81              
82             1;
83              
84             __END__