bin/annotate-reductionist.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<--annotatefile=s>
  29
  30 Defaults to C<annotate.txt>. Filename to work on.
  31
  32 =item B<--debug|d!>
  33
  34 More output
  35
  36 =item B<--dry-run|n!>
  37
  38 Only the diagnostics, no overwrite
  39
  40 =item B<--help|h!>
  41
  42 This help
  43
  44 =item B<--max=i>
  45
  46 Stop after how many
  47
  48 =item B<--rand!>
  49
  50 If true, pick your sample randomly from all lines
  51
  52 =back
  53
  54 =head1 DESCRIPTION
  55
  56 Visits fastapi for each line of the annotate.txt file and deletes
  57 lines that have a newer counterpart.
  58
  59 =cut
  60
  61
  62 use FindBin;
  63 use lib "$FindBin::Bin/../lib";
  64 BEGIN {
  65     push @INC, qw(       );
  66 }
  67
  68 use Getopt::Long;
  69 use Hash::Util qw(lock_keys);
  70 use Pod::Usage;
  71 use Time::HiRes qw(sleep);
  72 use Time::Piece;
  73
  74 our %Opt;
  75 lock_keys %Opt, map { /([^=|!]+)/ } @opt;
  76 GetOptions(\%Opt,
  77            @opt,
  78           ) or pod2usage(1);
  79 if ($Opt{help}) {
  80     pod2usage(0);
  81 }
  82 $Opt{annotatefile} //= "annotate.txt";
  83
  84 use LWP::UserAgent;
  85 use JSON::XS;
  86 use CPAN::DistnameInfo;
  87 use List::AllUtils qw(reduce);
  88 use CPAN::Version;
  89
  90 my $ua = LWP::UserAgent->new();
  91 $ua->default_header("Accept-Encoding", "gzip");
  92 my $jsonxs = JSON::XS->new->indent(0);
  93
  94 my @Sredu = my @Stmp = do { open my $fh, $Opt{annotatefile} or die; local $/="\n"; map {chop;$_} <$fh> };
  95
  96 my $max = defined $Opt{max} ? $Opt{max} : scalar @Stmp;
  97 my $maxi = $max - 1;
  98 my $sleep_on_error = 0.884;
  99
 100 my @DONE;
 101
 102 ANNO: for my $i (0..$maxi) {
 103     my $si = $Opt{rand} ? int rand @Stmp : $i;
 104     my($distv) = $Stmp[$si] =~ /(\S+)/;
 105     my %w = ( distv => $distv ); # work
 106     warn "\ndistv => $distv\n" if $Opt{debug};
 107     my $d = CPAN::DistnameInfo->new("A/AA/AAA/$distv.tar.gz");
 108     $w{version} = $d->version;
 109     warn "version     => $w{version}\n" if $Opt{debug};
 110     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;
 111     my $resp = $ua->get($query);
 112     unless ($resp->is_success) {
 113         warn sprintf "No success visiting '%s': %s; sleeiping %.3f\n",
 114             $query, $resp->code, $sleep_on_error;
 115         sleep $sleep_on_error;
 116         next ANNO;
 117     }
 118     # print $query;
 119     my $jsontxt = $resp->decoded_content;
 120     my $j = eval { $jsonxs->decode($jsontxt); };
 121     if (!$j || $@) {
 122         my $err = $@ || "unknown error";
 123         die "Error while decoding '$jsontxt': $err";
 124     }
 125     my $hits = $j->{hits}{hits};
 126     my($releasedate) = map { $_->{fields}{date} } grep { $_->{fields}{name} eq $distv } @$hits;
 127     unless ($releasedate) {
 128         die "Did not find own releasedate for $distv";
 129     }
 130     warn "releasedate => $releasedate\n" if $Opt{debug};
 131     $w{cpanversion} = reduce {
 132         CPAN::Version->vgt($a,$b) ? $a : $b
 133         } map { $_->{fields}{version} } grep { $_->{fields}{date} ge $releasedate } @$hits;
 134     warn "cpanversion => $w{cpanversion}\n" if $Opt{debug};
 135     my $line = splice @Stmp, $si, 1;
 136     $w{eliminated} = 0;
 137     if (CPAN::Version->vgt($w{cpanversion},$w{version})) {
 138         my($highest_distro) = grep { $_->{fields}{version} eq $w{cpanversion} } @$hits;
 139         warn "releasedate => $highest_distro->{fields}{date}\n" if $Opt{debug};
 140         if (($highest_distro->{_source}{tests}{fail}||0) > 0) {
 141             $w{whynot} = "found fails";
 142         } else {
 143             my $tepoch = Time::Piece->strptime($highest_distro->{fields}{date}, "%Y-%m-%dT%T")->epoch;
 144             if (time - $tepoch < 14*86400) {
 145                 $w{whynot} = "too fresh";
 146             } else {
 147                 my($redui) = grep { $Sredu[$_] eq $line } 0..$#Sredu;
 148                 splice @Sredu, $redui, 1;
 149                 $w{eliminated} = 1;
 150             }
 151         }
 152     }
 153     warn "eliminated  => $w{eliminated}\n" if $Opt{debug};
 154     if ($w{whynot}) {
 155         warn "whynot      => $w{whynot}\n" if $Opt{debug};
 156     }
 157     push @DONE, \%w;
 158 }
 159 my @elim = map {
 160     sprintf "%s(=>%s)", $_->{distv}, $_->{cpanversion};
 161 } grep { $_->{eliminated} } @DONE;
 162 if ($Opt{"dry-run"}) {
 163     my $lines = scalar @elim == 1 ? "line" : "lines";
 164     warn sprintf "Would have eliminated %d $lines: %s\n", scalar @elim, join(" ", @elim);
 165 } else {
 166     my $lines = scalar @elim == 1 ? "line" : "lines";
 167     warn sprintf "Have eliminated %d %s: %s\n", scalar @elim, $lines, join(" ", @elim);
 168     open my $fh, ">", $Opt{annotatefile};
 169     print $fh "$_\n" for @Sredu;
 170     close $fh or die "Could not write $Opt{annotatefile}: $!";
 171 }
 172
 173 # Local Variables:
 174 # mode: cperl
 175 # cperl-indent-level: 4
 176 # End: