diff options
Diffstat (limited to 'scripts/tagpending.pl')
| -rwxr-xr-x | scripts/tagpending.pl | 437 |
1 files changed, 437 insertions, 0 deletions
diff --git a/scripts/tagpending.pl b/scripts/tagpending.pl new file mode 100755 index 0000000..910e580 --- /dev/null +++ b/scripts/tagpending.pl @@ -0,0 +1,437 @@ +#!/usr/bin/perl +# +# tagpending: Parse a Debian changelog for a list of bugs closed +# and tag any that are not already pending as such. +# +# The original shell version of tagpending was written by Joshua Kwan +# and is Copyright 2004 Joshua Kwan <joshk@triplehelix.org> +# with changes copyright 2004-07 by their respective authors. +# +# This version is +# Copyright 2008 Adam D. Barratt +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with this program; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use strict; +use warnings; +use Getopt::Long qw(:config bundling permute no_getopt_compat); +use File::Basename; +use Dpkg::Changelog::Parse qw(changelog_parse); +use Devscripts::Debbugs; + +sub bugs_info; + +my $progname = basename($0); + +my ($opt_help, $opt_version, $opt_verbose, $opt_noact, $opt_silent); +my ($opt_online, $opt_confirm, %opt_to, $opt_wnpp, $opt_comments); +my $opt_interactive; + +# Default options +$opt_silent = 0; +$opt_verbose = 0; +$opt_online = 1; +$opt_noact = 0; +$opt_confirm = 0; +$opt_wnpp = 0; +%opt_to = (); +$opt_comments = 1; +$opt_interactive = 0; + +GetOptions( + "help|h" => \$opt_help, + "version" => \$opt_version, + "verbose|v!" => \$opt_verbose, + "noact|n" => \$opt_noact, + "comments!" => \$opt_comments, + "silent|s" => \$opt_silent, + "force|f" => sub { $opt_online = 0; }, + "confirm|c" => \$opt_confirm, + "to|t=s" => sub { $opt_to{'-v'} = $_[1] }, + "wnpp|w" => \$opt_wnpp, + "interactive|i" => \$opt_interactive, + ) + or die "Usage: $progname [options]\nRun $progname --help for more details\n"; + +if ($opt_help) { + help(); + exit 0; +} elsif ($opt_version) { + version(); + exit 0; +} + +if ($opt_verbose and $opt_silent) { + die "$progname error: --silent and --verbose contradict each other\n"; +} + +=head1 NAME + +tagpending - tags bugs that are to be closed in the latest changelog as pending + +=head1 SYNOPSIS + +B<tagpending> [I<options>] + +=head1 DESCRIPTION + +B<tagpending> parses debian/changelog to determine +which bugs would be closed if the package were uploaded. Each bug is +then marked as pending, using B<bts>(1) if it is not already so. + +=head1 OPTIONS + +=over 4 + +=item B<-n>, B<--noact> + +Check whether any bugs require tagging, but do not actually do so. + +=item B<-s>, B<--silent> + +Do not output any messages. + +=item B<-v>, B<--verbose> + +List each bug checked and tagged in turn. + +=item B<-f>, B<--force> + +Do not query the BTS, but (re)tag all bugs closed in the changelog. + +=item B<--comments> + +Include the changelog header line and the entries relating to the tagged +bugs as comments in the generated mail. This is the default. + +Note that when used in combination with B<--to>, the header line output +will always be that of the most recent version. + +=item B<--no-comments> + +Do not include changelog entries in the generated mail. + +=item B<-c>, B<--confirm> + +Tag bugs as both confirmed and pending. + +=item B<-t>, B<--to> I<version> + +Parse changelogs for all versions strictly greater than I<version>. + +Equivalent to B<dpkg-parsechangelog>'s B<-v> option. + +=item B<-i>, B<--interactive> + +Display the message which would be sent to the BTS and, except when +B<--noact> was used, prompt for confirmation before sending it. + +=item B<-w>, B<--wnpp> + +For each bug that does not appear to belong to the current package, +check whether it is filed against wnpp. If so, tag it. This allows e.g. +ITAs and ITPs closed in an upload to be tagged. + +=back + +=head1 SEE ALSO + +B<bts>(1) and B<dpkg-parsechangelog>(1) + +=cut + +if (!-f 'debian/changelog') { + die "$progname error: debian/changelog does not exist!\n"; +} + +my $changelog = changelog_parse(%opt_to); +my $source = $changelog->{Source}; +my @closes; +if ($changelog->{Closes}) { + @closes = split ' ', $changelog->{Closes}; +} +my @lines = split /\n/, $changelog->{Changes}; +my $header = $lines[1]; +my $changes = join "\n", grep /^ {3}[^[]/, @lines; + +# Add a fake entry to the end of the recorded changes +# This makes the parsing of the changes simpler +$changes .= " *"; + +my $pending; +my $open; +my %bugs = map { $_ => 1 } @closes; + +if (%bugs) { + if ($opt_online) { + if (!Devscripts::Debbugs::have_soap()) { + die +"$progname: The libsoap-lite-perl package is required for online operation; aborting.\n"; + } + + eval { + $pending = Devscripts::Debbugs::select( + "src:$source", "status:open", + "status:forwarded", "tag:pending" + ); + $open = Devscripts::Debbugs::select("src:$source", "status:open", + "status:forwarded"); + }; + + if ($@) { + die "$@\nUse --force to tag all bugs anyway.\n"; + } + } + + if ($pending) { + %bugs = (%bugs, map { $_ => 1 } @{$pending}); + } +} + +my $bug; +my $message; +my @to_tag = (); +my @wnpp_to_tag = (); + +foreach $bug (keys %bugs) { + print "Checking bug #$bug: " if $opt_verbose; + + if (grep /^$bug$/, @{$pending}) { + print "already marked pending\n" if $opt_verbose; + } else { + if (grep /^$bug$/, @{$open} or not $opt_online) { + print "needs tag\n" if $opt_verbose; + push(@to_tag, $bug); + } else { + if ($opt_wnpp) { + my $status = Devscripts::Debbugs::status($bug); + if ($status->{$bug}->{package} eq 'wnpp') { + if ($status->{$bug}->{tags} !~ /pending/) { + print "wnpp needs tag\n" if $opt_verbose; + push(@wnpp_to_tag, $bug); + } else { + print "wnpp already marked pending\n" if $opt_verbose; + } + } else { + $message + = "is closed or does not belong to this package (check bug # or force)\n"; + + print "Warning: #$bug " if not $opt_verbose; + print "$message"; + } + } else { + $message + = "is closed or does not belong to this package (check bug # or force)\n"; + + print "Warning: #$bug " if not $opt_verbose; + print "$message"; + } + } + } +} + +if (!@to_tag and !@wnpp_to_tag) { + print "$progname info: Nothing to do, exiting.\n" + if $opt_verbose or !$opt_silent; + exit 0; +} + +my @sourcepkgs = (); +my @thiscloses = (); +my $thischange = ''; +my $comments = ''; + +if (@to_tag or @wnpp_to_tag) { + if ($opt_comments) { + foreach my $change (split /\n/, $changes) { + if ($change =~ /^ {3}\*(.*)/) { + # Adapted from dpkg-parsechangelog / Changelog.pm + while ( + $thischange + && ($thischange + =~ /closes:\s*(?:bug)?\#?\s?\d+(?:,\s*(?:bug)?\#?\s?\d+)*/sig + ) + ) { + push(@thiscloses, $& =~ /\#?\s?(\d+)/g); + } + + foreach my $bug (@thiscloses) { + if ($bug and grep /^$bug$/, + @to_tag or grep /^$bug$/, @wnpp_to_tag) { + $comments .= $thischange; + last; + } + } + + @thiscloses = (); + $thischange = $change; + } else { + $thischange .= $change . "\n"; + } + } + + $comments = $header . "\n \n" . $comments . "\n \n" + if $comments; + } +} + +my @bts_args = ("bts", "--toolname", $progname); + +if ($opt_noact and not $opt_interactive) { + bugs_info; + bugs_info "wnpp" if $opt_wnpp; +} else { + if (!$opt_silent) { + bugs_info; + bugs_info "wnpp" if $opt_wnpp; + } + + if ($opt_interactive) { + if ($opt_noact) { + push(@bts_args, "-n"); + print "\nWould send this BTS mail:\n\n"; + } else { + push(@bts_args, "-i"); + } + } + + if (@to_tag) { + push(@bts_args, "limit", "source:$source"); + + if ($comments) { + $comments =~ s/\n\n/\n/sg; + $comments =~ s/\n\n/\n/m; + $comments =~ s/^ /#/mg; + push(@bts_args, $comments); + # We don't want to add comments twice if there are + # both package and wnpp bugs + $comments = ''; + } + + foreach my $bug (@to_tag) { + push(@bts_args, ".", "tag", $bug, "+", "pending"); + push(@bts_args, "confirmed") if $opt_confirm; + } + } + if (@wnpp_to_tag) { + push(@bts_args, ".") if scalar @bts_args > 1; + push(@bts_args, "package", "wnpp"); + + if ($comments) { + $comments =~ s/\n\n/\n/sg; + $comments =~ s/^ /#/mg; + push(@bts_args, $comments); + } + + foreach my $wnpp_bug (@wnpp_to_tag) { + push(@bts_args, ".", "tag", $wnpp_bug, "+", "pending"); + } + } + + system @bts_args; +} + +sub bugs_info { + my $type = shift || ''; + my @bugs; + + if ($type eq "wnpp") { + if (@wnpp_to_tag) { + @bugs = @wnpp_to_tag; + } else { + return; + } + } else { + @bugs = @to_tag; + } + + print "$progname info: "; + + if ($opt_noact) { + print "would tag"; + } else { + print "tagging"; + } + + print " these"; + print " wnpp" if $type eq "wnpp"; + print " bugs pending"; + print " and confirmed" if $opt_confirm and $type ne "wnpp"; + print ":"; + + foreach my $bug (@bugs) { + print " $bug"; + } + + print "\n"; +} + +sub help { + print <<"EOF"; +Usage: $progname [options] + +Valid options are: + --help, -h Display this message + --version Display version and copyright info + -n, --noact Only simulate what would happen during this run; + do not tag any bugs. + -s, --silent Silent mode + -v, --verbose Verbose mode: List bugs checked/tagged. + NOTE: Verbose and silent mode can't be used together. + -f, --force Do not query the BTS; (re-)tag all bug reports. + --comments Add the changelog header line and entries relating + to the bugs to be tagged to the generated mail. + (Default) + --no-comments Do not add changelog entries to the mail + -c, --confirm Tag bugs as confirmed as well as pending + -t, --to <version> Use changelog information from all versions strictly + later than <version> (mimics dpkg-parsechangelog's + -v option.) + -i, --interactive Display the message which would be sent to the BTS + and, except if --noact was used, prompt for + confirmation before sending it. + -w, --wnpp For each potentially not owned bug, check whether + it is filed against wnpp and, if so, tag it. This + allows e.g. ITA or ITPs to be tagged. + +EOF +} + +sub version { + print <<"EOF"; +This is $progname, from the Debian devscripts package, version ###VERSION### +Copyright 2008 by Adam D. Barratt <adam\@adam-barratt.org.uk>; based +on the shell script by Joshua Kwan <joshk\@triplehelix.org>. + +This program comes with ABSOLUTELY NO WARRANTY. +You are free to redistribute this code under the terms of the +GNU General Public License, version 2, or (at your option) any +later version. +EOF +} + +=head1 COPYRIGHT + +This program is Copyright 2008 by Adam D. Barratt +<adam@adam-barratt.org.uk>. + +The shell script tagpending, on which this program is based, is +Copyright 2004 by Joshua Kwan <joshk@triplehelix.org> with changes +copyright 2004-7 by their respective authors. + +This program is licensed under the terms of the GPL, either version 2 of +the License, or (at your option) any later version. + +=cut |