[Commits] [SCM] claws branch, master, updated. 3.13.2-147-gebf29bd

[mones at claws-mail.org]

The branch, master has been updated
       via  ebf29bd896d8dc0998aa03e5b8b5e8c61e4e5dab (commit)
      from  4bb9ba0e8331c149c5ac55ccd1f1cafe08342352 (commit)

Summary of changes:
 tools/README         |    6 +++
 tools/cm-reparent.pl |  138 ++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 144 insertions(+)
 create mode 100755 tools/cm-reparent.pl


- Log -----------------------------------------------------------------
commit ebf29bd896d8dc0998aa03e5b8b5e8c61e4e5dab
Author: Ricardo Mones <ricardo at mones.org>
Date:   Tue Jun 7 12:59:43 2016 +0200

    Add new action script for fixing threads
    
    Many thanks to H.Merijn Brand for contributing it!

diff --git a/tools/README b/tools/README
index 1d2bc57..f68ea6b 100644
--- 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
new file mode 100755
index 0000000..46e2cdb
--- /dev/null
+++ 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 at 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

-----------------------------------------------------------------------


hooks/post-receive
-- 
Claws Mail