Update thread tools
authorRicardo Mones <ricardo@mones.org>
Mon, 8 Oct 2018 13:49:29 +0000 (15:49 +0200)
committerRicardo Mones <ricardo@mones.org>
Mon, 8 Oct 2018 13:49:29 +0000 (15:49 +0200)
Patch by H.Merijn Brand

tools/README
tools/cm-break.pl [new file with mode: 0644]
tools/cm-reparent.pl

index 9d81d64..d562f46 100644 (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>
diff --git a/tools/cm-break.pl b/tools/cm-break.pl
new file mode 100644 (file)
index 0000000..7553b17
--- /dev/null
@@ -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
index 9a16da2..30eb7fd 100755 (executable)
@@ -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.