tools/cm-reparent.pl

   1 #!/usr/bin/perl
   2
   3 use 5.14.1;
   4 use warnings;
   5
   6 our $VERSION = "1.02 - 2016-06-07";
   7
   8 sub usage {
   9     my $err = shift and select STDERR;
  10     say "usage: $0 file ...";
  11     exit $err;
  12     } # usage
  13
  14 use Date::Parse;
  15 use Getopt::Long;
  16 GetOptions (
  17     "help|?"    => sub { usage (0); },
  18     "V|version" => sub { say $0 =~ s{.*/}{}r, " [$VERSION]"; exit 0; },
  19     ) or usage (1);
  20
  21 my $p;
  22 my %f;
  23 foreach my $fn (@ARGV) {
  24
  25     open my $fh, "<", $fn or die "$fn: $!\n";
  26     my ($hdr, $body) = split m/(?<=\n)(?=\r?\n)/ => do { local $/; <$fh> }, 2;
  27     close $fh;
  28
  29     $hdr or next;
  30
  31     my ($mid) = $hdr =~ m{^Message-Id: (.*)}mi;
  32     my ($dte) = $hdr =~ m{^Date: (.*)}mi;
  33     my ($irt) = $hdr =~ m{^In-Reply-To: (.*)}mi;
  34     my ($ref) = $hdr =~ m{^References: (.*)}mi;
  35
  36     my $stamp = str2time ($dte) or next;
  37
  38     $f{$fn} = {
  39         msg_id  => $mid,
  40         refs    => $ref,
  41         irt     => $irt,
  42         date    => $dte,
  43         stamp   => $stamp,
  44
  45         hdr     => $hdr,
  46         body    => $body,
  47         };
  48
  49     $p //= $fn;
  50
  51     $stamp < $f{$p}{stamp} and $p = $fn;
  52     }
  53
  54 # All but the oldest will refer to the oldest as parent
  55
  56 $p or exit 0;
  57 my $pid = $f{$p}{msg_id};
  58
  59 foreach my $fn (sort keys %f) {
  60
  61     $fn eq $p and next;
  62
  63     my $c = 0;
  64
  65     my $f = $f{$fn};
  66     if ($f->{refs}) {
  67         unless ($f->{refs} eq $pid) {
  68             $c++;
  69             $f->{hdr} =~ s{^(?=References:)}{References: $pid\nX-}mi;
  70             }
  71         }
  72     else {
  73         $c++;
  74         $f->{hdr} =~ s{^(?=Message-Id:)}{References: $pid\n}mi;
  75         }
  76     if ($f->{irt}) {
  77         unless ($f->{irt} eq $pid) {
  78             $c++;
  79             $f->{hdr} =~ s{^(?=In-Reply-To:)}{In-Reply-To: $pid\nX-}mi;
  80             }
  81         }
  82     else {
  83         $c++;
  84         $f->{hdr} =~ s{^(?=Message-Id:)}{In-Reply-To: $pid\n}mi;
  85         }
  86
  87     $c or next; # No changes required
  88
  89     say "$f->{msg_id} => $pid";
  90
  91     open my $fh, ">", $fn or die "$fn: $!\n";
  92     print $fh $f->{hdr}, $f->{body};
  93     close $fh or die "$fn: $!\n";
  94     }
  95
  96 __END__
  97
  98 =head1 NAME
  99
 100 cm-reparent.pl - fix mail threading
 101
 102 =head1 SYNOPSIS
 103
 104  cm-reparent.pl ~/Mail/inbox/23 ~/Mail/inbox/45 ...
 105
 106 =head1 DESCRIPTION
 107
 108 This script should be called from within Claws-Mail as an action
 109
 110 Define an action as
 111
 112   Menu name:  Reparent (fix threading)
 113   Command:    cm-reparent.pl %F
 114
 115 Then select from the message list all files that should be re-parented
 116
 117 Then invoke the action
 118
 119 All but the oldest of those mails will be modified (if needed) to
 120 reflect that the oldest mail is the parent of all other mails
 121
 122 Given 4 files A, B, C, and D like
 123
 124  File         Message-Id    Date
 125  A            123AC_12      2016-06-01 12:13:14
 126  B            aFFde2993     2016-06-01 13:14:15
 127  C            0000_1234     2016-06-02 10:18:04
 128  D            foo_bar_12    2016-06-03 04:00:00
 129
 130 The new tree will be like
 131
 132  A            123AC_12      2016-06-01 12:13:14
 133  +- B         aFFde2993     2016-06-01 13:14:15
 134  +- C         0000_1234     2016-06-02 10:18:04
 135  +- D         foo_bar_12    2016-06-03 04:00:00
 136
 137 and not
 138
 139  A            123AC_12      2016-06-01 12:13:14
 140  +- B         aFFde2993     2016-06-01 13:14:15
 141     +- C      0000_1234     2016-06-02 10:18:04
 142        +- D   foo_bar_12    2016-06-03 04:00:00
 143
 144 =head1 SEE ALSO
 145
 146 L<Date::Parse>, L<Claws Mail|http://www.claws-mail.org>
 147
 148 =head1 AUTHOR
 149
 150 H.Merijn Brand <h.m.brand@xs4all.nl>
 151
 152 =head1 COPYRIGHT AND LICENSE
 153
 154  Copyright (C) 2016-2016 H.Merijn Brand.  All rights reserved.
 155
 156 This library is free software;  you can redistribute and/or modify it under
 157 the same terms as Perl itself.
 158 See the L<Artistic license|http://dev.perl.org/licenses/artistic.html>.
 159
 160 =cut