6 our $VERSION = "1.02 - 2016-06-07";
9 my $err = shift and select STDERR;
10 say "usage: $0 file ...";
17 "help|?" => sub { usage (0); },
18 "V|version" => sub { say $0 =~ s{.*/}{}r, " [$VERSION]"; exit 0; },
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;
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;
51 $stamp < $f{$p}{stamp} and $p = $fn;
54 # All but the oldest will refer to the oldest as parent
57 my $pid = $f{$p}{msg_id};
59 foreach my $fn (sort keys %f) {
67 unless ($f->{refs} eq $pid) {
69 $f->{hdr} =~ s{^(?=References:)}{References: $pid\nX-}mi;
74 $f->{hdr} =~ s{^(?=Message-Id:)}{References: $pid\n}mi;
77 unless ($f->{irt} eq $pid) {
79 $f->{hdr} =~ s{^(?=In-Reply-To:)}{In-Reply-To: $pid\nX-}mi;
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";
100 cm-reparent.pl - fix mail threading
104 cm-reparent.pl ~/Mail/inbox/23 ~/Mail/inbox/45 ...
108 This script should be called from withing Claws-Mail as an action
112 Menu name: Reparent (fix threading)
113 Command: cm-reparent.pl %F
115 Then select from the list-view 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
124 L<Date::Parse>, L<Claws Mail|http://www.claws-mail.org>
128 H.Merijn Brand <h.m.brand@xs4all.nl>
130 =head1 COPYRIGHT AND LICENSE
132 Copyright (C) 2016-2016 H.Merijn Brand. All rights reserved.
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>.