mhonarc-users

Re: Condensing multiple re, fw and fwds (was Removeing RE and Prefix)

2002-03-09 09:28:42


On 28 Feb 2002 at 21:57, Simeon Nevel wrote:


I currently preprocess my incoming messages with a perl prog consisting 
a long series of regexps to deal with this.

Someone asked that I post my perl pre-processor that deals with multiple re & 
fwd strings.

It also handles some other stuff.

Here 'tis:

#!/usr/bin/perl

$file = shift @ARGV;
$outfile = $file . 'f';

print "Opening $file for input\n";

open (INPUT, $file) || die "Can't open $file\n";
open (OUTPUT, ">$outfile") || die "Can't open $outfile\n";

while (defined($original = <INPUT>)) {

  if ($original =~ /^Subject:/) {
    &fixit;
  }
  
  print OUTPUT $original;
}

close INPUT;
close OUTPUT;

sub fixit {
     
  $fixed = "N";
  $start = $original;

## Eliminate the [etherbun] tag

  if ($original =~ /\[etherbun\]/i) {
    $original =~ s/\[etherbun\]//i;
    $fixed = "Y";
  }                           

## Catch and eliminate *some* []s
  
  if ($original =~ /^subject:\s*(re:\s*)?\[.*\]\s*$/i) {
    $original =~ s/[\[\]]//g;
    $fixed = "Y";
  }

## Catch and eliminate Fwd:|(fwd)

  if ($original =~ /\(?fwd[):]?/i) {
    $original =~ s/\(?fwd[):]?//ig;
    $fixed = "Y";
  }

## Catch and eliminate some "s

  if ($original =~ /^subject:\s*(re:\s*)?\".*\"\s*$/i) {
    $original =~ s/\"//g;
    $fixed = "Y";
  }

## Catch and eliminate some other "s

  if ($original =~ /^subject:\s*(re:\s*)?\"/i) {
    $original =~ s/\"//g;
    $fixed = "Y";
  }


## Catch and fix [n]:

  if ($original =~ /(\[\d+\])/i) {
    $original =~ s/(\[\d+\])//ig;
    $fixed = "Y";
  }

## Catch and fix multiple re:'s

  if ($original =~ /^subject:\s*(re\s*:\s*){2,}/i) {
    $original =~ s/^(subject:)\s*(re\s*:\s*){2,}/$1 Re: /i;
    $fixed = "Y";
  }

## Catch and fix Subject: spacing

  if ($original =~ /^subject:\s{2,}/i) {
    $original =~ s/^subject:\s*/Subject: /i;
    $fixed = "Y";
  }

## Catch and fix re: spacing

  if ($original =~ /^subject: (re:)\s{2,}/i) {
    $original =~ s/^Subject: re:\s*(.*)/Subject: Re: $1/i;
    $fixed = "Y";
  }



  if ($fixed eq "Y") {
    print "Original => $start";
    print "Fixed    => $original\n";
  }

}


--
Simeon B. Nevel
112 Aguirre Way
Cotati, CA 94931

snevel(_at_)sonic(_dot_)net
(707) 792-9866 Home
(707) 738-0138 Cell

<Prev in Thread] Current Thread [Next in Thread>
  • Re: Condensing multiple re, fw and fwds (was Removeing RE and Prefix), Simeon Nevel <=