Bug#815220: update of cleanbug

Mike Gabriel <[email protected]> Fri, 04 Mar 2016 23:54:49 +0000

Newsgroups	gmane.linux.debian.devel.debbugs
Organization	DAS-NETZWERKTEAM
Message-ID	<20160304235449.Horde.hv3joOe0c5NmMtF3DIncBEA__43705.1691966646$1457135858$gmane$org@mail.das-netzwerkteam.de>

Hi Don,

attached find a bit improved version of the new cleanbug script.  
Please add copyright holder and license header as you see appropriate  
(also for the mbox script).

Mike
-- 

DAS-NETZWERKTEAM
mike gabriel, herweg 7, 24357 fleckeby
fon: +49 (1520) 1976 148

GnuPG Key ID 0x25771B31
mail: [email protected], http://das-netzwerkteam.de

freeBusy:
https://mail.das-netzwerkteam.de/mailxchange/kronolith/fb.php?u=m.gabriel%40das-netzwerkteam.de

cleanbug (text/plain, 2.7 KB)

#!/usr/bin/perl

use warnings;
use strict;

use POSIX qw(strftime);

use Debbugs::Config qw(:globals :text);

# for read_log_records
use Debbugs::Log qw(read_log_records write_log_records);
use Debbugs::Common qw(buglog bug_status);
use Debbugs::Status qw( split_status_fields get_bug_status);

use List::Util qw(max);

sub prompt {
	my ($query) = @_; # take a prompt string as argument
	local $| = 1; # activate autoflush to immediately show the prompt
	print $query;
	chomp(my $answer = <STDIN>);
	return $answer;
}

sub prompt_yesno {
	my ($query) = @_;
	my $answer = prompt("$query (Y/n): ");
	return (lc($answer) ne 'n');
}

sub prompt_noyes {
	my ($query) = @_;
	my $answer = prompt("$query (N/y): ");
	return (lc($answer) eq 'y');
}

sub prompt_safenoyes {
	my ($query) = @_;
	my $full_answer = 0;
	my $ret = 0;

	my $answer = '';
	while (!$full_answer) {
		$answer = prompt ("$query (NO/yes): ");
		$ret = (lc ($answer) eq 'yes');
		$full_answer = ((lc ($answer) eq 'yes') || (lc ($answer) eq 'no'));
	}

	return ($ret);
}

my $ref = shift or die;

my %bugusertags;

my $buglog = buglog($ref);
my $bug_status = bug_status($ref);

my $buglogfh;
my $cleanedbuglogfh;
if ($buglog =~ m/\.gz$/) {
    my $oldpath = $ENV{'PATH'};
    $ENV{'PATH'} = '/bin:/usr/bin';
    $buglogfh = IO::File->new("zcat $buglog |") or die("open log for $ref: $!");
    $ENV{'PATH'} = $oldpath;
} else {
    $buglogfh = IO::File->new($buglog,'r') or die("open log for $ref: $!");
}

my %status =
    %{split_status_fields(get_bug_status(bug=>$ref,
                                         bugusertags => \%bugusertags,
                                        ))};

my @records;
eval{
     @records = read_log_records($buglogfh);
};
my @cleaned_records = ();

binmode(STDOUT,":raw");
my $date = strftime "%a %b %d %T %Y", localtime;

my $message_number=0;

for my $record (@records) {
	my ($msg_id) = $record->{text} =~ /^Message-Id:\s+<(.+)>/im;
	my @lines = split( "\n", $record->{text}, -1 );
	if ( $lines[ 1 ] =~ m/^From / ) {
		my $tmp = $lines[ 0 ];
		$lines[ 0 ] = $lines[ 1 ];
		$lines[ 1 ] = $tmp;
	}
	if ( !( $lines[ 0 ] =~ m/^From / ) ) {
		unshift @lines, "From unknown $date";
	}
	map { s/^(>*From )/>$1/ } @lines[ 1 .. $#lines ];
	print join( "\n", @lines ) . "\n";

	if ( prompt_yesno("Keep this message in the bug report") ) {
		print "ANSWER WAS: YES\n\n";
		push @cleaned_records, $record;
	} else {
		print "\nANSWER WAS: NO\n\n";
	}
}

$buglogfh->close();

if ( prompt_safenoyes("Really write back the bug log of bug $ref") ) {
	print "\nANSWER WAS: YES\n\n";
	$cleanedbuglogfh = IO::File->new($buglog,'w') or die("open log for $ref: $!");
	write_log_records(logfh => $cleanedbuglogfh,
	                  records => \@cleaned_records,
	);
} else {
	print "\nANSWER WAS: NO\n\n";
}

exit 0;

signature.asc (application/pgp-signature, 819 B)