1: #!/usr/bin/perl
   2: 
   3: #This code is designed to be used in mail handling on a catch all account
   4: #It basically uses a list of Soundex checksums to match the actual recipient
   5: #header.txt is the header part
   6: #footer.txt is teh footer part
   7: #soundex.txt is the list of soundex checksums
   8: 
   9: #This was a project for OS Class
  10: #This is dirty enough :)
  11: #Note: This app written for local names.
  12: #For example: Jean-Pierre Van Den Bossche
  13: #I translasted variable names from dutch, so if I made a typo... :)
  14: 
  15: use Mail::Header;
  16: use Mail::Mailer;
  17: use Text::Soundex;
  18: use strict;
  19: #Yihaaa
  20: 
  21: my $domain = 'foo.bar'; #Domain
  22: my $type = 'sendmail';
  23: #Mail::Mailer types:   sendmail, mail, smtp, qmail, test
  24: my $mailprog = Mail::Mailer->new($type);
  25: 
  26: my $head = new Mail::Header \*STDIN;
  27: my $subject = $head->get("subject");
  28: my $from = $head->get("from");
  29: my $to = $head->get("delivered-to") || $head->get("to");
  30: chomp $subject,$from,$to;
  31: 
  32: my %headers = (
  33:   'To' => $from,
  34:   'From' => "Dolly\@$domain",
  35:   #the original script I based this on was named Debby
  36:   'Subject' => 'Reply to: '.$subject
  37: );
  38: 
  39: $mailprog->open(\%headers);
  40: my @email = qw();
  41: my ($name) = $to =~ /^([\w\.]*)\@$domain$/;
  42: my ($firstname,$lastname) = split(/\./,$name,2);
  43: my ($sfirstname,$slastname) = soundex($firstname,$lastname);
  44: open(SOUNDEX,"<soundex.txt") || die "Oops: $!";
  45: while(<SOUNDEX>)
  46: { chomp;
  47:   my ($checksum,$email) = split(/\=\>/,$_,2);
  48:   my (@list) = split(/ /,$email);
  49:   my ($sfname,$slname) = split(/\./,$checksum,2);
  50:   if ($sfname eq $sfirstname && $slname eq $slastname)
  51:   { push(@email,@list); }
  52: 
  53: }
  54: close(SOUNDEX);
  55: 
  56: open(HEADER,"<header.txt") || die "Oops: $!";
  57: open(FOOTER,"<footer.txt") || die "Oops: $!";
  58: my ($header,$footer);
  59: { local $/; $header = <HEADER>; $footer = <FOOTER>; }
  60: #Magic
  61: #To my professor anyway
  62: 
  63: my (@firstnames) = split(/\-/,$firstname);
  64: for (@firstnames) { $_ = ucfirst $_ }
  65: $firstname = join(" ",@firstnames);
  66: my (@lastnames) = split(/\./,$lastname);
  67: for (@lastnames) { $_ = ucfirst $_ }
  68: $lastname = join(" ",@lastnames);
  69: 
  70: for my $wanted (@email)
  71: { print $mailprog $header;
  72:   print $mailprog "For: $firstname $lastname I found the following e-mail addresses:\n\n";
  73:   print $mailprog "$wanted\n";
  74:   print $mailprog $footer;
  75: }
  76: 
  77: $mailprog->close;
  78: 
  79: #The program to generate checksums
  80: #!/usr/bin/perl
  81: 
  82: #use Text::Soundex;
  83: #use strict;
  84: #Yihaaa
  85: 
  86: #my %Soundex;
  87: 
  88: #open(NAMES,"<names.txt") || die "Oops: $!";
  89: #names.txt contains a list of names in the firstname:lastname format
  90: #while(<NAMES>)
  91: #{ chomp;
  92: #  my ($firstname,$lastname) = split(/\:/,$_,2);
  93: #  my ($sfirstname,$slastname) = ($firstname,$lastname);
  94: 
  95: #  $sfirstname =~ s/\s+//g; $slastname =~ s/\s+//g;
  96: #  $sfirstname =~ s/\-+//g; $slastname =~ s/\-+//g;
  97: #  $sfirstname =~ s/\.+//g; $slastname =~ s/\.+//g; 
  98: #  my $key = join(".",soundex($sfirstname), #soundex($slastname));
  99: #  if (exists $Soundex{$key})
 100: #  { $Soundex{$key} .=" "; }
 101: #  $Soundex{$key} = join(".",$firstname, $lastname);
 102: #}
 103: #close(NAMES);
 104: #open(SOUNDEX,">soundex.txt") || die "Oops: $!";
 105: #foreach ( sort keys %Soundex ) 
 106: #{ print SOUNDEX $_,"=>",$Soundex{$_},"\n" if $_ ne "." }
 107: #close(SOUNDEX);