home *** CD-ROM | disk | FTP | other *** search
/ Complete Internet Archive / Complete Internet Archive.iso / Web Boards / WebForum_tar(2).Z / WebForum_tar(2) / WebForum / src / BMWdigest2WF < prev    next >
Encoding:
Text File  |  1994-12-15  |  1.3 KB  |  62 lines
  1. #!/usr/local/bin/perl
  2.  
  3. # split the BMW digest
  4. require "/home/isscowww/httpd/cgi-bin/WebForum/libWebForum.pl";
  5.  
  6. # rejection patterns
  7. @rejects=("^From:[^\n]*isscowww",
  8.       "\nTo:[^\n]*bmw-digest@balltown",
  9.       "\nSubject:[^\n]*subscribe");
  10.  
  11. $digest=$ARGV[0];
  12.  
  13. if (!-r "$digest") {die "$digest does not exist!\n";}
  14.  
  15. open(FILE,"< $digest")||die "Couldn't open $digest\n";
  16.  
  17. $mn=0;
  18. MSGS:
  19. while (<FILE>){
  20.     $_=&GetNextMessage($_);
  21.     next if $_ eq '';
  22.     foreach $p (@rejects) {
  23.      next MSGS if /$p/;
  24.     }
  25.     &PostMessageToForum($_);
  26.     $mn++;
  27. }
  28.  
  29. exit;
  30.  
  31. sub GetNextMessage {
  32.  local ($l)=@_;
  33.  local ($m);
  34.  while (($l !~ /^From:/) && ($l= <FILE>)){};
  35.  $m=$l;
  36.  while (($l=<FILE>) && ($l !~ /^------------------------------/))
  37.     { $m = $m . $l; }
  38.  return $m;
  39. }
  40.  
  41. sub PostMessageToForum {
  42.  local ($themessage)=@_;
  43.  local ($ip);
  44.  
  45.  $themessage =~ /Subject: *([^\n]*)/;
  46.  local ($subject) = $1;
  47.  $subject =~ s/^ *//;
  48.  $subject =~ s/^[rR][eE]:? *//;
  49.  $subject = &WFEncodeDatum($subject);
  50.  
  51.  $ENV{"REMOTE_USER"}="BMWebGateway";
  52.  $ENV{"REQUEST_METHOD"}="POST";
  53.  $ENV{"REQUEST_NO_AUX_POST"}="YES";
  54.  $body=&WFEncodeDatum($themessage);
  55.  $ip="command=mkmsg&forum=BMW&subject=$subject&mtype=txt&body=$body&\n\n";
  56.  
  57.  $ENV{"CONTENT_LENGTH"}=length($ip);
  58.  open(PM,"|/home/isscowww/httpd/cgi-bin/WebForum/ctrl/wfcommand.pl");
  59.  print PM $ip;
  60.  close(PM);
  61. }
  62.