#!/usr/bin/perl require "pages.lib"; use CGI; my $cgi = new CGI; print "Location: http://www.pmsociety.org.uk/\n\n"; exit; $action = $cgi->param('action'); if ($action eq "subscribe"){ &subscribeaddress($cgi->param('address'), $cgi->param('jobtitle')); }elsif ($action eq "unsubscribe"){ &unsubaddress($cgi->param('address')); }else { &showmainpage; } ## subs sub subscribeaddress { @lists = &getlists; $signup = $_[0]; $passfail = &mailtest($_[0]); if ($passfail eq "FAIL"){ print "Content-type: text/html\n\n"; print ''; print 'Your email address is invalid, please check it and try again

'; print 'Email Address (eg person@company.co.uk):
'; print "\n" . '
'; print ''; print '
'; exit; } foreach $list (@lists){ open(LIST, "lists/$list"); @list = ; close(LIST); foreach $address (@list) { chomp($signup); chomp($address); $temp = $address; $temp =~ tr/A-Z/a-z/; $signup =~ tr/A-Z/a-z/; if ("$signup" eq "$temp"){ &alreadysubbed("$address"); exit; } } } $filetowrite = $_[1]||"0"; # deal with passed null file name open(SIGNUP, ">>lists/$filetowrite.txt")||&error('open signup'); print SIGNUP "$signup\n"; close(SIGNUP); open(DONE, "subdone.txt")||&error('open subdone');; @subdone = ; close(DONE); foreach $line (@subdone) { $line =~ s/%%address%%/$signup/g; } print "Content-type: text/html\n\n"; print "@subdone"; } sub unsubaddress { print "Content-type: text/html\n\n"; $address = $_[0]; chomp($address); $address =~ tr/A-Z/a-z/; @lists = &getlists; foreach $list (@lists){ open(DATA, "lists/$list"); @data = ; close(DATA); open(OUT, ">lists/$list"); flock(OUT, 2); foreach $item (@data){ chomp($item); $temp = $item; $temp =~ tr/A-Z/a-z/; if ($temp ne $address){ print OUT "$item\n"; }else{$removed = "true"}; }#2 @data = ""; flock(OUT, 8); close(OUT); }#1 if ($removed eq "true"){ print '' . "$address"; print ' has been unsubscribed from the PM Society Update Mailing list'; }else{ print '' . "$address"; print ' was not found in the PM Society Update Mailing list'; } } sub getlists{ opendir(LISTS, "lists"); @lists = readdir (LISTS); closedir(LISTS); LOOP: foreach $dir (@lists){ chomp($dir); if ($dir eq "."){ next LOOP; } if ($dir eq ".."){ next LOOP; } if ($dir eq "catagories.txt"){ next LOOP; } push(@output, $dir) } return @output; } sub mailtest { $testmail = $_[0]; if (($testmail =~ /\./)&&($testmail =~ /@/)){ return "PASS"; }else{ return "FAIL"; } } # Error Message sub error { print "Content-type: text/html\n\n"; print "uhoh.

$_[0] \n"; exit; }