#!/usr/bin/perl
#
# MAILMATIC 10-Second Survey & Mailing List Manager
#
# Filename: mailmat.cgi
# Copyright: 1997, 1998 by Joe DePasquale
# Last revised: April 7, 1998
# E-Mail: crypt@getcruising.com
# Website: http://www.GetCruising.com
#
########################################################################
# #
# This script and accompanying files may be distributed freely #
# and modified, provided this header with my name, E-Mail address and #
# this notice remain intact. Ownership rights remain with me. You may #
# not sell this script without my approval. #
# #
# This script comes with no guarantee or warranty except for my good #
# intentions. By using this code you agree to indemnify me from any #
# liability that might arise from it's use. #
# #
# There is no technical support for this script, neither am I a #
# professional programmer. Refer to 'HELPME.TXT' for further guidance. #
# #
########################################################################
#
# 2. CONFIGURE SCRIPT -
# Change these sample paths to the actual paths on your server:
# Your Unix system sendmail and date commands
$mailCmd = '/usr/sbin/sendmail';
$dateCmd = '/bin/date';
# Your E-Mail address - note mandatory backslash before \@
$myMail = "you\@your-server.com";
# E-mail address to use as Group Mailing List recipient
$toMail = "Our Mailing List <you\@your-server.com>";
# Unix path to the mailmat directory
$mailmatDir = "/usr/home/you/htdocs/mailmat";
# URL for mailmat.cgi
$scriptUrl = "http://your-server.com/cgi-bin/mailmat.cgi";
# Go to this URL when exiting manager
$exitUrl = "http://your-server.com/manager.html";
# OPTIONAL - You can edit these variables if desired:
$headTitle = "Mailmatic Ten-Second Survey";
$bodyTag = qq|<body bgcolor="#FFFFFF" text="#000099" link="#0000FF" alink="#FFFF00" vlink="#990000">|;
$bodyTitle = qq|<b><font size=4><font color="#0000FF">THE </font><font color="#FF0000">TEN </font><font color="#006600">SECOND </font><font color="#FF00FF">SURVEY</font></font></b>|;
# If you want a signature file attached to mail messages,
# uncomment the next line and enter the correct Unix path ..
# $MYSIG = '/usr/home/you/htdocs/mailmat/mysig.txt';
# .. otherwise uncomment the next line and replace with your info ..
# $myName = 'Donald Quack';
# $homeUrl = 'http://your-server.com';
# Customize your survey by changing the following 'key','value' pairs.
# You can have any number of questions or subjects. Following the format,
# increase the 'Q'-number for each added question and/or change the text of
# the questions. The Subject 'key' selected by a visitor will become part
# of their record in your mailing list.
%Question = (
'Q1','Enjoyed browsing our site',
'Q2','Found what you were looking for',
'Q3','Graphics',
'Q4','Navigation & Layout',
'Q5','Overall impression of this website',
);
%Subject = (
'A','This Subject',
'B','That Subject',
'C','The Other One',
);
# You can select one subject to be checked by default on the survey
# form by entering a subject key and uncommenting the next line.
# $checked = 'C';
# If you use HITMATIC, you can have a list of pages visited
# attached to the respondent's E-Mail to the manager. If you
# want this option, set $hitFlag to 'Y' and add the path info ..
# $HITLOG = '/usr/home/you/htdocs/hit/hit1.log';
$hitFlag = 'N';
# If you don't want to backup the mail.dat files, set $bakFlag to 'N',
# otherwise you can configure the values in the 'if' loop ..
$bakFlag = 'Y';
if ($bakFlag eq 'Y')
{ $bakTime = 2; # days btwn backups
$bakMax = 7; # days to keep backups
# Unix path to backup directory
$bakDir = "/usr/home/you/htdocs/bak";
# END OF INSTALLATION - DO NOT EDIT BELOW THIS LINE!
######################################################################
chop ($jDate = `$dateCmd +"%j"`);
$MAILBAK = "$bakDir/mail$jDate.bak";
}
chop ($dateStamp = `$dateCmd +"%Y%m%d"`);
chop ($timeStamp = `$dateCmd +"%a %D %H%M%Z"`);
$MAILDAT = "$mailmatDir/mail.dat";
$MAILFLK = "$mailmatDir/mail.flk";
$MAILTEMP = "$mailmatDir/mailtemp.html";
$MAILTTL = "$mailmatDir/mail.ttl";
$MAILHOLD = "$mailmatDir/mail.tmp";
$noName = "Left_No_Name";
$listFlag = "N";
###########################################################################
# Read and parse input from form or querystring
if (-e "./referer.pl")
{ require "./referer.pl";
&referer;
}
print "Content-Type: text/html\n\n";
if ($ENV{'QUERY_STRING'})
{ $buffer = $ENV{'QUERY_STRING'};
} elsif ($ENV{'CONTENT_LENGTH'})
{ read (STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
}
@cgiPairs = split(/&/,$buffer);
foreach $cgiPair (@cgiPairs)
{
($name,$value) = split(/=/,$cgiPair);
$value =~ s/\+/ /g;
$value =~ s/%(..)/pack("c",hex($1))/ge;
$Form{$name} .= "\0" if (defined($Form{$name}));
$Form{$name} .= "$value";
}
undef $name; undef $value;
if ($Form{'checked'}) {$checked = $Form{'checked'};}
##################################################################
# Case: Manager functions
if (defined $Form{'manager'})
{ require "./mailman.pl";
$MAILLOG = "$mailmatDir/mail.log";
$MAILPWD = "$mailmatDir/mailmat.pwd";
$MAILTXT = "$mailmatDir/mail.txt";
&mailman;
exit;
} # end manager
##################################################################
# Case: User has submitted a REPLY
elsif ($Form{'reply'})
{
&header;
if ($Form{'email'})
{ $email = $Form{'email'};
$email =~ s/(\s|\|)//g;
if ($email !~ /^\S+\@\S+(\.\S+)+/)
{ &endIt ("Invalid E-Mail address.. Example: $myMail");
}
}
if ($Form{'name'})
{ $name = $Form{'name'};
$name =~ s/(\f|\n|\r|\t|\|)//g;
}
if ($Form{'company'})
{ $company = $Form{'company'};
$company =~ s/(\f|\n|\r|\t|\|)//g;
}
if ($Form{'subjectkey'}) # add user to mailing list
{
$subjectKeys = '';
@subjectKeys = split (/\0/,$Form{'subjectkey'});
foreach $subjectKey (@subjectKeys)
{ if ($Subject{$subjectKey})
{ $subjectKeys .= $subjectKey;
} else
{ &endIt ("Invalid subject selection.");
}
}
if ($email && $name =~ /\w{2,}/)
{ $addMail = join ("\|",$email,$name,$company,$subjectKeys,$dateStamp,"\n");
$listFlag = 'Y';
} else
{ &endIt ("You selected a mailing list. <b>Your Name</b> and <b>E-Mail Address</b> are needed.");
}
# get lock if manager not using files
# else append new record to MAILHOLD file
open (LOCK,">$MAILFLK") || &endIt;
if (flock (LOCK,2|4))
{ open (DAT,"+<$MAILDAT") || &endit;
if (-s $MAILHOLD)
{ open (HOLD,"+<$MAILHOLD") || &endIt;
flock (HOLD,2); seek (HOLD,0,0);
@mailHold = <HOLD>;
seek (HOLD,0,0);
truncate (HOLD,0); close (HOLD);
}
} else
{ open (DAT,"+<$MAILHOLD") || &endIt;
}
flock (DAT,2); seek (DAT,0,0);
@oldFile = <DAT>;
push (@oldFile,$addMail,@mailHold);
@newFile = sort {uc($a) cmp uc($b)} @oldFile;
seek (DAT,0,0);
print (DAT @newFile);
truncate (DAT,tell(DAT)); close (DAT);
close (LOCK);
if ($bakFlag eq 'Y' && ($jDate % $bakTime ==0) && !-e $MAILBAK)
{ &backUp (@newFile);
}
}
##################################################################
# Send E-Mail to myMail
if (!$email) {$email = $myMail;}
if (!$name) {$name = $noName;}
if ($Form{'comment'})
{ $comment = $Form{'comment'};
if (length $comment >5120) {$comment = substr ($comment,0,5120);}
} else
{ $comment = "NONE";
}
open (MAIL,"|$mailCmd -t -oi") || &endIt ("Couldn't start SENDMAIL program $!");
print MAIL "From: $email\nTo: $myMail\n";
print MAIL "Subject: $headTitle\n\n";
print MAIL "This visitor responded on $timeStamp.\n\n";
print MAIL "Name: $name\nCompany: $company\nE-Mail: $email\n\n";
foreach $key (sort (keys %Question)) { print MAIL "$Question{$key}: $Form{$key}\n"; }
print MAIL "\nComment: $comment\n\n";
if ($listFlag eq 'Y')
{ print MAIL "Visitor has registered for:\n";
foreach $subjectKey (@subjectKeys) { print MAIL " $Subject{$subjectKey} ($subjectKey)\n"; }
print MAIL "\n";
}
print MAIL "Domain Addr: $ENV{'REMOTE_HOST'}\n";
print MAIL " IP Address: $ENV{'REMOTE_ADDR'}\n";
print MAIL "Browser: $ENV{'HTTP_USER_AGENT'}\n";
print MAIL "Cookies: $ENV{'HTTP_COOKIE'}\n";
if ($hitFlag eq 'Y' && (open (HITLOG,"<$HITLOG")))
{ flock (HITLOG,1); seek (HITLOG,0,0);
@hitlog = <HITLOG>;
close (HITLOG);
@visits = grep (/($ENV{'REMOTE_ADDR'}|$ENV{'REMOTE_HOST'})/,@hitlog);
print MAIL "\nHitLog for this visitor:\n";
foreach $visit (@visits) { print MAIL $visit; }
}
close (MAIL);
##################################################################
# Send E-Mail to visitor
open (MAIL,"|$mailCmd -t -oi") || &endIt ("Couldn't start SENDMAIL program $!");
print MAIL "From: $myMail\nTo: $email\n";
print MAIL "Subject: $headTitle\n\nDear $name\n";
if ($company) { print MAIL "$company\n"; }
print MAIL "\nI appreciate your taking the time to give your opinion!\n";
print MAIL "If you requested a reply, I will try to respond as time allows.\n";
print MAIL "If you need to contact me, you can E-Mail me at:\n $myMail.\n\n";
if ($listFlag eq "Y")
{ print MAIL "Thank you for registering for our website news:\n";
foreach $subjectKey (@subjectKeys) { print MAIL " $Subject{$subjectKey}\n"; }
print MAIL "If at any time you wish to discontinue receiving \n";
print MAIL "our news simply send a note by E-Mail.\n\n";
}
print MAIL "Please come back and visit again soon!\n\n";
if (open (SIG,"<$MYSIG"))
{ @mySig = <SIG>;
print MAIL "@mySig";
close (SIG);
} else
{ print MAIL "$myName <$myMail>\n$homeUrl\n";
}
close (MAIL);
##################################################################
# Add survey scores to total
open (TTL,"+<$MAILTTL") || &endIt;
flock (TTL,2); seek (TTL,0,0);
@ttlFile = <TTL>;
foreach $ttlLine (@ttlFile)
{ ($key,$score,$reply,$eol) = split (/\|/,$ttlLine);
if ($Form{$key} && $Form{$key} >0)
{ $score = $score + $Form{$key};
$reply = $reply +1;
$ttlLine = join ("\|",$key,$score,$reply,"\n");
$scoreFlag = "Y";
}
}
if ($scoreFlag)
{ seek (TTL,0,0);
print (TTL @ttlFile);
truncate (TTL,tell(TTL));
}
close (TTL);
# Send message to the browser
print qq|<font size=5>Thank You!</font>\n<p>\n|;
print qq|Your responses have been sent to $myMail.\n<p>\n|;
if ($listFlag eq "Y")
{ print qq|You will receive updates on these subjects:<br>|;
foreach $subjectKey (@subjectKeys) { print " $Subject{$subjectKey},"; }
}
print qq|\n<hr>\n<a href="$scriptUrl">Back to $headTitle</a>\n|;
&footer;
} # end Case REPLY
##################################################################
# Case: View Survey Results
elsif ($Form{'results'})
{
&header;
open (TTL,"<$MAILTTL") || &endIt;
flock (TTL,1); seek (TTL,0,0);
@ttlFile = <TTL>;
close (TTL);
print "<p><table border=2><tr>\n";
print "<th align=left>Question</th><th>Average<br>Score</th><th>Total<br>Replies</th>\n";
foreach $ttlLine (@ttlFile)
{ ($key,$score,$reply,$eol) = split (/\|/,$ttlLine);
if ($reply >0)
{ $average = int ($score * 10000 / $reply) *.0001;
} else
{ $average = 0;
}
$scoreTtl = $scoreTtl + $score;
$replyTtl = $replyTtl + $reply;
print "</tr><tr align=right>\n";
print "<td align=left>$Question{$key}</td><td>$average</td><td>$reply</td>\n";
}
$average = int ($scoreTtl * 10000 / $replyTtl) *.0001;
print "</tr><tr align=right>\n";
print "<th>$timeStamp</th><th>$average</th><th>$replyTtl</th>\n";
print "</tr></table><p>\n";
print qq|<a href="$scriptUrl">Back to $headTitle</a>\n|;
&footer;
}
##################################################################
# Default Case: Output the Survey Form
else
{
open (TEMP,"<$MAILTEMP") || &endIt;
@tempFile = <TEMP>;
close (TEMP);
$x =0;
while ($x <= $#tempFile)
{ if ($tempFile[$x] =~ /<!-- MAILMATIC SURVEY - STARTS HERE -->/)
{
foreach $nbr (sort (keys %Question))
{ print qq|<font color="#990000"><b>$Question{$nbr}</b></font><br>\n<nobr>|;
for $value (1..10)
{ print qq|<input type=radio name="$nbr" value="$value">$value\||;
}
print qq|<input type=radio name="$nbr" value="0" checked>No opinion</nobr>\n<br>\n|;
}
print qq|<br><font size=5>2</font>. <font color="#0000FF"><b>Check subjects to receive our occasional E-Mail when we have news.</b></font><br>\n|;
foreach $key (sort (keys %Subject))
{ print qq|<input type=checkbox name=subjectkey value="$key"|;
if ($key eq $checked) { print " checked"; }
print qq|\>$Subject{$key}<br>\n|;
}
print qq|<input type=hidden name=checked value="$checked"></nobr>\n|;
} else
{ print "$tempFile[$x]";
}
$x++;
}
} # end default
##################################################################
sub backUp # Backup data and delete old backups
{
@bakData = @_;
open (BAK,">$MAILBAK") || &endIt;
print (BAK @bakData);
close (BAK);
chmod (0666,$MAILBAK);
opendir (BAKDIR,$bakDir);
@bakFiles = grep (/mail\d{3}\.bak/, readdir(BAKDIR));
closedir (BAKDIR);
foreach $bakFile (@bakFiles)
{ if (-M "$bakDir/$bakFile" > $bakMax) { unlink "$bakDir/$bakFile"; }
}
} # end backup
sub header
{
print "<html><head><title>$headTitle</title></head>\n";
print "$bodyTag\n$bodyTitle\n<p>\n";
}
sub footer
{
print qq|<p><font size=2><i><b>MAILMATIC</b> is one of <a href="http://www.GetCruising.com/crypt" target="_top">Joe's CGI Scripts From The Crypt!</a></i></font>\n|;
print qq|<p>\n</body></html>\n|;
}
sub endIt # Correctible user error
{
print qq|<font color="#FF0000"><b>ERROR:</font><br>|;
if ($_[0]) { print "$_[0]"; } else { print "Server made a Boo-Boo! $!"; }
print qq|</b>\n<p>Use your browser's [BACK] button and try again.\n|;
print qq|<p></body></html>\n|;
exit;
} # end endIt