Fix phrasing, terminology and typos
[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 =head1 SEE ALSO
123
124 L<Date::Parse>, L<Claws Mail|http://www.claws-mail.org>
125
126 =head1 AUTHOR
127
128 H.Merijn Brand <h.m.brand@xs4all.nl>
129
130 =head1 COPYRIGHT AND LICENSE
131
132  Copyright (C) 2016-2016 H.Merijn Brand.  All rights reserved.
133
134 This library is free software;  you can redistribute and/or modify it under
135 the same terms as Perl itself.
136 See the L<Artistic license|http://dev.perl.org/licenses/artistic.html>.
137
138 =cut