debian/extra/lib/mailspell

   1 #!/usr/bin/perl
   2 #
   3 # Wrapper to call ispell on mail messages, ignoring quoted portions
   4 # and signatures.
   5 # By Brendan O'Dea <bod@debian.org>, public domain.
   6 # Usage: set ispell = /usr/lib/mutt/mailspell
   7 #
   8
   9 use IO::File;
  10 use POSIX 'tmpnam';
  11 use File::Copy 'move';
  12
  13 $0 =~ s#.*/##;
  14
  15 my $ISPELL = 'ispell';
  16 my $DIFF   = 'diff';
  17 my $ED     = 'ed';
  18
  19 # make sure that we don't inherit SIGCHLD
  20 $SIG{CHLD} = 'DEFAULT';
  21
  22 # ignore -x ispell option
  23 shift if $ARGV[0] eq '-x';
  24 die "Usage: $0 [-x] FILE\n" unless @ARGV == 1;
  25
  26 my $msg = $ARGV[0];
  27
  28 # create temporary files
  29 my (%orig, %ed);
  30
  31 END {
  32     unlink $ed{path}   if $ed{path};
  33     unlink $orig{path} if $orig{path};
  34 }
  35
  36 foreach (\%orig, \%ed) {
  37     $_->{path} = tmpnam;
  38     $_->{fd} = IO::File->new($_->{path}, O_RDWR|O_CREAT|O_EXCL, 0600)
  39                 or die "$0: can't create $_->{path} ($!)";
  40 }
  41
  42 while (<>) {
  43     # stop at sigdashes
  44     last if /^-- \n/;
  45
  46     # drop quoted text and attribution
  47     $orig{fd}->print($_) unless /^>/ or /^On \w{3}, \w{3} \d{2}, \d{4} at \d/;
  48 }
  49
  50 $orig{fd}->close;
  51
  52 my $pid = fork;
  53 die "$0: can't fork ($!)\n" unless defined $pid;
  54 unless ($pid) {
  55     open STDOUT, '>&=' . $ed{fd}->fileno
  56                 or die "$0: can't dup stdout to ed script ($!)\n";
  57     $ed{fd}->close;
  58     exec $DIFF, '-e', $orig{path}, $msg;
  59     die "$0: can't exec $DIFF ($!)\n";
  60 }
  61
  62 die "$0: can't reap child ($!)\n" unless wait == $pid;
  63 system $ISPELL, '-x', $orig{path}
  64     and die "$0: problem with $ISPELL ($?)\n";
  65
  66 $ed{fd}->seek(0, SEEK_END);
  67 $ed{fd}->print("w\nq\n");
  68 $ed{fd}->seek(0, SEEK_SET);
  69
  70 open STDIN, '<&=' . $ed{fd}->fileno
  71     or die "$0: can't dup stdin from ed script ($!)\n";
  72
  73 system $ED, '-s', $orig{path} and die "$0: problem with $ED ($?)\n";
  74 move $orig{path}, $msg        or  die "$0: can't replace $msg ($!)\n";
  75 delete $orig{path};
  76
  77 1;