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 warn sprintf "left => %d\n", $maxi-$i if $Opt{debug
};
111 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;
112 my $resp = $ua->get($query);
113 unless ($resp->is_success) {
114 warn sprintf "No success visiting '%s': %s; sleeiping %.3f\n",
115 $query, $resp->code, $sleep_on_error;
116 sleep $sleep_on_error;
120 my $jsontxt = $resp->decoded_content;
121 my $j = eval { $jsonxs->decode($jsontxt); };
123 my $err = $@
|| "unknown error";
124 die "Error while decoding '$jsontxt': $err";
126 my $hits = $j->{hits
}{hits
};
127 my($releasedate) = map { $_->{fields
}{date
} } grep { $_->{fields
}{name
} eq $distv } @
$hits;
128 unless ($releasedate) {
129 warn "Did not find own releasedate for $distv\n";
132 warn "releasedate => $releasedate\n" if $Opt{debug
};
133 $w{cpanversion
} = reduce
{
134 CPAN
::Version
->vgt($a,$b) ?
$a : $b
135 } map { $_->{fields
}{version
} } grep { $_->{fields
}{date
} ge $releasedate } @
$hits;
136 warn "cpanversion => $w{cpanversion}\n" if $Opt{debug
};
137 my $line = splice @Stmp, $si, 1;
139 if (CPAN
::Version
->vgt($w{cpanversion
},$w{version
})) {
140 my($highest_distro) = grep { $_->{fields
}{version
} eq $w{cpanversion
} } @
$hits;
141 warn "releasedate => $highest_distro->{fields}{date}\n" if $Opt{debug
};
142 if (($highest_distro->{_source
}{tests
}{fail
}||0) > 0) {
143 my $fails = $highest_distro->{_source
}{tests
}{fail
} == 1 ?
"fail" : "fails";
144 $w{whynot
} = sprintf "found %d %s", $highest_distro->{_source
}{tests
}{fail
}, $fails;
146 my $tepoch = Time
::Piece
->strptime($highest_distro->{fields
}{date
}, "%Y-%m-%dT%T")->epoch;
147 if (time - $tepoch < 14*86400) {
148 $w{whynot
} = "too fresh";
150 my($redui) = grep { $Sredu[$_] eq $line } 0..$#Sredu;
151 splice @Sredu, $redui, 1;
156 warn "eliminated => $w{eliminated}\n" if $Opt{debug
};
158 warn "whynot => $w{whynot}\n" if $Opt{debug
};
163 sprintf "%s(=>%s)", $_->{distv
}, $_->{cpanversion
};
164 } grep { $_->{eliminated
} } @DONE;
165 if ($Opt{"dry-run"}) {
166 my $lines = scalar @elim == 1 ?
"line" : "lines";
167 warn sprintf "Would have eliminated %d $lines: %s\n", scalar @elim, join(" ", @elim);
169 my $lines = scalar @elim == 1 ?
"line" : "lines";
170 warn sprintf "Have eliminated %d %s: %s\n", scalar @elim, $lines, join(" ", @elim);
171 open my $fh, ">", $Opt{annotatefile
};
172 print $fh "$_\n" for @Sredu;
173 close $fh or die "Could not write $Opt{annotatefile}: $!";
178 # cperl-indent-level: 4