#!/usr/bin/perl -w use strict; umask(002); my $debugs=time(); my $ROOT=$ENV{HOME}."/Contenido/var/projects/promosuite/loader"; my $wdir="$ROOT/incom/"; my $tmpdir="$ROOT/tmp/"; my $plist="$ROOT/etc/author.priority"; my $maxL=2048*1024; my %P; if (open(L,$plist)){ while (defined(my $str=)){ next if ($str=~/^\#/); my ($addr,$p)=split(/\s+/,$str,2); $p=~s/\D//g if ($p); $p=0 unless ($p); $P{$addr}=$p; } close L; } my $tm=time(); my $salt=$$+$tm; my $rndPart=int(rand(1000)); my $cont=''; read (STDIN,$cont,$maxL); my $from='_unknown'; if ($cont=~/^From:\s+(\S+)\s*$/m){ $from=$1; } if ($cont=~/^AUTH_ID:\s+(\d+)/m){ $from=$1; } my $prior=0; $prior=$P{$from} if (exists($P{$from})); my $sfn="$tm.$$.$rndPart.$prior"; my $fn=""; my $tmpfn="$tmpdir$sfn"; if (open (F,">$tmpfn")){ select F; $|=1; select STDOUT; print F $cont; close F; my $debuge=time(); my $debugd=$debuge-$debugs; $fn="$wdir$tm.$$.${rndPart}_$debugd.$prior"; unless (rename($tmpfn,$fn)){ warn "Can\'t rename temporary $tmpfn to $fn"; } } else{ warn "Can\'t save mail message to $tmpfn: $!\nMessage:\n$cont"; }