File Coverage

blib/lib/App/cpanreports.pm

Criterion	Covered	Total	%
statement	40	82	48.7
branch	3	28	10.7
condition	1	8	12.5
subroutine	13	15	86.6
pod	3	3	100.0
total	60	136	44.1

package App::cpanreports;

# Created on: 2015-03-01 11:33:26
# Create by:  Ivan Wills
# $Id$
# $Revision$, $HeadURL$, $Date$
# $Revision$, $Source$, $Date$

use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use Data::Dumper qw/Dumper/;
use English qw/ -no_match_vars /;
use base qw/Exporter/;
use FindBin qw/$Bin/;
use YAML::XS qw/Load LoadFile/;
use HTML::Entities;
use WWW::Mechanize;
use Path::Tiny;

our $VERSION = 0.004;
my ($name)   = $PROGRAM_NAME =~ m{^.*/(.*?)$}mxs;

my %option = (
    version  => meta()->{version},
    distname => meta()->{name},
    dir      => 't/report',
    verbose  => 0,
    man      => 0,
    help     => 0,
    VERSION  => 0,
);


sub run {
    my ($self) = @_;

    Getopt::Long::Configure('bundling');
    GetOptions(
        \%option,
        'version|v=s',
        'distiname|d=s',
        'dir|D=s',
        'state|s=s',
        'verbose|V+',
        'man',
        'help',
        'VERSION!',
    ) or pod2usage(2);

    if ( $option{'VERSION'} ) {
        print "$name Version = $VERSION\n";
        exit 1;
    }
    elsif ( $option{'man'} ) {
        pod2usage( -verbose => 2 );
    }
    elsif ( $option{'help'} ) {
        pod2usage( -verbose => 1 );
    }
    elsif ( !$option{version} || !$option{distname} ) {
        warn <<'HELP';
The arguments --version and --distname must be specified if you are not
running from this script from the distribution's directory.

HELP
        pod2usage( -verbose => 1 );
    }

    # do stuff here
    my $mech = WWW::Mechanize->new;
    my $dir  = "$option{dir}/$option{version}";
    my $test_reports = $self->get_report_summary($mech, $dir, $option{distname}, $option{version});

    for my $report (@$test_reports) {
        next if $report->{version} ne $option{version};
        next if $option{state} && $report->{state} eq $option{state};

        my $guid = $report->{guid};
        next if glob "$dir/*.$guid";

        my $file_name = "$dir/log.test-$report->{osname}.$report->{osvers}-$report->{perl}";
        $mech->get("http://www.cpantesters.org/cpan/report/$guid");
        my $text = $mech->content;

        if ($text =~ /ccflags[^\n]+ -DDEBUGGING.+?\n/sm) {
            $file_name .= 'd';
        }
        if ($report->{platform} !~ /thread/) {
            $file_name .= "-nt";
        }

        # add the GUID to the file to make determining if the report has been
        # previously downloaded easy.
        $file_name .= ".$guid";

        $text =~ s/^.*\nFrom:/From/sm;
        $text =~ s{.*$}{}s;
        decode_entities($text);

        path($file_name)->spew_utf8($text);
    }

    return;
}

my $meta;
sub meta {
    return $meta if $meta;
    my $file
        = -f 'MYMETA.yml'               ? path('MYMETA.yml')
        : -f '.build/latest/MYMETA.yml' ? path('.build/latest/MYMETA.yml')
        :                                 path('META.yml');

    $meta = eval { LoadFile $file } || {};
    return $meta;
}

sub get_report_summary {
    my ($self, $mech, $dir, $distname, $version) = @_;
    my $cache = path("$dir/$distname.yml");
    $cache->parent->mkpath;
    if (-f $cache) {
        return Load scalar $cache->slurp_utf8;
    }

    my $initial = substr $distname, 0, 1;
    my $url = "http://www.cpantesters.org/distro/$initial/$distname.yml";
    $mech->get($url);
    $cache->spew_utf8($mech->content);

    my $yaml = Load $mech->content;
    return $yaml;
}


1;

__END__