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 by
 121 adding or altering the header lines C<In-Reply-To:> and C<References:>
 122
 123 Given 4 files A, B, C, and D like
 124
 125  File         Message-Id    Date
 126  A            123AC_12      2016-06-01 12:13:14
 127  B            aFFde2993     2016-06-01 13:14:15
 128  C            0000_1234     2016-06-02 10:18:04
 129  D            foo_bar_12    2016-06-03 04:00:00
 130
 131 The new tree will be like
 132
 133  A            123AC_12      2016-06-01 12:13:14
 134  +- B         aFFde2993     2016-06-01 13:14:15
 135  +- C         0000_1234     2016-06-02 10:18:04
 136  +- D         foo_bar_12    2016-06-03 04:00:00
 137
 138 and not like
 139
 140  A            123AC_12      2016-06-01 12:13:14
 141  +- B         aFFde2993     2016-06-01 13:14:15
 142     +- C      0000_1234     2016-06-02 10:18:04
 143        +- D   foo_bar_12    2016-06-03 04:00:00
 144
 145 Existing entries of C<References:> and C<In-Reply-To:> in the header
 146 of any of B, C, or D will be preserved as C<X-References:> or
 147 C<X-In-Reply-To:> respectively.
 148
 149 =head1 SEE ALSO
 150
 151 L<Date::Parse>, L<Claws Mail|http://www.claws-mail.org>
 152
 153 =head1 AUTHOR
 154
 155 H.Merijn Brand <h.m.brand@xs4all.nl>
 156
 157 =head1 COPYRIGHT AND LICENSE
 158
 159  Copyright (C) 2016-2016 H.Merijn Brand.  All rights reserved.
 160
 161 This library is free software;  you can redistribute and/or modify it under
 162 the same terms as Perl itself.
 163 See the L<Artistic license|http://dev.perl.org/licenses/artistic.html>.
 164
 165 =cut