#!/usr/bin/perl -w

use strict;
use JSON::XS;

use Getopt::Std;
use Pod::Usage qw( pod2usage );
use Time::Piece;

my %opts;

getopts('d:aA:nbhmI', \%opts) || pod2usage(2);

my $showall = exists $opts{a};
my $arch = $opts{A} || 'amd64';
my $dist = $opts{d} || 'unstable';
my $showbugs = exists $opts{b};
my $showid = exists $opts{I};
pod2usage(1) if $opts{h};
pod2usage(-exitval => 0, -verbose => 2) if $opts{m};

use AptPkg::Config '$_config';
use AptPkg::System '$_system';
use AptPkg::Source;
use SOAP::Lite;
use Term::ANSIColor;
use File::Spec;
use Debian::PkgPerl::Util;

my $srccache;
my $versioning;

# initialise the global config object with the default values and
# setup the $_system object
$_config->init;
$_system    = $_config->system;
$versioning = $_system->versioning;

# suppress cache building messages
$_config->{quiet} = 2;

# set up the cache
$srccache = AptPkg::Source->new;

my $packagesfile = Debian::PkgPerl::Util->download_and_cache_file(
    "https://ci.debian.net/data/status/$dist/$arch/packages.json",
    "ci.debian.net-packages-$dist-$arch.json",
    6 * 60 * 60
);

open(my $fh, '<', $packagesfile) or die("open $packagesfile: $!");

local $/;

for my $j (sort {$a->{package} cmp $b->{package}} @{decode_json(<$fh>)}) {
    my $p = $j->{package};
    if ($j->{status} eq "fail") {
        next if $p !~ /perl/ and !$showall;
        # "trigger": null (aka newly uploaded package?) or "trigger": "migration-reference%2F0"
        next unless !defined($j->{trigger}) or $j->{trigger} =~ m/migration-reference/;
        my @slist = $srccache->find($p) or warn("$p not found in $dist/$arch sources\n"), next;
        my $s = src_latest(@slist);
        next if $s->{Maintainer} !~ /pkg-perl/ and $p ne 'perl';
        if (!$showall) {
            next if !$j->{version} || $s->{Version} ne $j->{version};
        }
        # weed out reports older than 30 days (removed packages)
        if ( $j->{date} ) {
            # 2024-10-14T07:19:25.000Z
            ( my $reportdate = $j->{date} ) =~ s/^(.+)\.\w+$/$1/;
            $reportdate = Time::Piece->strptime( $reportdate, '%Y-%m-%dT%H:%M:%S' );
            my $now  = gmtime;
            my $diff = $now - $reportdate;
            next if $diff->days > 30;
        }
        my $prefix = substr($p, 0, ($p =~ /^lib/ ? 4 : 1));
        my @rcbugs = map {"https://bugs.debian.org/$_"} src_rcbugs($p) if $showbugs;
        my $run_id = $j->{run_id};
        my $previous_status = $j->{previous_status};
        printf "%s_%s %s %s %s %s\n", $p, $j->{version},
            "https://ci.debian.net/packages/$prefix/$p/$dist/${arch}/",
            ($showid ? $run_id : ''),
            (@rcbugs ? colored('RC: ', 'magenta') . join(" ", @rcbugs) : ''),
            ($previous_status && $previous_status ne "fail" ? colored("# NEW", 'red') : '');
    }
}

close $fh;

sub src_latest {
    return (sort src_byversion @_)[-1];
}

sub src_byversion {
    return $versioning->compare($a->{Version}, $b->{Version});
}

sub src_rcbugs {
    my $pkg  = shift;
    my $soap = SOAP::Lite->uri('Debbugs/SOAP')
        ->proxy('https://bugs.debian.org/cgi-bin/soap.cgi');
    my $bugs
        = $soap->get_status( $soap->get_bugs( src => $pkg )->result() )->result;
    return unless $bugs;

    my @rcbugs;
    foreach my $b ( sort { $a <=> $b } keys %$bugs ) {
        next unless my $status = $bugs->{$b};
        next
            if $status->{done}
            or $status->{archived}
            or ( grep { !/(serious|grave|critical)/ } $status->{severity} );
        push @rcbugs, $status->{bug_num};
    }
    return @rcbugs;
}


=head1 NAME

dpt-ci-failures - query ci.debian.net for autopkgtest failures

=head1 SYNOPSIS

B<dpt ci-failures> I<[-d E<lt>distributionE<gt>]> I<[-A E<lt>architectureE<gt>]> I<[-anbhmI]>

=head1 OPTIONS

=over

=item B<-d E<lt>distributionE<gt>>

Defaults to I<unstable>.

=item B<-A E<lt>architectureE<gt>>

Defaults to I<amd64>.

=item B<-a>

Show more ("all") results (slow). By default only packages matching /perl/
and the latest versions are shown.

=item B<-b>

Additionally show RC bugs for the found packages.

=item B<-I>

Additionally show the run id for the last run (suitable for retrying a test
via the ci.debian.net API.)

=item B<-h>

Show this help.

=item B<-m>

Show full manpage.

=back

=head1 CONFIGURATION

None.

=head1 FILES

A file called F<ci.debian.net-packages-$dist-$arch.json> is stored in
F<$XDG_CACHE_HOME/pkg-perl-tools> or F<$HOME/.cache/pkg-perl-tools>.

=head1 COPYRIGHT AND LICENSE

    Copyright 2017-2018, Niko Tyni <ntyni@debian.org>
              2017-2024, gregor herrmann <gregoa@debian.org>

    This program is free software. You may distribute it under the same
    terms as Perl.
