commit ebf29bd896d8dc0998aa03e5b8b5e8c61e4e5dab
parent 4bb9ba0e8331c149c5ac55ccd1f1cafe08342352
Author: Ricardo Mones <ricardo@mones.org>
Date: Tue, 7 Jun 2016 12:59:43 +0200
Add new action script for fixing threads
Many thanks to H.Merijn Brand for contributing it!
Diffstat:
2 files changed, 144 insertions(+), 0 deletions(-)
diff --git a/tools/README b/tools/README
@@ -12,6 +12,7 @@ Action scripts:
uudec Decode and display uuencoded images
uuooffice Decode uuencoded attachments and open them with
OpenOffice
+ cm-reparent.pl Fix thread parenting for two or more messages
Addressbook conversion:
csv2addressbook.pl Import Becky, Thunderbird, Kmail, Gmail and Fox
@@ -89,6 +90,11 @@ Action scripts
COMMAND: uuooffice %f&
Decode uuencoded attachments and open them with OpenOffice
+* cm-reparent.pl
+ WORKS ON: selected messages (two or more)
+ COMMAND: cm-reparent.pl %F
+ Fix threading by setting old messages first on thread
+
* More action examples can be found at the Claws Mail FAQ
http://www.claws-mail.org/faq/index.php/Actions
diff --git a/tools/cm-reparent.pl b/tools/cm-reparent.pl
@@ -0,0 +1,138 @@
+#!/usr/bin/perl
+
+use 5.14.1;
+use warnings;
+
+our $VERSION = "1.02 - 2016-06-07";
+
+sub usage {
+ my $err = shift and select STDERR;
+ say "usage: $0 file ...";
+ exit $err;
+ } # usage
+
+use Date::Parse;
+use Getopt::Long;
+GetOptions (
+ "help|?" => sub { usage (0); },
+ "V|version" => sub { say $0 =~ s{.*/}{}r, " [$VERSION]"; exit 0; },
+ ) or usage (1);
+
+my $p;
+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 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;
+
+ $f{$fn} = {
+ msg_id => $mid,
+ refs => $ref,
+ irt => $irt,
+ date => $dte,
+ stamp => $stamp,
+
+ 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};
+
+foreach my $fn (sort keys %f) {
+
+ $fn eq $p and next;
+
+ my $c = 0;
+
+ my $f = $f{$fn};
+ if ($f->{refs}) {
+ unless ($f->{refs} eq $pid) {
+ $c++;
+ $f->{hdr} =~ s{^(?=References:)}{References: $pid\nX-}mi;
+ }
+ }
+ else {
+ $c++;
+ $f->{hdr} =~ s{^(?=Message-Id:)}{References: $pid\n}mi;
+ }
+ if ($f->{irt}) {
+ unless ($f->{irt} eq $pid) {
+ $c++;
+ $f->{hdr} =~ s{^(?=In-Reply-To:)}{In-Reply-To: $pid\nX-}mi;
+ }
+ }
+ else {
+ $c++;
+ $f->{hdr} =~ s{^(?=Message-Id:)}{In-Reply-To: $pid\n}mi;
+ }
+
+ $c or next; # No changes required
+
+ say "$f->{msg_id} => $pid";
+
+ open my $fh, ">", $fn or die "$fn: $!\n";
+ print $fh $f->{hdr}, $f->{body};
+ close $fh or die "$fn: $!\n";
+ }
+
+__END__
+
+=head1 NAME
+
+cm-reparent.pl - fix mail threading
+
+=head1 SYNOPSIS
+
+ cm-reparent.pl ~/Mail/inbox/23 ~/Mail/inbox/45 ...
+
+=head1 DESCRIPTION
+
+This script should be called from withing Claws-Mail as an action
+
+Define an action as
+
+ Menu name: Reparent (fix threading)
+ Command: cm-reparent.pl %F
+
+Then select from the list-view all files that should be re-parented
+
+Then invoke the action
+
+All but the oldest of those mails will be modified (if needed) to
+reflect that the oldest mail is the parent of all other mails
+
+=head1 SEE ALSO
+
+L<Date::Parse>, L<Claws Mail|http://www.claws-mail.org>
+
+=head1 AUTHOR
+
+H.Merijn Brand <h.m.brand@xs4all.nl>
+
+=head1 COPYRIGHT AND LICENSE
+
+ Copyright (C) 2016-2016 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
