#! /usr/bin/perl

=head1 NAME

bts - developers' command line interface to the BTS

=cut
#'

use 5.6.0;
use warnings;
use strict;

my $version='###VERSION###';

my @valid_tags=qw(patch wontfix moreinfo unreproducible fixed security potato woody sid help pending upstream);
my @valid_severities=qw(wishlist minor normal serious important critical grave);

my $browser;  # Will set if necessary
my $btsurl='http://bugs.debian.org/';
my $btsemail='control@bugs.debian.org';

=head1 SYNOPSIS

B<bts> command [args] [#comment] [.|, command [args] [#comment]] ...

=head1 DESCRIPTION

This is a command line interface to the bug tracking system, intended mainly
for use by developers. It lets the BTS be manipulated using simple commands
that can be run at the prompt or in a script, does various sanity checks on
the input, and constructs and sends a mail to the BTS control address for
you.

In general, the command line interface is the same as what you would write
in a mail to control@bugs.debian.org, just prefixed with "bts". For
example:

 % bts close 85942
 % bts severity 69042 normal
 % bts merge 69042 43233
 % bts retitle 69042 blah blah

A few additional commands have been added for your convenience, and this
program is less strict about what constitutes a valid bug number. For example,
"close Bug#85942" is understood, as is "close #85942".

Also, for your convenience, this program allows you to abbreviate commands
to the shortest unique substring (similar to how cvs lets you abbreviate
commands). So it understands things like "bts cl 85942".

It is also possible to include a comment in the mail sent to the BTS. If
your shell does not strip out the comment in a command like
"bts severity 30321 normal #inflated severity", then this program is smart
enough to figure out where the comment is, and include it in the email.
Note that most shells do strip out such comments before they get to the
program, unless the comment is quoted.

You can specify multiple commands by separating them with a single dot,
rather like B<update-rc.d>; a single comma may also be used; all the
commands will then be sent in a single mail. For example (quoting where
necessary so that B<bts> sees the comment):

 % bts severity 95672 normal , merge 95672 95673 \#they\'re the same!

Please use this program responsibly, and do take our users into
consideration.

=head1 COMMANDS

For full details about the commands, see the BTS documentation.

=over 4

=item show <bug>

Display a particular bug in a web browser. The browser can be configured by
setting the BROWSER environment variable.  The conventions follow those
defined by Eric Raymond at http://www.tuxedo.org/~esr/BROWSER/; we here
reproduce the relevant part.

The value of BROWSER may consist of a colon-separated series of
browser command parts. These should be tried in order until one
succeeds. Each command part may optionally contain the string "%s"; if
it does, the URL to be viewed is substituted there. If a command part
does not contain %s, the browser is to be launched as if the URL had
been supplied as its first argument. The string %% must be substituted
as a single %.

Rationale: We need to be able to specify multiple browser commands so
programs obeying this convention can do the right thing in either X or
console environments, trying X first. Specifying multiple commands may
also be useful for people who share files like .profile across
multiple systems. We need %s because some popular browsers have
remote-invocation syntax that requires it. Unless %% reduces to %, it
won't be possible to have a literal %s in the string.

For example, on most Linux systems a good thing to do would be:

BROWSER='mozilla -raise -remote "openURL(%s,new-window)":links'

=cut
#'

sub bts_show {
        my $thing=shift or die "display what bug?\n";
        execbrowser($btsurl.$thing);
}

=item bugs <package>

=item bugs <maintainer>

=item bugs

Display all of a maintainer or package's bugs, in a web browser. If neither
a maintainer email address nor a package is specified, it will display your
bugs (if DEBEMAIL is set to the appropriate email address).

=cut
#'

sub bts_bugs {
        my $email = shift;
        if (! $email) {
                if (! defined $ENV{DEBEMAIL}) {
                        die "Please set DEBEMAIL to your debian email address.\n"
                }
                $email=$ENV{DEBEMAIL};
        }
        execbrowser($btsurl.$email);
}

=item close <bug>

Close a bug. Remember that using this to close a bug is often bad manners,
sending an informative mail to bug-done@bugs.debian.org is much better.

=cut

sub bts_close {
        my $bug=checkbug(shift) or die "close what bug?\n";
	warn "Please remember to send an informative mail to $bug\@bugs.debian.org\nsaying why you have closed the bug!  Thanks.\n";
        mailbts("closing $bug", "close $bug");
}

=item reopen <bug> <submitter>

Reopen a bug, with optional submitter.

=cut

sub bts_reopen {
        my $bug=checkbug(shift) or die "reopen what bug?\n";
        my $submitter=shift || ''; # optional
        mailbts("reopening $bug", "reopen $bug $submitter");
}

=item retitle <bug> <title>

Change the title of the bug.

=cut

sub bts_retitle {
        my $bug=checkbug(shift) or die "retitle what bug?\n";
        my $title=join(" ", @_);
        if (! length $title) {
                die "set title of $bug to what?\n";
        }
        mailbts("retitle $bug to $title", "retitle $bug $title");
}

=item reassign <bug> <package>

Reassign a bug to a different package.

=cut

sub bts_reassign {
        my $bug=checkbug(shift) or die "reassign what bug?\n";
        my $package=shift or die "reassign #$bug to what package?\n";
        mailbts("reassign $bug to $package", "reassign $bug $package");
}

=item merge <bug> <bug> [<bug> ...]

Merge a set of bugs together.

=cut

sub bts_merge {
        my @bugs=map { checkbug($_) } @_;
        @bugs > 1 or die "at least two bug numbers to be merged must be specified?\n";
        mailbts("merging @bugs", "merge @bugs");
}

=item unmerge <bug>

Unmerge a bug.

=cut

sub bts_unmerge {
        my $bug=checkbug(shift) or die "unmerge what bug?\n";
        mailbts("unmerging $bug", "unmerge $bug");
}

=item tag <bug> [+|-|=] tag [tag ..]

=item tags <bug> [+|-|=] tag [tag ..]

Set or unset a tag on a bug. The tag may be abbreviated to any unique
substring. Multiple tags may be specified as well. The two commands
(tag and tags) are identical.

=cut

sub bts_tags {
        my $bug=checkbug(shift) or die "tag what bug?\n";
        if (! @_) {
                die "set what tag?\n";
        }
        # Parse the rest of the command line.
        my $flag="";
        my @commands;
        foreach my $word (@_) {
                if ($word eq '-' or $word eq '+' or $word eq '=') {
                        $flag=$word;
                }
                else {
                        my @matches = grep /^\Q$word\E/, @valid_tags;
                        if (@matches != 1) {
                                if ($word =~ /^[-+=]/) {
                                        die "The +|-|= flag must not be joined to the tags.  Run bts help for usage info.\n";
                                }
                                die "\"$word\" is not a valid tag. Choose from: @valid_tags\n";
                        }
                        push @commands, "tag $bug $flag $matches[0]";
                }
        }
        mailbts("tagging $bug", join("\n", @commands));
}

=item severity <bug> <severity>

Change the severity of a bug. The severity may be abbreviated to any unique
substring.

=cut

sub bts_severity {
        my $bug=checkbug(shift) or die "change the severity of what bug?\n";
        my $severity=lc(shift) or die "set #$bug\'s severity to what?\n";
        my @matches = grep /^\Q$severity\E/i, @valid_severities;
        if (@matches != 1) {
                die "\"$severity\" is not a valid severity.\nChoose from: @valid_severities\n";
        }
        mailbts("severity of $bug is $matches[0]", "severity $bug $matches[0]");
}

=item forwarded <bug> <email>

Mark the bug as forwarded to the given email address.

=cut

sub bts_forwarded {
        my $bug=checkbug(shift) or die "mark what bug as forwarded?\n";
        my $email=join(' ', @_);
        if (! length $email) {
                die "mark bug $bug as forwarded to what email address?\n"
        }
        mailbts("bug $bug is forwarded to $email", "forwarded $bug $email");
}

=item notforwarded <bug>

Mark a bug as not forwarded.

=cut

sub bts_notforwarded {
        my $bug=checkbug(shift) or die "what bug?\n";
        mailbts("bug $bug is not forwarded", "notforwarded $bug");
}

# Add any new commands here.

=item version

Display version and copyright information.

=cut

sub bts_version {
        (my $progname = $0) =~ s%.*/%%;
        print STDOUT "$progname version $version\n";
        print STDOUT "Copyright (C) 2001 by Joey Hess <joeyh\@debian.org>.\n";
	print STDOUT "It is licensed under the terms of the GPL.\n";
        exit(0);
}

=item help

Display a short summary of commands, suspiciously similar to parts of this
man page.

=cut

sub bts_help {
        my $exit = $_[0] || 0;
        (my $progname = $0) =~ s%.*/%%;
        print STDERR "Usage: $progname command [args] [#comment] [.|, command [args] [#comment]] ...\n";
        seek DATA, 0, 0;
        while (<DATA>) {
                print STDERR "\t$1\n" if /^=item\s(.*)/;
		last if defined $1 and $1 eq 'help';
        }
        exit($exit);
}

# Command line parse.
if ($ARGV[0] eq '--help') {
        bts_help(0);
}
if ($ARGV[0] eq '--version') {
        bts_version;
}
# Otherwise, parse the arguments
my @command;
my @args;
our @comment=('');
my $ncommand = 0;
my $iscommand = 1;
foreach (@ARGV) {
        if ($_ =~ /^[\.,]$/) {
                $ncommand++;
                $iscommand = 1;
		$comment[$ncommand] = '';
        }
        elsif ($iscommand) {
                push @command, $_;
                $iscommand = 0;
        }
        elsif ($comment[$ncommand] or /^\#/) {
                $comment[$ncommand] .= " $_";
        }
        else {
                push @{$args[$ncommand]}, $_;
        }
}
push @command, '' if $iscommand;

# Grub through the symbol table to find matching commands.
my $subject = '';
my $body = '';
our $index;
for $index (0 .. $ncommand) {
        my @matches=grep /^bts_\Q$command[$index]\E/, keys %::;
        bts_help(1) if @matches != 1;
        no strict 'refs';
        $matches[0]->(@{$args[$index]});
}

# Send all cached commands.
mailbtsall($subject, $body);

# Validate a bug number. Strips out extraneous leading junk, allowing
# for things like "#74041" and "Bug#94921"
sub checkbug {
        my $bug=$_[0] or return "";

        $bug=~s/^[^0-9]*//;
        if (! length $bug || $bug !~ /^[0-9]+$/) {
                die "\"$_[0]\" does not look like a bug number\n";
        }
        return $bug;
}

# Stores up some extra information for a mail to the bts.
sub mailbts {
        if ($subject eq '') {
                $subject = $_[0];
        }
        elsif (length($subject) + length($_[0]) < 100) {
                $subject .= ", $_[0]";
        }
        else {
                $subject .= " ...";
        }
        $body .= "$comment[$index]\n" if $comment[$index];
        $body .= "$_[1]\n";
}

# Sends all cached mail to the bts (duh).
sub mailbtsall {
        my $subject=shift;
        my $body=shift;

        if ($ENV{'DEBEMAIL'}) {
                # We need to fake the From: line
                my $from = $ENV{'DEBFULLNAME'} || '';
                if (! $from) {
                        # Perhaps not ideal, but it will have to do
                        $from = (getpwuid($<))[6];
                        $from =~ s/,.*//;
                }
                $from .= " <$ENV{'DEBEMAIL'}>";
                my $date = `822-date`;
                chomp $date;

                my $pid = open(MAIL, "|-");
                if (! defined $pid) {
                        die "Couldn't fork: $!";
                }
                if ($pid) {
                        # parent
                        print MAIL <<"EOM";
From: $from
To: $btsemail
Subject: $subject
Date: $date

$body
EOM
                        close MAIL or die "sendmail error: $!";
                }
                else {
                        # child
                        exec("/usr/sbin/sendmail", "-t")
                                or die "error running sendmail: $!";
                }
        }
        else {  # No DEBEMAIL
                my $pid = open(MAIL, "|-");
                if ($pid) {
                        # parent
                        print MAIL $body;
                        close MAIL or die "mail: $!";
                }
                else {
                        # child
                        exec("mail", "-s$subject", $btsemail)
                                or die "error running mail: $!";
                }
        }
}

# Determines which browser to use
sub execbrowser {
        my $URL = $_[0];

        my $browserlist = $ENV{'BROWSER'} ||
                'w3m:links:lynx:mozilla -raise -remote "openURL(%s,new-window)":netscape -raise -remote "openURL(%s,new-window)"';

        foreach my $testbrowser (split /:/, $browserlist) {
                $testbrowser =~ /^(\S+)/;
                my $browsername = $1;
                if (system("command -v $browsername 2>&1 > /dev/null") == 0) {
                        $browser = $testbrowser;
                        last;
                }
        }

        if (! defined $browser) {
                die "Can't find a browser; please set the BROWSER environment variable!\n";
        }

        # Yuck! Have to build a parser for substitutions %% -> %, %s -> $URL
        # This is non-trivial!
        my @split_command = split /(%%)/, $browser, -1;
        my $substs = 0;
        map { s/^%%$/%/; $substs=1 if /%s/; s/%s/$URL/g; } @split_command;
        $browser = join('', @split_command);
        $browser .= " $URL" unless $substs;

        exec $browser or die "Couldn't exec $browser: $!";
}

=back

=head1 ENVIRONMENT VARIABLES

=over 4

=item DEBEMAIL

If this is set, the From: line in the email will be set to use this email
address instead of your normal email address (as would be determined by
B<mail>).

=back

=over 4

=item DEBFULLNAME

If DEBEMAIL is set, DEBFULLNAME is examined to determine the full name
to use; if this is not set, B<bts> attempts to determine a name from
your passwd entry.

=back

=over 4

=item BROWSER

If set, it specifies the browser to use for the 'show' and 'bugs'
options.  See the description above.

=back

=head1 BUGS

No caching is done of requested data from the BTS, unless the web browser
you use is configured to use a proxy.

=head1 COPYRIGHT

This program is Copyright (C) 2001 by Joey Hess <joeyh@debian.org>.
It is licensed under the terms of the GPL.

=cut

# Please leave this alone unless you understand the seek above.
__DATA__