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