#!/usr/bin/perl

use strict;
use warnings;
use feature qw( say );

use SOAP::Lite;

use Pod::Usage qw( pod2usage );
use Term::ANSIColor;
use Time::Piece;

# honour CLICOLOR; NO_COLOR is automatically honoured
if ( exists( $ENV{CLICOLOR} ) && $ENV{CLICOLOR} == 0 ) {
    if ( !$ENV{CLICOLOR_FORCE} ) {
        $ENV{ANSI_COLORS_DISABLED} = 1;
    }
}
# also disable colors if STDOUT is not a tty
$ENV{ANSI_COLORS_DISABLED} = 1 unless -t STDOUT;

# handle options
use Getopt::Std;
$Getopt::Std::STANDARD_HELP_VERSION = 1; # don't continue with unknown option
my %opts;
getopts( 'afhmct', \%opts ) || pod2usage(2);
my $showallbugs   = exists $opts{'a'};
my $showallfields = exists $opts{'f'};
my $nocolors      = exists $opts{'c'};
my $notitle       = exists $opts{'t'};
pod2usage(1)                              if $opts{'h'};
pod2usage( -exitval => 0, -verbose => 2 ) if $opts{'m'};
sub HELP_MESSAGE {    # --help
    pod2usage(1);
}
$ENV{ANSI_COLORS_DISABLED} = 1 if $nocolors;

# which package?
my $pkg;
$pkg = shift @ARGV || do {
    use Debian::Control;
    my $c = Debian::Control->new();
    $c->read('debian/control');
    $pkg = $c->source->Source;
};
die("There's something wrong with package '$pkg'\n") unless $pkg;

# let's start
unless ($notitle) {
    say colored( ['cyan'], "Bugs in src:$pkg" );
    say colored( ['cyan'], '============', '=' x length($pkg) );
}

# get all bug infos
my $soap = SOAP::Lite->uri('Debbugs/SOAP')
    ->proxy('http://bugs.debian.org/cgi-bin/soap.cgi');
my $bugs
    = $soap->get_status( $soap->get_bugs( src => $pkg )->result() )->result;
hooray() unless $bugs;

# show us the info
my $count = 0;
foreach my $bug ( sort { $a <=> $b } keys %$bugs ) {
    next unless my $status = $bugs->{$bug};
    next if !$showallbugs && ( $status->{done} || $status->{archived} );
    $count++;
    my $color
        = ( grep {/(serious|grave|critical)/} $status->{severity} )
        ? 'red'
        : 'magenta';
    print "\n";
    say colored( [$color],
        "bug_num: " . tab('bug_num') . "#$status->{bug_num}" );
    delete $status->{bug_num};
    if ( !$showallfields ) {
        say "$_: ", tab($_), "$status->{$_}"
            for qw(originator subject severity forwarded tags);
        my @dates;
        for (qw(date last_modified)) {
            push @dates,
                  "$_: "
                . ( !scalar @dates ? tab($_) : '' )
                . localtime( $status->{$_} )->strftime("%Y-%m-%d %H:%M:%S");
        }
        say join ' | ', @dates;
        say 'versions: ', tab('versions'),
            join ' | ', @{ $status->{found_versions} };
    } else {
        foreach my $field ( sort keys %{$status} ) {
            # "dont't use" per spec: https://wiki.debian.org/DebbugsSoapInterface
            next
                if grep /^$field$/,
                qw(keywords fixed_date found_date id found fixed);
            my $value = $status->{$field};
            if ( ref($value) eq 'ARRAY' ) {
                say "$field: ", join ' | ', @{$value};
            } elsif ( ref($value) eq 'HASH' ) {
                # nothing left after the grep above but still
                say "$field: ";
                say "\t$_ => $value->{$_}" foreach keys %{$value};
            } else {
                # dates
                if ( grep /^$field$/, qw(date last_modified log_modified) ) {
                    $value = localtime($value)->strftime("%Y-%m-%d %H:%M:%S");
                }
                say "$field: $value";
            }
        }
    }
}
hooray() unless $count;

sub tab {
    my $key = shift;
    return ' ' x ( 10 - length($key) );
}

sub hooray {
    say colored( ['green'], 'None \o/' );
    exit(0);
}

__END__

=head1 NAME

bts-srcpkg - query bugs.debian.org for bugs in a source package

=head1 SYNOPSIS

B<bts-srcpkg> I<[-a]> I<[-f]> I<[-h]> I<[-m]> I<[-c]> I<[-t]> I<[source package name]>

=head1 DESCRIPTION

B<bts-srcpkg> queries the Debian BTS for bugs in a I<source package>.

The I<source package name> can be passed as a command line parameter.
By default, it is read from F<debian/control> in the current directory.

If you are in a Debian source directory, you can just type B<bts-srcpkg> to
get a list of the open bugs of the package you are working on.

=head1 ARGUMENTS

=over

=item B<source package name>

Name of the source package to query bugs for.
By default, the name is taken from F<debian/control> in the current
directory.

=back

=head1 OPTIONS

=over

=item B<-a> Show all bugs of a source package.

Also show done or archived bugs.
By default, only open bugs are shown.

=item B<-f> Show all fields of a bug.

Also show less relevant fields.
By default, only bug_num, originator, subject, severity, forwarded, and tags
are shown.

=item B<-c> Disable colored output.

Don't colorize output.
By default, output uses colors, unless STDOUT is not a tty or the
environment variables CLICOLOR or NO_COLOR are set to false or true,
respectively.

=item B<-t> Disable title.

Don't output the title with the packagename.
Might be convenient when called from another script.

=item B<-h>

Show this help.

=item B<-m>

Show full manpage.

=back

=head1 SEE ALSO

=over

=item L<bts(1)>

=item https://www.debian.org/Bugs/

=item https://wiki.debian.org/DebbugsSoapInterface

=back

=head1 COPYRIGHT AND LICENSE

Copyright 2011, 2016, 2021, 2022, gregor herrmann E<lt>gregoa@debian.orgE<gt>

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