Bug#815220: New script: cleanbug

[Mike Gabriel]

Package: debbugs
Severity: wishlist
Version: 2.6~exp1

Hi all,





Greets,
Mike
--

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

GnuPG Key ID 0x25771B31
mail: mike.gabr...@das-netzwerkteam.de, http://das-netzwerkteam.de

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

#!/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');
}

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_noyes("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;

I have created a little but very helpful script for debbugs (placed in /usr/lib/debbugs): cleanbug. The script is attached and currently in use while cleaning up SPAM and virus infected mails from bugs.x2go.org.

pgpMG6rwxZK5I.pgp
Description: Digitale PGP-Signatur