bin/metacpanapiquery.pl

   1 #!/usr/bin/perl
   2
   3 # die " Deadly, don't use yet. We must implement date verification as well, at least ";
   4
   5 # Have eliminated 10 lines: Dancer2-Logger-Radis-0.001(=>0.002) Yote-0.1022(=>2.02) DBD-SQLAnywhere-2.08(=>2.13) Template-Mustache-1.0.0_0(=>1.1.0) Data-Rmap-0.64(=>0.65) Pcore-PDF-v0.1.0(=>v0.4.4) IO-Socket-Socks-0.71(=>0.74) Data-Sah-Resolve-0.003(=>0.007) Git-PurePerl-0.51(=>0.53) Archive-Zip-1.57(=>1_11)
   6
   7
   8 # use 5.010;
   9 use strict;
  10 use warnings;
  11
  12 =head1 NAME
  13
  14
  15
  16 =head1 SYNOPSIS
  17
  18
  19
  20 =head1 OPTIONS
  21
  22 =over 8
  23
  24 =cut
  25
  26 my @opt = <<'=back' =~ /B<--(\S+)>/g;
  27
  28 =item B<--debug|d!>
  29
  30 More output
  31
  32 =item B<--help|h!>
  33
  34 This help
  35
  36 =back
  37
  38 =head1 DESCRIPTION
  39
  40 Visits fastapi for each command line argument. Arguments can either be
  41 vdistro (Test-Pockito-0.02) or pretty_id style
  42 (JWIED/HTML-EP-0.2011.tar.gz) or pretty_id without filename suffix
  43 (FVULTO/HTML-Toc-1.12)
  44
  45 =cut
  46
  47
  48 use FindBin;
  49 use lib "$FindBin::Bin/../lib";
  50 BEGIN {
  51     push @INC, qw(       );
  52 }
  53
  54 use Getopt::Long;
  55 use Hash::Util qw(lock_keys);
  56 use Pod::Usage;
  57 use Time::HiRes qw(sleep);
  58 use Time::Piece;
  59
  60 our %Opt;
  61 lock_keys %Opt, map { /([^=|!]+)/ } @opt;
  62 GetOptions(\%Opt,
  63            @opt,
  64           ) or pod2usage(1);
  65 if ($Opt{help}) {
  66     pod2usage(0);
  67 }
  68
  69 use LWP::UserAgent;
  70 use JSON::XS;
  71 use CPAN::DistnameInfo;
  72 use List::AllUtils qw(reduce);
  73 use CPAN::Version;
  74
  75 my $ua = LWP::UserAgent->new();
  76 $ua->default_header("Accept-Encoding", "gzip");
  77 my $jsonxs = JSON::XS->new->indent(0);
  78
  79 ARG: for my $i (0..$#ARGV) {
  80     my($maybedistv) = $ARGV[$i];
  81     my $CDA;
  82     if ($maybedistv =~ m{/}) {
  83         unless ($maybedistv =~ m{/.*\.(tar\.gz|zip|tar.bz2)}) {
  84             $maybedistv .= ".tar.gz";
  85         }
  86         $CDA = substr($maybedistv,0,1) . '/' . substr($maybedistv,0,2) . '/' . $maybedistv;
  87     } else {
  88         $CDA = "A/AA/AAA/$maybedistv.tar.gz";
  89     }
  90     my $d = CPAN::DistnameInfo->new($CDA) or die "no d for argument $CDA";
  91     my $distv = $d->distvname or die "no distv for $CDA";
  92     my %w = ( distv => $distv ); # work
  93     $w{version} = $d->version;
  94     warn "distv => $distv\n" if $Opt{debug};
  95     warn "  version     => $w{version}\n" if $Opt{debug};
  96     my $query = sprintf "http://fastapi.metacpan.org/v1/release/_search?q=distribution:%s&fields=name,date,status,version,author&size=400&_source=tests", $d->dist;
  97     my $resp = $ua->get($query);
  98     unless ($resp->is_success) {
  99         warn sprintf "No success visiting '%s': %s; sleeping %.3f\n",
 100             $query, $resp->code;
 101         next ARG;
 102     }
 103     # print $query;
 104     my $jsontxt = $resp->decoded_content;
 105     my $j = eval { $jsonxs->decode($jsontxt); };
 106     if (!$j || $@) {
 107         my $err = $@ || "unknown error";
 108         die "Error while decoding '$jsontxt': $err";
 109     }
 110     my $hits = $j->{hits}{hits};
 111     my($matchingrelease) = grep { $_->{fields}{name} eq $distv } @$hits;
 112     unless ($matchingrelease) {
 113         warn "Did not find release for $distv\n";
 114         next ANNO;
 115     }
 116     my($releasedate) = $matchingrelease->{fields}{date};
 117     warn "  releasedate => $releasedate\n" if $Opt{debug};
 118     my($author) = $matchingrelease->{fields}{author};
 119     warn "  author      => $author\n" if $Opt{debug};
 120     $w{cpanversion} = reduce {
 121         CPAN::Version->vgt($a,$b) ? $a : $b
 122         } map { $_->{fields}{version} } grep { $_->{fields}{date} ge $releasedate } @$hits;
 123     if (CPAN::Version->vgt($w{cpanversion},$w{version})) {
 124         warn "  newercpanversion => $w{cpanversion}\n" if $Opt{debug};
 125         my($highest_distro) = grep { $_->{fields}{version} eq $w{cpanversion} } @$hits;
 126         warn "  newerreleasedate => $highest_distro->{fields}{date}\n" if $Opt{debug};
 127         if ($highest_distro->{fields}{author} ne $author) {
 128             warn "  newerauthor      => $highest_distro->{fields}{author}\n" if $Opt{debug};
 129         }
 130     }
 131 }
 132
 133 # Local Variables:
 134 # mode: cperl
 135 # cperl-indent-level: 4
 136 # End: