new ticket from slaven

[andk-cpan-tools.git] / bin / refill-cpanstatsdb-minutes.pl

#!/usr/bin/perl

# use 5.010;
use strict;
use warnings;

=encoding utf8

=head1 NAME



=head1 SYNOPSIS

 refill-cpanstatsdb-minutes.pl directory

=head1 OPTIONS

=over 8

=cut

my @opt = <<'=back' =~ /B<--(\S+)>/g;

=item B<--help|h!>

This help

=item B<--collectguids!>

Try to identify the guids on amazon side that are missing on
cpantesters side. Report them together with the record in
tab-separated format. (Misnomer: originally we reported only the guid
but it turned out the guid was not usable)

=item B<--pickdate=s>

Limits the investigation to a certain date. Format must be
left-aligned, e.g. C<20121008>. Note that results are unreliable for
dates lower than 20121008 and that at least 15 hours should have
passed since the end of the picked day because analysis fetches fresh
data from upstream only every 15 hours and then needs about 6 hours
for processing. So better is 21 hours, and give room for unanticipated
stuff.

=item B<--seek=i>

Defaults to 2_800_000_000. The logfile is huge and skipping 2.8 G
helps run times enourmously. On the relation to dates:

  2700000000 2013-12-16T21:46:30Z
  2800000000 2014-01-02T06:34:34Z
  2900000000 2014-01-17T11:43:43Z
  3000000000 2014-01-30T15:29:56Z
  3100000000 2014-02-14T16:14:52Z
 11099702509 2017-04-17T11:26:33Z

IOW: 100_000_000 ≙ (U+2259 ≙ estimates) 2 weeks unchanges over the
years.

=back

=head1 DESCRIPTION

Opens directory, looks into all json files that describe recent
cpanstats records, collects all minutes and counts number of reports
in amazon and in cpanstatsdb. With the --collectguids argument it also
lists guids on the amazon side that are either definitively missing or
are victims of some confusion. Confusions can arise because the source
of the amazon data comes from log.txt which does not provide
osversion. Or because testers send duplicates. Or because somebody
calculates the time wrongly. We're not sure. Some of the GUIDs we
report are most probably not missings. On initial inspection this
seems to be in the 1 to 15 percent range.

=head1 HISTORICAL EVIDENCE

2013-04-29 21:25 I called this program with

andreas@ds8143:~/src/andk-cpan-tools% /home/andreas/src/installed-perls/v5.16.0/4e6d/bin/perl bin/refill-cpanstatsdb-minutes.pl --pickdate=20130422 ~/var/refill-cpanstatsdb/2013/04 | perl -nale 'printf "%d %d\n", $F[2], $S+=$F[2] if $F[0] ge "201304220623" and $F[0] le "201304221306"'

to count the number of reports in a specific range that I had spotted
on a first run piping to "less".

Revisiting my history I find

2012-10-17 07:17  /home/andreas/src/installed-perls/v5.16.0/4e6d/bin/perl -d /tmp/refill-cpanstatsdb-minutes.pl --pickdate=201210082202 --collectguids ~/var/refill-cpanstatsdb/2012/10

Interesting to see a longer argument to pickdate.

=cut


use FindBin;
use lib "$FindBin::Bin/../lib";
BEGIN {
    push @INC, qw(       );
}

use Dumpvalue;
use File::Basename qw(dirname);
use File::Path qw(mkpath);
use File::Spec;
use File::Temp;
use Getopt::Long;
use Hash::Util qw(lock_keys);
use CPAN::DistnameInfo;

our %Opt;
lock_keys %Opt, map { /([^=!]+)/ } @opt;
GetOptions(\%Opt,
           @opt,
          ) or pod2usage(1);

if ( $Opt{pickdate} ) {
    die "Invalid pickdate[$Opt{pickdate}]" unless $Opt{pickdate} =~ /^[1-9][0-9]+$/
}
$Opt{seek} //= 2_800_000_000;

use JSON::XS ();
use List::Util qw(minstr maxstr);
use DBD::SQLite;
our $jsonxs = JSON::XS->new->indent(0);

my $dir = shift or pod2usage(1);
opendir my $dh, $dir or die "Could not opendir '$dir': $!";
my @jsonfiles = sort grep /\.json\.gz$/, readdir $dh;
my %S;
my $delta_records = 0;
for my $dirent (@jsonfiles) {
    my $abs = "$dir/$dirent";
    next unless -M $abs > 1/12; # must be older than two hours to prevent reading unfinished files
    open my $fh, "-|", "zcat" => $abs or die "Could not fork: $!";
    # {"version":"0.003","dist":"Test-Spec-RMock","osvers":"2.11","state":"pass","perl":"5.14.1","fulldate":"201210070645","osname":"solaris","postdate":"201210","platform":"i86pc-solaris-thread-multi-64int","guid":"8d4da104-104a-11e2-bdcc-373e3b6b8117","id":"23770157","type":"2","tester":"root@klanker.bingosnet.co.uk ((Charlie &))"}
    while (<$fh>) {
        my $report = $jsonxs->decode($_);
        my $minute = $report->{fulldate};
        $delta_records++;
        if (!$Opt{pickdate} || $Opt{pickdate} && $minute =~ /^$Opt{pickdate}/) {
            $S{$minute}{cpandbdelta}++;
            if ( $Opt{collectguids} ) {
                my($canon) = join "\t", @{$report}{qw(state platform dist version perl)};
                $S{$minute}{cpandbdeltarecord}{$canon}++;
            }
        }
    }
    close $fh or die "Could not close 'zcat ...': $!";
}
my $found_records = keys %S;
if ( $found_records > 0 ) {
    my $mindate = minstr keys %S;
    my $maxdate = maxstr keys %S;
    my $mblog = "$ENV{HOME}/var/metabase-log/metabase.log";
    open my $fh, $mblog or die "Could not open '$mblog': $!";
    if ($Opt{seek}) {
        seek $fh, $Opt{seek}, 0;
        <$fh>; # throw away this one
    }
    #[2012-10-07T06:45:15Z] [Chris Williams (BINGOS)] [pass] [KJELLM/Test-Spec-RMock-0.003.tar.gz] [i86pc-solaris-thread-multi-64int] [perl-v5.14.1] [8d4e0766-104a-11e2-bdcc-373e3b6b8117] [2012-10-07T06:45:15Z]
    #[2012-10-04T07:14:06Z] [Chris Williams (BINGOS)] [pass] [TOBYINK/P5U-Command-Peek-0.001.tar.gz] [x86_64-linux-thread-multi-ld] [perl-v5.12.4] [15dfc45c-0df3-11e2-bdcc-373e3b6b8117] [2012-10-04T07:14:06Z]
    my %mbseen;
    while (<$fh>) {
        next if /^\.\.\./; # we know that we missed something upstream
        my($date, $author, $state, $distro, $platform, $perl, $guid) =
            /^\[([^\]]*)\]
             \s+\[([^\]]*)\]
             \s+\[([^\]]*)\]
             \s+\[([^\]]*)\]
             \s+\[([^\]]*)\]
             \s+\[([^\]]*)\]
             \s+\[([^\]]*)\]
            /x or die "non-matching line: '$_'\n";
        next if $mbseen{$guid}++;
        $date =~ s/:\d\dZ$//; # cut seconds off
        $date =~ s/[^0-9]//g; # remove [-T:]
        next unless $date ge $mindate && $date le $maxdate;
        $S{$date}{mblog}++;
        if ( $Opt{collectguids} ) {
            my $d = CPAN::DistnameInfo->new($distro);
            my($shortperl) = $perl =~ /perl-v(.+)/;
            my $canon = join "\t", $state, $platform, $d->dist, $d->version, $shortperl;
            $S{$date}{mblogrecord}{$canon}{$guid}++;
        }
    }
    my @fields = qw(mblog cpandbdelta);
    my %SUM = map { ($_ => 0) } @fields;
    my $j = 0;
    for my $m (sort { $a <=> $b } keys %S) {
        $S{$m}{mblog} ||= 0;
        $S{$m}{cpandbdelta} ||= 0;
        if (0) {
        } else {
            printf "%s %5d %5d %5d\n", $m, $S{$m}{mblog}, $S{$m}{cpandbdelta}, $S{$m}{mblog}-$S{$m}{cpandbdelta};
            my $miss = $S{$m}{mblog}-$S{$m}{cpandbdelta};
            my $i = 0;
            if ( $Opt{collectguids} ) {
                for my $k (keys %{$S{$m}{mblogrecord}}) {
                    # $k is a canonized record; mblog stands for metabase log
                    my $v = $S{$m}{mblogrecord}{$k};
                    # $v is a hashref, the keys are guids we might want to publish
                    my $cnt_mb = keys %$v;
                    my $cnt_ct = $S{$m}{cpandbdeltarecord}{$k} || 0;
                    if ( $cnt_mb > $cnt_ct ) {
                        for my $k2 (keys %$v) {
                            printf "  %d(%d): %s\t%s\n", ++$i, ++$j, $k2, $k;
                        }
                    }
                }
            }
        }
        for my $k (@fields) {
            $SUM{$k} += $S{$m}{$k};
        }
    }
    if (0) {
    } else {
        printf ".........SUM %5d %5d %5d\n", $SUM{mblog}, $SUM{cpandbdelta}, $SUM{mblog}-$SUM{cpandbdelta};
    }
} else {
    warn sprintf
        (
         "None of the %d records among the jsonfiles (\n%s) was matching pickdate '%s'",
         $delta_records,
         join("",map("  $_\n",@jsonfiles)),
         $Opt{pickdate},
        );
}

# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# End: