Repository List / Contenido / utf8 / samples / promosuite / services / loader / bin / store_mail @ HEAD

#!/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=<L>)){
      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";
}