gfgit
/
claws-mail
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Update thread tools 

Patch by H.Merijn Brand
This commit is contained in:
Ricardo Mones 2018-10-08 15:49:29 +02:00 committed by Andrej Kacian
parent b63551d65c
commit 228170113b
3 changed files with 213 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
tools/README
View File

@ -5,6 +5,7 @@ Contents of the tools directory:
Action scripts:
cm-reparent.pl Fix thread parenting for two or more messages
cm-break.pl Remove thread parenting for one or more messages
freshmeat_search.pl Search freshmeat.net for selected text
google_msgid.pl Search groups.google.com for selected message-id
google_search.pl Search google.com for selected text
@ -65,6 +66,11 @@ Action scripts
COMMAND: cm-reparent.pl %F
Thread the selected messages based on date, old to new
* cm-break.pl
WORKS ON: selected messages (one or more)
COMMAND: cm-break.pl %F
Break thread references for the selected messages
* google_msgid.pl
WORKS ON: selection
COMMAND: |google_msgid.pl
@ -825,3 +831,51 @@ Extra tools
This file is Copyright 1999-2014 by the Claws Mail team.
See accompanying COPYING file for license details.
See each included script for copyright and license details.
* cm-reparent.pl
WHAT IT DOES
This script tries to fix thread parenting for two or more messages
HOW TO USE IT
Define an action as
Menu name: Reparent (fix threading)
Command: cm-reparent.pl %F
Then select from the message list all files that should be re-parented
Then invoke the action
MORE INFORMATION
$ perldoc cm-reparent.pl
REQUIREMENTS
Date::Parse
Getopt::Long
Contact: H.Merijn Brand <h.m.brand@xs4all.nl>
* cm-break.pl
WHAT IT DOES
This script tries to break thread parenting for one or more messages
HOW TO USE IT
Define an action as
Menu name: Unthread (break threading)
Command: cm-break.pl %F
Then select from the message list all files that should be un-threaded
Then invoke the action
MORE INFORMATION
$ perldoc cm-break.pl
REQUIREMENTS
Date::Parse
Getopt::Long
Contact: H.Merijn Brand <h.m.brand@xs4all.nl>

124
tools/cm-break.pl Normal file
View File

@ -0,0 +1,124 @@
#!/usr/bin/perl
use 5.14.1;
use warnings;
our $VERSION = "1.05 - 2018-10-08";
our $cmd = $0 =~ s{.*/}{}r;
sub usage {
my $err = shift and select STDERR;
say "usage: $cmd file ...";
exit $err;
} # usage
use Date::Parse;
use Getopt::Long;
GetOptions (
"help|?" => sub { usage (0); },
"V|version" => sub { say "$cmd [$VERSION]"; exit 0; },
) or usage (1);
my %f;
foreach my $fn (@ARGV) {
open my $fh, "<", $fn or die "$fn: $!\n";
my ($hdr, $body) = split m/(?<=\n)(?=\r?\n)/ => do { local $/; <$fh> }, 2;
close $fh;
$hdr && $hdr =~ m/\b(?:In-Reply-To|References)\b/i or next;
my ($mid) = $hdr =~ m{^Message-Id: (?:[\x20\t]*\n)?[\x20\t]+ (\S.*)}xmi;
my ($dte) = $hdr =~ m{^Date: (?:[\x20\t]*\n)?[\x20\t]+ (\S.*)}xmi;
my ($irt) = $hdr =~ m{^In-Reply-To: (?:[\x20\t]*\n)?[\x20\t]+ (\S.*)}xmi;
my ($ref) = $hdr =~ m{^References: (?:[\x20\t]*\n)?[\x20\t]+ (\S.*)}xmi;
my $stamp = str2time ($dte) or die $dte;
my $date = $stamp ? do {
my @d = localtime $stamp;
sprintf "%4d-%02d-%02d %02d:%02d:%02d", $d[5] + 1900, ++$d[4], @d[3,2,1,0];
} : "-";
#printf "%12s %-20s %s\n", $stamp // "-", $date, $rcv;
$f{$fn} = {
msg_id => $mid,
refs => $ref,
irt => $irt,
date => $dte,
stamp => $stamp,
sdate => $date,
hdr => $hdr,
body => $body,
};
}
foreach my $fn (sort keys %f) {
my $c = 0;
my $f = $f{$fn};
if ($f->{refs}) {
$c++;
$f->{hdr} =~ s{\nReferences:.*(?:\n\s+.*)*+}{}ig;
}
if ($f->{irt}) {
$c++;
$f->{hdr} =~ s{\nIn-Reply-To:.*(?:\n\s+.*)*+}{}ig;
}
$c or next; # No changes required
say "$f->{msg_id} => -";
my @t = stat $fn;
open my $fh, ">", $fn or die "$fn: $!\n";
print $fh $f->{hdr}, $f->{body};
close $fh or die "$fn: $!\n";
utime $t[8], $t[9], $fn;
}
__END__
=head1 NAME
cm-break.pl - remove mail from thread
=head1 SYNOPSIS
cm-break.pl ~/Mail/inbox/23 ~/Mail/inbox/45 ...
=head1 DESCRIPTION
This script should be called from within Claws-Mail as an action
Define an action as
Menu name: Unthread (break threading)
Command: cm-break.pl %F
Then select from the message list all files that should be un-threaded
Then invoke the action
All of those mails will be modified (if needed): their C<In-Reply-To:>
and C<References:> header tags are removed from the header.
=head1 SEE ALSO
L<Date::Parse>, L<Claws Mail|http://www.claws-mail.org>
cm-reparent.pl
=head1 AUTHOR
H.Merijn Brand <h.m.brand@xs4all.nl>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2018-2018 H.Merijn Brand. All rights reserved.
This library is free software; you can redistribute and/or modify it under
the same terms as Perl itself.
See the L<Artistic license|http://dev.perl.org/licenses/artistic.html>.
=cut

