520e1350eadf6818247556c65c0e951aca937797
[claws.git] / 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