File Coverage

blib/lib/DMOSS/Plugin/LinkValidator.pm

Criterion	Covered	Total	%
statement	24	65	36.9
branch	0	12	0.0
condition	0	3	0.0
subroutine	8	16	50.0
pod	6	6	100.0
total	38	102	37.2

package DMOSS::Plugin::LinkValidator;
$DMOSS::Plugin::LinkValidator::VERSION = '0.01_2';
# ABSTRACT: DMOSS link validator plugin
use parent qw/DMOSS::Plugin/;
use strict;
use warnings;

use URI::Find;
use File::Slurp qw/read_file/;
use HTTP::Request;
use LWP::UserAgent;
use Data::Dumper;

#our $SKIP = 1;
our @types = qw/README INSTALL/;

sub name { 'Link Validator' }

sub process {
  my ($self, $dmoss, $file) = @_;
  my $content = read_file $file->fullpath;

  my $res;
  my $finder = URI::Find->new(
      sub {
        my ($uri, $orig_uri) = @_;
        return if ($orig_uri =~ m/(localhost|hostname|localdomain)/i);
        $res->{$orig_uri} = __test_link($orig_uri);
      }
    );
  $finder->find(\$content);

  $dmoss->add_attr('links', $res);
}

sub reduce {
  my ($self, $dmoss, @attrs) = @_;

  my $res;
  foreach (@attrs) {
    foreach my $i (keys %{ $_->value }) {
      $res->{$i} = $_->value->{$i};
    }
  }

  $dmoss->add_attr('links', $res);
}

sub report {
  my ($self, $dmoss, $attr) = @_;
  return unless ($attr->value and keys %{$attr->value});

  my $final = [];
  foreach (keys %{$attr->value}) {
    push @$final, [ $_, ($attr->value->{$_} ? 'ok' : 'nok') ];
  }

  return $final;

}

sub report_headers {
  my ($self, $dmoss) = @_;

  return ['URL', 'Status'];
}

sub grade {
  my ($self, $dmoss, $attr) = @_;

  my ($total, $valid) = (0, 0);
  foreach (keys %{ $attr->value }) {
    $total++;
    $valid++ if $attr->value->{$_}
  }

  return ($total ? ($valid/$total) : 0);
}

# auxiliary function
sub __test_link {
   my $url = shift;

   my $request = HTTP::Request->new(GET => $url);
   my $ua = LWP::UserAgent->new;
   my $response = $ua->request($request);

   if ($response->is_success) { return 1; }
   else { return -1; }
}

1;

__END__