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