49
tools/cm-reparent.pl
View File

@ -3,11 +3,12 @@
use 5.14.1;
use warnings;
our $VERSION = "1.02 - 2016-06-07";
our $VERSION = "1.05 - 2018-10-08";
our $cmd = $0 =~ s{.*/}{}r;
sub usage {
my $err = shift and select STDERR;
say "usage: $0 file ...";
say "usage: $cmd file ...";
exit $err;
} # usage
@ -15,7 +16,7 @@ use Date::Parse;
use Getopt::Long;
GetOptions (
"help|?" => sub { usage (0); },
"V|version" => sub { say $0 =~ s{.*/}{}r, " [$VERSION]"; exit 0; },
"V|version" => sub { say "$cmd [$VERSION]"; exit 0; },
) or usage (1);
my $p;
@ -26,35 +27,47 @@ foreach my $fn (@ARGV) {
my ($hdr, $body) = split m/(?<=\n)(?=\r?\n)/ => do { local $/; <$fh> }, 2;
close $fh;
$hdr or next;
$hdr && $hdr =~ m/\b(?:Date|Received)\b/ or next;
my ($mid) = $hdr =~ m{^Message-Id: (.*)}mi;
my ($dte) = $hdr =~ m{^Date: (.*)}mi;
my ($irt) = $hdr =~ m{^In-Reply-To: (.*)}mi;
my ($ref) = $hdr =~ m{^References: (.*)}mi;
my ($mid) = $hdr =~ m{^Message-Id: (?:[\x20\t]*\n)?[\x20\t]+ (\S.*)}xmi;
my ($dte) = $hdr =~ m{^Date: (?:[\x20\t]*\n)?[\x20\t]+ (\S.*)}xmi;
my ($rcv) = $hdr =~ m{\nReceived: (?:[\x20\t]*\n)?[\x20\t]+ (\S.*(?:\n\s+.*)*+)}xi;
my ($irt) = $hdr =~ m{^In-Reply-To: (?:[\x20\t]*\n)?[\x20\t]+ (\S.*)}xmi;
my ($ref) = $hdr =~ m{^References: (?:[\x20\t]*\n)?[\x20\t]+ (\S.*)}xmi;
my $stamp = str2time ($dte) or next;
$rcv ||= $dte;
$rcv =~ s/[\s\r\n]+/ /g;
$rcv =~ s/\s+$//;
$rcv =~ s/.*;\s*//;
$rcv =~ s/.* id \S+\s+//i;
my $stamp = str2time ($rcv) or die $rcv;
my $date = $stamp ? do {
my @d = localtime $stamp;
sprintf "%4d-%02d-%02d %02d:%02d:%02d", $d[5] + 1900, ++$d[4], @d[3,2,1,0];
} : "-";
#printf "%12s %-20s %s\n", $stamp // "-", $date, $rcv;
$f{$fn} = {
msg_id => $mid,
refs => $ref,
irt => $irt,
date => $dte,
rcvd => $rcv,
stamp => $stamp,
sdate => $date,
hdr => $hdr,
body => $body,
};
$p //= $fn;
$stamp < $f{$p}{stamp} and $p = $fn;
}
# All but the oldest will refer to the oldest as parent
$p or exit 0;
my $pid = $f{$p}{msg_id};
my $pid = $f{$p}{msg_id} or die "Parent file $p has no Message-Id\n";
foreach my $fn (sort keys %f) {
@ -86,11 +99,18 @@ foreach my $fn (sort keys %f) {
$c or next; # No changes required
unless ($f->{msg_id}) {
warn "Child message $fn has no Message-Id, skipped\n";
next;
}
say "$f->{msg_id} => $pid";
my @t = stat $fn;
open my $fh, ">", $fn or die "$fn: $!\n";
print $fh $f->{hdr}, $f->{body};
close $fh or die "$fn: $!\n";
print $fh $f->{hdr}, $f->{body};
close $fh or die "$fn: $!\n";
utime $t[8], $t[9], $fn;
}
__END__
@ -149,6 +169,7 @@ C<X-In-Reply-To:> respectively.
=head1 SEE ALSO
L<Date::Parse>, L<Claws Mail|http://www.claws-mail.org>
cm-break.pl
=head1 AUTHOR
@ -156,7 +177,7 @@ H.Merijn Brand <h.m.brand@xs4all.nl>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2016-2016 H.Merijn Brand. All rights reserved.
Copyright (C) 2016-2018 H.Merijn Brand. All rights reserved.
This library is free software; you can redistribute and/or modify it under
the same terms as Perl itself.