Improve script documentation
[claws.git] / tools / cm-reparent.pl
blob520e1350eadf6818247556c65c0e951aca937797
1 #!/usr/bin/perl
3 use 5.14.1;
4 use warnings;
6 our $VERSION = "1.02 - 2016-06-07";
8 sub usage {
9 my $err = shift and select STDERR;
10 say "usage: $0 file ...";
11 exit $err;
12 } # usage
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);
21 my $p;
22 my %f;
23 foreach my $fn (@ARGV) {
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;
29 $hdr or next;
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;
36 my $stamp = str2time ($dte) or next;
38 $f{$fn} = {
39 msg_id => $mid,
40 refs => $ref,
41 irt => $irt,
42 date => $dte,
43 stamp => $stamp,
45 hdr => $hdr,
46 body => $body,
49 $p //= $fn;
51 $stamp < $f{$p}{stamp} and $p = $fn;
54 # All but the oldest will refer to the oldest as parent
56 $p or exit 0;
57 my $pid = $f{$p}{msg_id};
59 foreach my $fn (sort keys %f) {
61 $fn eq $p and next;
63 my $c = 0;
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;
72 else {
73 $c++;
74 $f->{hdr} =~ s{^(?=Message-Id:)}{References: $pid\n}mi;
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;
82 else {
83 $c++;
84 $f->{hdr} =~ s{^(?=Message-Id:)}{In-Reply-To: $pid\n}mi;
87 $c or next; # No changes required
89 say "$f->{msg_id} => $pid";
91 open my $fh, ">", $fn or die "$fn: $!\n";
92 print $fh $f->{hdr}, $f->{body};
93 close $fh or die "$fn: $!\n";
96 __END__
98 =head1 NAME
100 cm-reparent.pl - fix mail threading
102 =head1 SYNOPSIS
104 cm-reparent.pl ~/Mail/inbox/23 ~/Mail/inbox/45 ...
106 =head1 DESCRIPTION
108 This script should be called from within Claws-Mail as an action
110 Define an action as
112 Menu name: Reparent (fix threading)
113 Command: cm-reparent.pl %F
115 Then select from the message list all files that should be re-parented
117 Then invoke the action
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
122 Given 4 files A, B, C, and D like
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
130 The new tree will be like
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
137 and not
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
144 =head1 SEE ALSO
146 L<Date::Parse>, L<Claws Mail|http://www.claws-mail.org>
148 =head1 AUTHOR
150 H.Merijn Brand <h.m.brand@xs4all.nl>
152 =head1 COPYRIGHT AND LICENSE
154 Copyright (C) 2016-2016 H.Merijn Brand. All rights reserved.
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>.
160 =cut