# filterng - Called by NewsFilter:filter

# $Id: filterng 2.4 2001/10/13 09:19:21 vlefevre Exp $

# Fixes Outlook Express and Mozilla sig separator in news articles.
# Rejects news articles with newsgroups name (in Newsgroups or Followup-To
#   header) consisting of at least 80 characters (long newsgroups names
#   seem to crash Pluto).
# Rejects news articles from mailgate.org.
# Rejects Outlook Express and Mozilla articles with long quote at the end
#   (you must create an empty text file "froms" in !NFilter).
# Removes Yahoo's advertising in yahoogroups mailing-lists.

use RISCOS::Filespec;
use strict;

my $fixsigsep = 1;  # Fixes OE and Mozilla sig separator in news articles.
my $longngname = 1;  # News articles with long newsgroups name rejected.
my $nomailgate = 1;  # News articles from mailgate.org rejected.
my $rejlquote = 1;  # Rejects OE/Mozilla articles with long quote at the end.
my $filteradv = 1;  # Removes Yahoo's advertising in yahoogroups lists.
my $scrapdir = $ENV{'NewsFilter$ScrapDir'} || $ENV{'Wimp$ScrapDir'};

&filter(\&newsfilter, $ENV{'NewsHound$NewsDir'}.'.folder');
&filter(\&mailfilter, $ENV{'POPstar$MailDir'}.'.spool.mail.text');

sub filter
  {
    my ($sub,$dir) = @_;
    if (opendir DIR, $dir)
      {
        my @d = readdir DIR;
        closedir DIR;
        foreach (@d)
          { &$sub($dir) }
      }
  }

sub newsfilter
  {
    /^...News$/ or return;
    my $file = "$_[0].$_";
    my $tmp = &gettmp($_[0],$file) or return;
    my $froms = "NewsFilter:froms";
    while (<FILE>)
      {
        my ($len) = /^#! rnews 0*(\d+)$/ or return;
        my ($article,$header,$hflag,$t,$u);
        while (length $article != $len)
          {
            defined($_ = <FILE>) or return;
            $article .= $_;
            $_ eq "\n" and $hflag = 1, $u = 0, next;
            $header .= $_ unless $hflag;
            $t = $u;
            substr($_,0,1) eq '>' and $t++, $u++;
          }
        $longngname && $header =~ /^(Newsgroups|Followup-To):.*?[\t ,][^\s,]{80}/imo
          and next;
        $nomailgate && $header =~ /^Organization: Mailgate\.ORG Server/imo
          and next;
        if ($header =~
          /^X-(Newsreader: Microsoft Outlook Express|Mailer: Mozilla)/imo)
          {
            if ($rejlquote && $t >= 12 && -e $froms &&
                $header =~ /^From:\s+(.+)/im)
              { open FROM, ">>$froms" or next;
                print FROM "$1\n";
                close FROM;
                next; }
            if ($fixsigsep)
              { $article =~ s/^--$/-- /mg;
                $len = length $article; }
          }
        printf TMP "#! rnews %07d\n%s", $len, $article;
      }
    close FILE;
    close TMP or return;
    &mv($tmp, $file);
  }

sub mailfilter
  {
    my $file = "$_[0].$_";
    my $tmp = &gettmp($_[0],$file) or return;
    while (<FILE>)
      {
        my ($len) = /^#! rmail 0*(\d+)$/ or return;
        my ($lh,$body,$header);
        while ($lh + length($body) != $len)
          {
            defined($_ = <FILE>) or return;
            if ($lh)
              { $body .= $_; }
            else
              { $header .= $_;
                $_ eq "\n" and $lh = length $header; }
          }
        if ($filteradv &&
            $header =~ /^Mailing-List:.*yahoogroups/imo &&
            $header =~ m!^Content-Type:.*text/plain!imo &&
            $body =~ s/^-+ Yahoo! Groups Sponsor -+~-->.*^-+~->\n+//ms)
          { $header =~ s/^(Content-Length|Lines):.*\n//gimo;
            $len = length($header) + length($body); }
        printf TMP "#! rmail %07d\n%s%s", $len, $header, $body;
      }
    close FILE;
    close TMP or return;
    &mv($tmp, $file);
  }

sub gettmp
  { my ($dir,$file) = @_;
    my $tmp = "$scrapdir.nfilter";
    my $i = 0;
    while (-e $tmp.$i) { $i++ }
    $tmp .= $i;
    open FILE, $file or return;
    open TMP, ">$tmp" or close FILE, return;
    return $tmp; }

sub mv
  { my ($src,$dst) = @_;
    rename $src, $dst and return;
    open SRC, "<$src" or return;
    open DST, ">$dst" or close SRC, return;
    while (<SRC>)
      { print DST or &mverr($dst, "print failed", 1), return; }
    close DST or &mverr($dst, "can't close $dst"), return;
    close SRC; unlink $src; }

sub mverr
  { my ($file,$err,$flag) = @_;
    $file =~ s/.*\.//;
    warn "Error when copying batch file $file:\n$err\n";
    $flag and close DST;
    close SRC; }
