commit 788d627c282bd3e8829383fe3dcbe47b0f285671
parent 595de51b0f44e283734b08ed785c75ba879983da
Author: Ricardo Mones <ricardo@mones.org>
Date: Mon, 8 Oct 2018 15:49:29 +0200
Update thread tools
Patch by H.Merijn Brand
Diffstat:
| M | tools/README | | | 54 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | tools/cm-break.pl | | | 124 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| M | tools/cm-reparent.pl | | | 53 | +++++++++++++++++++++++++++++++++++++---------------- |
3 files changed, 215 insertions(+), 16 deletions(-)
diff --git a/tools/README b/tools/README
@@ -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>
diff --git a/tools/cm-break.pl b/tools/cm-break.pl
@@ -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
diff --git a/tools/cm-reparent.pl b/tools/cm-reparent.pl
@@ -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;
-
- 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 $stamp = str2time ($dte) or next;
+ $hdr && $hdr =~ m/\b(?:Date|Received)\b/ 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 ($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;
+
+ $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.
