Update thread tools
[claws.git] / tools / cm-break.pl
1 #!/usr/bin/perl
2
3 use 5.14.1;
4 use warnings;
5
6 our $VERSION = "1.05 - 2018-10-08";
7 our $cmd = $0 =~ s{.*/}{}r;
8
9 sub usage {
10     my $err = shift and select STDERR;
11     say "usage: $cmd file ...";
12     exit $err;
13     } # usage
14
15 use Date::Parse;
16 use Getopt::Long;
17 GetOptions (
18     "help|?"    => sub { usage (0); },
19     "V|version" => sub { say "$cmd [$VERSION]"; exit 0; },
20     ) or usage (1);
21
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 && $hdr =~ m/\b(?:In-Reply-To|References)\b/i or next;
30
31     my ($mid) = $hdr =~ m{^Message-Id:  (?:[\x20\t]*\n)?[\x20\t]+ (\S.*)}xmi;
32     my ($dte) = $hdr =~ m{^Date:        (?:[\x20\t]*\n)?[\x20\t]+ (\S.*)}xmi;
33     my ($irt) = $hdr =~ m{^In-Reply-To: (?:[\x20\t]*\n)?[\x20\t]+ (\S.*)}xmi;
34     my ($ref) = $hdr =~ m{^References:  (?:[\x20\t]*\n)?[\x20\t]+ (\S.*)}xmi;
35
36     my $stamp = str2time ($dte) or die $dte;
37     my $date = $stamp ? do {
38         my @d = localtime $stamp;
39         sprintf "%4d-%02d-%02d %02d:%02d:%02d", $d[5] + 1900, ++$d[4], @d[3,2,1,0];
40         } : "-";
41     #printf "%12s %-20s %s\n", $stamp // "-", $date, $rcv;
42
43     $f{$fn} = {
44         msg_id  => $mid,
45         refs    => $ref,
46         irt     => $irt,
47         date    => $dte,
48         stamp   => $stamp,
49         sdate   => $date,
50
51         hdr     => $hdr,
52         body    => $body,
53         };
54     }
55
56 foreach my $fn (sort keys %f) {
57
58     my $c = 0;
59
60     my $f = $f{$fn};
61     if ($f->{refs}) {
62         $c++;
63         $f->{hdr} =~ s{\nReferences:.*(?:\n\s+.*)*+}{}ig;
64         }
65     if ($f->{irt}) {
66         $c++;
67         $f->{hdr} =~ s{\nIn-Reply-To:.*(?:\n\s+.*)*+}{}ig;
68         }
69
70     $c or next; # No changes required
71
72     say "$f->{msg_id} => -";
73
74     my @t = stat $fn;
75     open my $fh, ">", $fn or die "$fn: $!\n";
76     print   $fh $f->{hdr}, $f->{body};
77     close   $fh or die "$fn: $!\n";
78     utime $t[8], $t[9], $fn;
79     }
80
81 __END__
82
83 =head1 NAME
84
85 cm-break.pl - remove mail from thread
86
87 =head1 SYNOPSIS
88
89  cm-break.pl ~/Mail/inbox/23 ~/Mail/inbox/45 ...
90
91 =head1 DESCRIPTION
92
93 This script should be called from within Claws-Mail as an action
94
95 Define an action as
96
97   Menu name:  Unthread (break threading)
98   Command:    cm-break.pl %F
99
100 Then select from the message list all files that should be un-threaded
101
102 Then invoke the action
103
104 All of those mails will be modified (if needed): their C<In-Reply-To:>
105 and C<References:> header tags are removed from the header.
106
107 =head1 SEE ALSO
108
109 L<Date::Parse>, L<Claws Mail|http://www.claws-mail.org>
110 cm-reparent.pl
111
112 =head1 AUTHOR
113
114 H.Merijn Brand <h.m.brand@xs4all.nl>
115
116 =head1 COPYRIGHT AND LICENSE
117
118  Copyright (C) 2018-2018 H.Merijn Brand.  All rights reserved.
119
120 This library is free software;  you can redistribute and/or modify it under
121 the same terms as Perl itself.
122 See the L<Artistic license|http://dev.perl.org/licenses/artistic.html>.
123
124 =cut