#!/usr/bin/env perl
use warnings;
use strict;
use feature 'state';
use URI;
use HTTP::Tiny;
use Path::Class qw/dir file/;
use CPAN::Mirrors;
use Digest::SHA;
use Config::Perl;
use MetaCPAN::Client;
use Regexp::Common qw/balanced/;

# ### User Vars ###
my $MODULE = 'PAR::Packer';
my $WORKDIR = dir('/tmp/mirrorcheck');
# Control how the files are downloaded from the mirrors:
# "force"  = delete the local file first, forcing a re-download
# "always" = always try to mirror the file
# "maybe"  = if file exists locally, don't try to mirror it
# "never"  = never go out to the net
my $FETCHMODE = 'maybe';
# ###
$WORKDIR->mkpath(1);

my $MODURL = URI->new(
    MetaCPAN::Client->new->module($MODULE)->download_url );
my @MODURL_SEG = $MODURL->path_segments;
my $MOD_FN = (@MODURL_SEG)[-1];

my $orig_hash = do { # download the original file and checksum it
    my $f_uri = URI->new('https://www.cpan.org');
    $f_uri->path_segments(@MODURL_SEG);
    my $fn = $WORKDIR->file($MOD_FN);
    $FETCHMODE eq 'force' and $fn->remove;
    mirror($f_uri, $fn, 1);
    Digest::SHA->new('SHA-256')->addfile("$fn")->hexdigest };

my $cksum_hash = do { # get the CHECKSUMS file entry
    my $ck_uri = URI->new('https://www.cpan.org');
    $ck_uri->path_segments( @MODURL_SEG[0..$#MODURL_SEG-1],
        'CHECKSUMS' );
    my $ckf = $WORKDIR->file('CHECKSUMS');
    $FETCHMODE eq 'force' and $ckf->remove;
    mirror($ck_uri, $ckf, 1);
    my $dat = $ckf->slurp;
    $dat =~ /\$cksum\s*=\s*$RE{balanced}{-parens=>'{}'}\s*;/
        or die "failed to parse CHECKSUMS";
    my $hash = Config::Perl->new->parse_or_die(\$1)->{_}[0];
    die "file not found in $ck_uri" unless $hash->{$MOD_FN};
    $hash->{$MOD_FN}{sha256} };

die "checksum of original $MOD_FN ($orig_hash) does not match"
    ." CHECKSUMS ($cksum_hash)" unless $cksum_hash eq $orig_hash;

my $mir_fn = $WORKDIR->file('MIRRORED.BY');
$FETCHMODE eq 'force' and $mir_fn->remove;
mirror('https://www.cpan.org/MIRRORED.BY', $mir_fn, 1);
my $mirrors = CPAN::Mirrors->new("$mir_fn");
my @mirrors = sort keys %{{ map {$_=>1} grep {defined}
    map {$_->{http}} $mirrors->mirrors }};

my $cnt=0;
foreach my $cpan (@mirrors) {
    my $uri = URI->new($cpan);
    $uri->path_segments( grep {length} $uri->path_segments,
        @MODURL_SEG );
    my $fn = $WORKDIR->file($uri->host.'_'.$MOD_FN);
    $FETCHMODE eq 'force' and $fn->remove;
    mirror($uri, $fn, 0)
        if $FETCHMODE eq 'force' || $FETCHMODE eq 'always'
        || $FETCHMODE eq 'maybe' && !-e $fn;
    next unless -e $fn;
    my $hash = Digest::SHA->new('SHA-256')->addfile("$fn")->hexdigest;
    $cnt++;
    print "WARNING: Checksum mismatch on $uri: expected $orig_hash,"
        ." got $hash\n" if $hash ne $orig_hash;
}
print "Done, checked $cnt mirrors\n";

sub mirror {
    my ($url, $file, $strict) = @_;
    state $http = HTTP::Tiny->new(timeout=>30);
    $|=1; print "$url: ";
    my $resp = $http->mirror($url, $file);
    my $msg = "$resp->{status} $resp->{reason}";
    chomp( $msg = $resp->{content} ) if $resp->{status}==599;
    if ($strict && !$resp->{success}) { die "$msg, ABORT\n" }
    else { print $msg, $resp->{success}?" => $file":"", "\n" }
    return $resp->{success};
}
[download]