Mail/CrossAssassin.pm

   1 # CrossAssassin.pm 2004/04/12 blarson
   2
   3 package Mail::CrossAssassin;
   4
   5 use strict;
   6 require Exporter;
   7 our @ISA = qw(Exporter);
   8 our @EXPORT = qw(ca_init ca_keys ca_set ca_score ca_expire);
   9 our $VERSION = 0.1;
  10
  11 use Digest::MD5 qw(md5_base64);
  12 use DB_File;
  13
  14 our %database;
  15 our $init;
  16 our $addrpat = '\b\d{3,8}(?:-(?:close|done|forwarded|maintonly|submitter|quiet))?\@bugs\.debian\.org';
  17
  18 sub ca_init(;$$) {
  19     my $ap = shift;
  20     $addrpat = $ap if(defined $ap);
  21     my $dir = shift;
  22     return if ($init && ! defined($dir));
  23     $dir = "$ENV{'HOME'}/.crosssassassin" unless (defined($dir));
  24     (mkdir $dir or die "Could not create \"$dir\"") unless (-d $dir);
  25     untie %database;
  26     tie %database, 'DB_File', "$dir/Crossdb"
  27         or die "Could not initialize crosassasin database \"$dir/Crossdb\": $!";
  28     $init = 1;
  29 }
  30
  31 sub ca_keys($) {
  32     my $body = shift;
  33     my @keys;
  34     my $m = join('',@$body);
  35     $m =~ s/\n(?:\s*\n)+/\n/gm;
  36     if (length($m) > 4000) {
  37         my $m2 = $m;
  38         $m2 =~ s/\S\S+/\*/gs;
  39         push @keys, '0'.md5_base64($m2);
  40     }
  41 #    $m =~ s/^--.*$/--/m;
  42     $m =~ s/$addrpat/LOCAL\@ADDRESS/iogm;
  43     push @keys, '1'.md5_base64($m);
  44     return join(' ',@keys);
  45 }
  46
  47 sub ca_set($) {
  48     my @keys = split(' ', $_[0]);
  49     my $now = time;
  50     my $score = 0;
  51     my @scores;
  52     foreach my $k (@keys) {
  53         my ($count,$date) = split(' ',$database{$k});
  54         $count++;
  55         $score = $count if ($count > $score);
  56         $database{$k} = "$count $now";
  57         push @scores, $count;
  58     }
  59     return (wantarray ? @scores : $score);
  60 }
  61
  62 sub ca_score($) {
  63     my @keys = split(' ', $_[0]);
  64     my $score = 0;
  65     my @scores;
  66     my $i = 0;
  67     foreach my $k (@keys) {
  68         my ($count,$date) = split(' ',$database{$k});
  69         $score = $count if ($count > $score);
  70         $i++;
  71         push @scores, $count;
  72     }
  73     return (wantarray ? @scores : $score);
  74 }
  75
  76 sub ca_expire($) {
  77     my $when = shift;
  78     my @ret;
  79     my $num = 0;
  80     my $exp = 0;
  81     while (my ($k, $v) = each %database) {
  82         $num++;
  83         my ($count, $date) = split(' ', $v);
  84         if ($date <= $when) {
  85             delete $database{$k};
  86             $exp++;
  87         }
  88     }
  89     return ($num, $exp);
  90 }
  91
  92 END {
  93     return unless($init);
  94     untie %database;
  95     undef($init);
  96 }
  97
  98 1;