3 # die " Deadly, don't use yet. We must implement date verification as well, at least ";
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)
26 my @opt = <<'=back' =~ /B<--(\S+)>/g;
28 =item B<--annotatefile=s>
30 Defaults to C<annotate.txt>. Filename to work on.
38 Only the diagnostics, no overwrite
50 If true, pick your sample randomly from all lines
56 Visits fastapi for each line of the annotate.txt file and deletes
57 lines that have a newer counterpart.
63 use lib
"$FindBin::Bin/../lib";
69 use Hash
::Util
qw(lock_keys);
71 use Time
::HiRes
qw(sleep);
75 lock_keys
%Opt, map { /([^=|!]+)/ } @opt;
82 $Opt{annotatefile
} //= "annotate.txt";
86 use CPAN
::DistnameInfo
;
87 use List
::AllUtils
qw(reduce);
90 my $ua = LWP
::UserAgent
->new();
91 $ua->default_header("Accept-Encoding", "gzip");
92 my $jsonxs = JSON
::XS
->new->indent(0);
94 my @Sredu = my @Stmp = do { open my $fh, $Opt{annotatefile
} or die; local $/="\n"; map {chop;$_} <$fh> };
96 my $max = defined $Opt{max
} ?
$Opt{max
} : scalar @Stmp;
98 my $sleep_on_error = 0.884;
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;
119 my $jsontxt = $resp->decoded_content;
120 my $j = eval { $jsonxs->decode($jsontxt); };
122 my $err = $@
|| "unknown error";
123 die "Error while decoding '$jsontxt': $err";
125 my $hits = $j->{hits
}{hits
};
126 my($releasedate) = map { $_->{fields
}{date
} } grep { $_->{fields
}{name
} eq $distv } @
$hits;
127 unless ($releasedate) {
128 warn "Did not find own releasedate for $distv\n";
131 warn "releasedate => $releasedate\n" if $Opt{debug
};
132 $w{cpanversion
} = reduce
{
133 CPAN
::Version
->vgt($a,$b) ?
$a : $b
134 } map { $_->{fields
}{version
} } grep { $_->{fields
}{date
} ge $releasedate } @
$hits;
135 warn "cpanversion => $w{cpanversion}\n" if $Opt{debug
};
136 my $line = splice @Stmp, $si, 1;
138 if (CPAN
::Version
->vgt($w{cpanversion
},$w{version
})) {
139 my($highest_distro) = grep { $_->{fields
}{version
} eq $w{cpanversion
} } @
$hits;
140 warn "releasedate => $highest_distro->{fields}{date}\n" if $Opt{debug
};
141 if (($highest_distro->{_source
}{tests
}{fail
}||0) > 0) {
142 my $fails = $highest_distro->{_source
}{tests
}{fail
} == 1 ?
"fail" : "fails";
143 $w{whynot
} = sprintf "found %d %s", $highest_distro->{_source
}{tests
}{fail
}, $fails;
145 my $tepoch = Time
::Piece
->strptime($highest_distro->{fields
}{date
}, "%Y-%m-%dT%T")->epoch;
146 if (time - $tepoch < 14*86400) {
147 $w{whynot
} = "too fresh";
149 my($redui) = grep { $Sredu[$_] eq $line } 0..$#Sredu;
150 splice @Sredu, $redui, 1;
155 warn "eliminated => $w{eliminated}\n" if $Opt{debug
};
157 warn "whynot => $w{whynot}\n" if $Opt{debug
};
162 sprintf "%s(=>%s)", $_->{distv
}, $_->{cpanversion
};
163 } grep { $_->{eliminated
} } @DONE;
164 if ($Opt{"dry-run"}) {
165 my $lines = scalar @elim == 1 ?
"line" : "lines";
166 warn sprintf "Would have eliminated %d $lines: %s\n", scalar @elim, join(" ", @elim);
168 my $lines = scalar @elim == 1 ?
"line" : "lines";
169 warn sprintf "Have eliminated %d %s: %s\n", scalar @elim, $lines, join(" ", @elim);
170 open my $fh, ">", $Opt{annotatefile
};
171 print $fh "$_\n" for @Sredu;
172 close $fh or die "Could not write $Opt{annotatefile}: $!";
177 # cperl-indent-level: 4