Line # Revision Author
1 296 ahitrov #!/usr/bin/perl -w
2 use strict;
3
4 umask(002);
5 my $debugs=time();
6
7 my $ROOT=$ENV{HOME}."/Contenido/var/projects/promosuite/loader";
8 my $wdir="$ROOT/incom/";
9 my $tmpdir="$ROOT/tmp/";
10 my $plist="$ROOT/etc/author.priority";
11
12 my $maxL=2048*1024;
13
14 my %P;
15
16 if (open(L,$plist)){
17 while (defined(my $str=<L>)){
18 next if ($str=~/^\#/);
19 my ($addr,$p)=split(/\s+/,$str,2);
20 $p=~s/\D//g if ($p);
21 $p=0 unless ($p);
22 $P{$addr}=$p;
23 }
24 close L;
25 }
26
27 my $tm=time();
28 my $salt=$$+$tm;
29 my $rndPart=int(rand(1000));
30
31
32 my $cont='';
33 read (STDIN,$cont,$maxL);
34 my $from='_unknown';
35 if ($cont=~/^From:\s+(\S+)\s*$/m){
36 $from=$1;
37 }
38 if ($cont=~/^AUTH_ID:\s+(\d+)/m){
39 $from=$1;
40 }
41
42 my $prior=0;
43 $prior=$P{$from} if (exists($P{$from}));
44
45 my $sfn="$tm.$$.$rndPart.$prior";
46 my $fn="";
47 my $tmpfn="$tmpdir$sfn";
48 if (open (F,">$tmpfn")){
49 select F;
50 $|=1;
51 select STDOUT;
52 print F $cont;
53 close F;
54 my $debuge=time();
55 my $debugd=$debuge-$debugs;
56 $fn="$wdir$tm.$$.${rndPart}_$debugd.$prior";
57 unless (rename($tmpfn,$fn)){
58 warn "Can\'t rename temporary $tmpfn to $fn";
59 }
60
61 }
62 else{
63 warn "Can\'t save mail message to $tmpfn: $!\nMessage:\n$cont";
64 }