Subj : readpkt.pl part 1 of 2
To   : All
From : tony summerfelt
Date : Wed Aug 28 2002 03:55 pm

# change dirs for your setup
# this program writes headers in a specific order for writepkt.pl

$pktdir = "r:/pkt";

$wrap = 79;

$seenby="";
opendir(dir,$pktdir) || die "can't open directory $pktdir -- $!";
@pkts = grep(/.*\.pkt/i,readdir(dir));
closedir(dir);

foreach $pkt (sort @pkts) {
   $pktname=lc($pkt);
   $pkt = $pktdir."/".$pkt;
   open(pkt,$pkt) || die "can't open $pkt -- $!";
   binmode(pkt);
   &newsmsgs();
}
unlink("path.~~~");

sub newsmsgs
{
    local($to,$from,$subj,$msgid);
    local($buf,$c,$s,$osep);

    read(pkt,$buf,58);

    while (!eof(pkt))
    {
          last if (read(pkt,$buf,14) != 14);
          ($pktver,$orgnode,$destnode,$orgnet
          ,$destnet,$attrib,$cost) =
           unpack("SSSSSSS",$buf);
          $osep = $/;
          $/ = "\0";
          $datetime = <pkt>;
          if (length($datetime) > 20)
          {
             $to = substr($datetime,20);
          } else {
             $to = <pkt>;
          }
          $from = <pkt>;
          $subj = <pkt>;

          $to   =~ tr/\200-\377/\0-\177/;
          $to   =~ tr/\0-\037/\040-\100/;
          $from =~ tr/\200-\377/\0-\177/;
          $from =~ tr/\0-\037/\040-\100/;
          $subj =~ tr/\0-\037/\040-\100/;
          $s = <pkt>;
          $/ = $osep;
          $s =~ s/\x8d/\r/g;
          @lines = split(/\r/,$s);
          undef $s;
          next if ($#lines < 0);
          $area = shift(@lines);
          $_=$area;
          $area="netmail" if /\//i;
          $area =~ s/.*://;

          for ($i = $k = 0; $i <= $#lines; $i++)
          {
               if ($lines[$i] =~ /^\001/)
               {
                  $kludges[$k++] = splice(@lines,$i,1);
                  redo;
               }
          }
          for (;;)
          {
              $_ = pop(@lines);
              last if ($_ eq "");
          if (/ \* origin: /i)
          {
             $origin = substr($_,11);
             last;
          }
          if (/---/)
          {
             $mailer = $_;
          }
          if (/seen-by/i)
          {
            $seenby="$_\n".$seenby if ! /\n$/i;
          }
    }
    if ($#lines < 0)
    {
       @lines = ("[empty message]");
    }
    @lines = &wraparray(@lines);
    $areas{$area}++;
    print "$pktdir/$area.$areas{$area}   \r";

    open(msg,">$pktdir/$area.$areas{$area}") ||
         die "can't open $pktdir/$area.$areas{$area} -- $!";
    binmode(msg);
    &showheader;
    foreach $s (@lines)
    {
            $s =~ tr/\0-\037/\040-\100/;
            $s =~ s/\s+$//;
            $s=~tr/^\*/ /;
            print msg "$s\n";
    }
    for ($k=0;$k<$#lines;$k++)
    {
        $_=$kludges[$k];
        $path=$_ if /^\001path/i;
        open tp, ">r:/pkt/path.~~~" || die "can't open path.~~~ --$!";
        print tp $path;close tp;
        print msg "$_\n" if ((/^\001via/i) && ($area eq "netmail"));
    }
    close(msg);
    $seenby="";
    undef @lines;
    }
}

sub wraparray {
   local(@temp);
   while ($#_ > -1) {
      $_ = shift;
      while (length($_) > $wrap) {
         if ($_ =~ /.{1,$wrap}\s/) {
            push(@temp,$&);
            $_ = $';
         }
         else {
            last;
         }
      }
      push(@temp,$_);
   }
   @temp;
}

--- GoldED/SuSE 3.0.1-os1+
 * Origin: ...the vented spleen - kingston, on (613) 544-9332 (1:249/139)

.