Gossamer Forum
Home : General : Perl Programming :

Email based on multiple checbox value in a HTML form...

Quote Reply
Email based on multiple checbox value in a HTML form...
Hello All,

Thank you for any support in advanced. I come here for help because our perl programmer has left and we are left with a script that we do not know how to add to or modify. He has created a html form that sends out email based on user imput (they enter the email address that the form
should be sent to... Anyway, We have modify the form to add some checkboxes (9 groups) that has a SMTP address associated to them - for example,
If I select checkbox 1 and 3 the form should be sent via email to user1@domain.com and user3@domain.com.... and so on, in addition to the smtp address that's entered in the input field.

checkbox 1 = user1@domain.com
checkbox 2 = user2@domain.com
checkbox3 = user3@domain.com


Thank you,
Anthony Smile


below is the code from the html form....

--------------------------------------------------------------------------

<form name="Not_Out" method="post" action="/cgi-bin/form_email.pl">
<table border="0" cellspacing="0" cellpadding="0">
<tr>
<td colspan="2" class="maintext" bgcolor="#006699"> <b><font color="#FFFFFF">Select group(s)
to email ::</font></b></td>
</tr>
<tr>
<td> <font size="2">
<input type="checkbox" name="m_EmailGroups" value="User1">
Inttra All</font></td>
<td> <font size="2">
<input type="checkbox" name="m_EmailGroups" value="User2">
Integration & Operations </font></td>
</tr>
<tr>
<td> <font size="2">
<input type="checkbox" name="m_EmailGroups" value="User3 ">
EDI </font></td>
</table>
<p><font size="2">
<input type="submit" name="Submit" value="..:: SUBMIT ::.." class="buttons"> <input type="reset" name="reset" value="..:: RESET ::.." class="buttons">
</form>



---------------------------------------------------------------------------------


Below is the Perl script "form_email.pl"

**** We need to add the ability to email based on checkbox
selection from the html form to this Perl Script...If there
are any Perl expert that can interpret this script and make sense of it - Please help....We need it. ****************


---------------------------------------------------------------------------------------


#!c:/perl/bin
#!/usr/bin/perl

# init default values
@Months= qw(January February March April May June July August September October November December); unshift @Months, "";
@Weekdays= qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
#$base_path = "./";
$error_loop = 0;
$browser_out = 0;
$cfg_file = "settings.cfg";
$cfg_form = "form.cfg";
$content_type = "Content-Type: text/html\n\n";
$multi_separator = ", ";
##############################################################################

use CGI::Carp qw (fatalsToBrowser);
use CGI qw/:cgi/;
$ENV{'UPDATED'}= ' ';
$query = new CGI;

# default message
if ($ENV{'REQUEST_METHOD'} eq 'GET' and not $ENV{'QUERY_STRING'}) {
&StartPage;
exit(0);
}

@lines = ReadFile2('Configuration File', $cfg_file);
foreach $line (@lines) {
if ($line =~ /^(Referers)\s*=\s*(.+?)\s*(\x23|$)/)
{ eval "push \@$1, \"$2\";";}
elsif ($line =~ /^(\w+)\s*=\s*(.+?)\s*(\x23|$)/)
{ eval "\$$1 = \"$2\";"; }
}




# we can inherit base path if drawn through several pages in page sequence
$base_path = $query->param('base_path').'/' if defined(($query->param('base_path')));
$base_path = $query->param('_base_path').'/' if defined(($query->param('_base_path')));

#NOT The following reads the form config. TMP var - "base_path" still remains
#NOT Say GoodBye to form hidden fields :)
@lines=ReadFile2('Form Configuration File', $base_path . $cfg_form);
foreach $line (@lines) {
if ($line =~ /^(attachments_path)\s*=\s*(.+?)\s*(\x23|$)/)
{eval "\$$1 = \"$2\";";}
if ($line =~ /^(\w+)\s*=\s*(.+?)\s*(\x23|$)/)
{ eval "\$FORM{$1} = \"$2\";";}
}
$attachments_path=$base_path . $attachments_path;

#exit;
# let's party
&ParseForm;
&CheckRef;


$mail_format="plain" if ($ENV{'HTTP_REFERER'}=~/(\/\/|\.)aol\.com/);
$mail_format="plain" if ($ENV{'HTTP_REFERER'}=~/(\/|\.)not/);

$FORM{'_format_decimals'} = "0" unless ($FORM{'_format_decimals'});
$FORM{'GMT_OFFSET'} = "0" unless ($FORM{'GMT_OFFSET'});

## DATE FORMATTING
$date_format = 'dd.mm.yyyy' unless defined($date_format);
$date = $date_format;
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time + $FORM{'GMT_OFFSET'}*3600);
$mon++; $year+=1900; $syear="0".($year-2000);
$mday="0".$mday if length($mday)<2 ;

$date=~s/weekday/$Weekdays[$wday]/i;
$date=~s/wee/substr($Weekdays[$wday],0,3)/ei;
$date=~s/Month/$Months[$mon]/i;
$date=~s/mmm/substr($Months[$mon],0,3)/ei;
$mon=(length($mon)<2?"0":"").$mon; # "0" schreiben oder nicht?
$date=~s/yyyy/$year/i;
$date=~s/yy/$syear/io;
$date=~s/dd/$mday/io;
$date=~s/mm/$mon/eio;
$ENV{'DATE_GMT'} = sprintf("%02d:%02d:%02d %s GMT%+d",$hour,$min,$sec,$date,$FORM{'GMT_OFFSET'});
## END DATE FORMATTING


srand(time ^ $$);
$rnd1 = sprintf("%04d", int(rand 10000));
$rnd2 = sprintf("%04d", int(rand 10000));

$FORM{'unique_reference_number'} = "$year$mon$mday-$rnd1-$rnd2" unless ($FORM{'unique_reference_number'});

if (@missing_values or @bad_emails or @only_digits or @only_words) { Error('evil values') }

foreach $key (keys %FORM)
{
$FORM{$key} =~s/\0//g;
$FORM{$key} =~s/\"(\s|\.|\)|\Z)/$1/g;
$FORM{$key} =~s/(\A|\s|\.|\()\"/$1/g;
#NOT Page number
$pn=$FORM{'page_no'}; $pn++;
#NOT
# start_email is hidden field in the form which email has to been sent after
if ($key =~ /^_send_email/)
{
if (!defined($FORM{"_browser_out".$pn})) {
@lines = ReadFile('Email Template',$FORM{$key});
@lines = ParseText(@lines);
@lines = ParseEmail(@lines);
if ($mailserver ne '') {SendMailBySmtp(@lines);} else {SendMail(@lines);}
# BrowserOut("Mail ($FORM{$key}) was sent OK!<br>") ;
}
}
elsif ($key =~ /^_out_file/)
{
if (!defined($FORM{"_browser_out".$pn})) {
@lines = ReadFile('Log File',$FORM{$key});
@lines = ParseText(@lines);
LogFile('LogFile Template',@lines);
}
}
elsif ($key =~ /^_browser_out$FORM{page_no}$/ and $browser_out < 2)
{
#NOT Loading template:
$browser_out++;
@lines = ReadFile('Browser Template', $FORM{$key});
@lines = ParseText(@lines);
#NOT Appending POST variables as hidden fields
foreach $line (@lines) {
if ($line=~/(<\/form>)/) {
$hfields="";
foreach $k (keys %FORM) {
$v=$FORM{$k};
if ($k =~ /^page_no/) {$v++;}
$hfields .= '<input type="hidden" name="'.$k.'" value="'.$v.'">'."\n";
}
if (!defined($FORM{page_no})) {$hfields .= '<input type="hidden" name="page_no" value="1">'."\n";}
$line=$`.$hfields.$1.$';
}
}
BrowserOut(@lines);
}
elsif ($key =~ /^_redirect/ and $browser_out < 2)
{
$browser_out++;
print "Location: $FORM{$key}\n\n";
}
}


unless ($browser_out) {
@msg = (<DATA>);
$ENV{'OUT_TITLE'} = "Submission Successful";
$ENV{'OUT_MSG'} = "Your submission was successful. Thank you.";
@msg = ParseText(@msg);
BrowserOut(@msg);
}

opendir(DIR, $attachments_path) || exit(0);
@files_list = grep { /^\d{8}_(.*)_\._file$/ && -f "$attachments_path$_" } readdir(DIR);
closedir DIR;
foreach $attachment_file (@files_list) {
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) = stat($attachments_path.$attachment_file);
if (time() >= $mtime + $attachments_ttl) {
unlink($attachments_path.$attachment_file);
}
}

exit(0);

### Subroutines ###

sub round
{
$value = shift @_;
$round_dec = shift @_;
$round_dec = $FORM{'_format_decimals'} if ($round_dec eq "");
return sprintf("%.".$round_dec."f", $value);

}#round

sub BrowserOut
{
print "$content_type@_\n";
}#BrowserOut

sub CheckRef
{
my ($valid_referer, @terms);

if ((@Referers) and ($ENV{'HTTP_REFERER'})) {
foreach $referer (@Referers) {
if ($ENV{'HTTP_REFERER'} =~ m|http.*?://$referer|i) {
$valid_referer++;
last;
}
}
} else {
$valid_referer++;
}
unless ($valid_referer) {
@terms = split(/\//,$ENV{'HTTP_REFERER'});
Error ('Bad Referer',
"'$ENV{'HTTP_REFERER'}' is not authorised to use this script. If you want them to be able to,
you should add '$terms[2]' to the referer list."
);
}
}#CheckRef

sub Error
{
++$error_loop;
my $title = shift @_;
my $msg = shift @_;
my @error;

if ($title eq 'evil values') {
my $val;

if (@missing_values) {
$msg = qq|<p>The following field(s) are required to be filled in before successful submission:</p>\n<table border=0><tr><td><ol>\n|;
foreach $val (@missing_values) { $msg .= "<li>$val\n" }
$msg .= "</ol></td></tr></table>\n";
}
if (@bad_emails) {
$msg .= qq|<p>The following field(s) are required to be filled in with valid email addresses before successful submission:</p>\n<table border=0><tr><td><ol>\n|;
foreach $val (@bad_emails) { $msg .= "<li>$val\n" }
$msg .= "</ol></td></tr></table>\n";
}
if (@only_digits) {
$msg .= qq|<p>The following field(s) are required to be filled in only with digits (0-9) and decimal point before successful submission:</p>\n<table border=0><tr><td><ol>\n|;
foreach $val (@only_digits) { $msg .= "<li>$val\n" }
$msg .= "</ol></td></tr></table>\n";
}
if (@only_dig_and_dolar) {
$msg .= qq|<p>The following field(s) are required to be filled in only with digits (0-9) a decimal point, or a dollar sign before successful submission:</p>\n<table border=0><tr><td><ol>\n|;
foreach $val (@only_dig_and_dolar) { $msg .= "<li>$val\n" }
$msg .= "</ol></td></tr></table>\n";
}
if (@only_words) {
$msg .= qq|<p>The following field(s) are required to be filled in only with word characters (A-Z, 0-9) before successful submission:</p>\n<ol type="i">\n|;
foreach $val (@only_words) { $msg .= "<li>$val\n" }
$msg .= "</ol>\n";
}
$title = 'Error - Incorrect Values';
$msg .= qq|<p>Please go back and fill in the fields accordingly.</p>\n|;
}
if ($FORM{'_error_url'}) {
print "Location: $FORM{'_error_url'}\n\n"

} elsif ($FORM{'_error_path'} and $error_loop < 2) {
$ENV{'OUT_TITLE'} = $title;
$ENV{'OUT_MSG'} = $msg;
@error = ReadFile('Error Template',$FORM{'_error_path'});
@error = ParseText(@error);
BrowserOut(@error);
} else {
@error = (<DATA>);
$ENV{'OUT_TITLE'} = $title;
$ENV{'OUT_MSG'} = $msg;
@error = ParseText(@error);
BrowserOut(@error);
}
exit(0);
}#Error

sub LogFile
{
my $msg = shift @_;
my $file = shift @_;

$file =~ s#^(\s)#./$1#;
# $file =~ s#\.\./##g;
# $file =~ s/[^\w-\.]//g;
$file = $base_path . $file;

open(FILE,">>$file") or Error('File Access Error',"An error occurred when trying to append to the $msg ($file): $!");
if (!defined($ENV{'COMSPEC'})) { # flock ain't needed on Windows !NT based systems
flock(FILE,2) or Error('File Lock Error',"An error occured when locking the $msg ($file): $!.");
}
print FILE @_;
close(FILE) or Error('File Close Error',"An error occurred when close the $msg ($file): $!.");

}#LogFile

sub ReadFile
{
my $msg = shift @_;
my $file = shift @_;

$file =~ s#^(\s)#./$1#;
# $file =~ s#\.\./##g;
# $file =~ s/[^\w-\.]//g;
$file = $base_path . $file;
open(FILE, "$file") or Error('File Access Error',"An error occurred when opening the $msg ($file): $!.");
my @lines = (<FILE>);
close(FILE) or Error('File Close Error',"An error occurred when close the $msg ($file): $!.");
return @lines;

}#ReadFile

sub ReadFile2
{
my $msg = shift @_;
my $file = shift @_;

$file =~ s#^(\s)#./$1#;
open(FILE, "$file") or Error('File Access Error',"An error occurred when opening the $msg ($file): $!.");
my @lines = (<FILE>);
close(FILE) or Error('File Close Error',"An error occurred when close the $msg ($file): $!.");
return @lines;

}#ReadFile2

sub ParseForm
{
my ($key, $prefs, $buffer, $file, $local_file, $value, $name, $file_name);

@names = $query->param;

foreach $name (@names)
{
$value = $query->param($name);

$FORM{$name} = $value;

if ($bytesread = read($value, $buffer, 1024)) {
$file_name = $value;
if ($file_name =~ /([^\/\\:]*)$/) {
$file_name = $1;
}
my $t_size = 0;
srand(time ^ $$);
my $rnd = sprintf("%08d", int(rand 100000000));
$local_file = $attachments_path . $rnd . "_" . $file_name . "_._file";
$FORM{$name."_uploaded"} = $rnd . "_" . $file_name . "_._file";
open (OUTFILE,">$local_file") or Error('File Access Error',"An error occurred when trying to save attachments ($local_file): $!");
binmode OUTFILE;
$t_size = length($buffer);
print OUTFILE $buffer;
while ($bytesread = read($value, $buffer, 1024)) {
$t_size += length($buffer);
print OUTFILE $buffer;
}
close OUTFILE;
my $f_size = 1024 * $max_file_size;
if($t_size > $f_size && $f_size != 0) {
unlink($local_file);
Error("Uploading file is too large. It must to be less than $max_file_size KB.");
}

} else {
if ($name =~ /^([rs]*[edwmcn]?[rs]*)_/) {

($prefs, $key) = split /_/, $name, 2;

if ($prefs =~ /s/i and $value) {
$value =~ s/^(\s)*//;
$value =~ s/(\s)*$//;
$FORM{$name} = $value;
}

if ($prefs =~ /m/i and $value) {
$multi_separator = $FORM{'_multi_separator'} if defined($FORM{'_multi_separator'});
@value = $query->param($name);
$value = join($multi_separator,@value);
$value =~ s/^default$multi_separator|^default//ig;
$FORM{$name} = $value;
}
if ($prefs =~ /n/i and $value) {
$value =~ s/\n//ig;
$value =~ s/\r//ig;
$FORM{$name} = $value;
}

if ($prefs =~ /r/i and $value eq "")
{ push @missing_values, $key }
if ($prefs =~ /e/i and $value and isEmailBad($value))
{ push @bad_emails, $key }
if ($prefs =~ /d/i and $value and !($value =~ /^(\d+|\d+\.\d+)$/))
{ push @only_digits, $key }
if ($prefs =~ /c/i and $value and !($value =~ /^(\$?\d+\$?|\$?\d+\.\d+\$?)$/))
{ push @only_dig_and_dolar, $key }
if ($prefs =~ /w/i and $value and $value =~ /\W/)
{ push @only_words, $key }
}
}
}
}#ParseForm

sub ParseText
{
my ($line, $key, $value, $sub);
foreach $line (@_) {
while (($key => $value) = each %FORM)
{ $line =~ s/\[$key\]/$value/ig }
while (($key => $value) = each %ENV)
{ $line =~ s/\[\%$key\]/$value/ig }
$line =~ s/\x7e(\w+)((\[)(\d)(\]))?/eval "\$$1$3$4$5"/e;
#remove blank vars
# $line =~ s/\[[^<](.)*?[^>]\]//g;
}
foreach $line (@_) {
while ($line =~ /\[<((.)*?)>\]/) {
$sub = $1;

if ($sub !~ /^([\d\+\*\/\-%\.,x<>\(\)\s]|round|ifcond)*$/s) {
Error("Error in expression", $sub);
}
$sub = eval $sub;
$line =~ s/\[<(.)*?>\]/$sub/s
}
}
return @_;

}#ParseText

sub ifcond
{
$cond = shift @_;
$res1 = shift @_;
$res2 = shift @_;

if($cond) {
return sprintf("%s", $res1);
} else {
return sprintf("%s", $res2);
}

}#ifcond

sub ParseEmail
{
my ($line, $attachment_file, $add2email, $real_name, @email);
$add2email = "";
foreach $line (@_)
{
if (($line =~ /^Subject: (.+)\n$/i) and ($mail_format eq "html")) {
$sline = $line."Content-Type: text\/html\n";
$line =~ s/^Subject: (.+)\n$/$sline/i;
}

if ($line =~ /^Attachment: (.+)$/i)
{
my @files = split (/,/, $1);

foreach $attachment_file (@files)
{
$attachment_file =~ s/(^\s*|\s*$)//g;
if ($attachment_file =~ /([^\/\\:]*)$/)
{
$attachment_file = $1;
}

if ($attachment_file =~ /^\d{8}_(.*)_\._file$/)
{$real_name = $1;}
else {$real_name = $attachment_file;}

#FIX
if (-e $attachments_path . $attachment_file)
{
$add2email .= "---2099962873-1165733044-991133573=:5283\n";
$add2email .= "Content-Transfer-Encoding: BASE64\n";
$add2email .= "Content-Disposition: attachment; filename=\"$real_name\"\n\n";

open(FILE, $attachments_path . $attachment_file) or Error("Error while opening attchment file", "\'$attachments_path$attachment_file\'");
binmode FILE;
while (read(FILE, my $buf, 60*57))
{
$add2email .= encode_base64($buf);
}
close FILE;
}
}

push @email, "MIME-Version: 1.0\n";
push @email, "Content-Type: MULTIPART/MIXED; BOUNDARY=\"-2099962873-1165733044-991133573=:5283\"\n\n";
push @email, " This message is in MIME format. The first part should be readable text,\n";
push @email, " while the remaining parts are likely unreadable without MIME-aware tools.\n";
push @email, " Send mail to mime\@docserver.cac.washington.edu for more info.\n\n";
push @email, "---2099962873-1165733044-991133573=:5283\n";

} else {
#NOT
# Strip tags if mail format is plain, skipping service info lines
$line=~s/<(?:[^>'"]*|(['"]).*?\1)*>//gs if ($mail_format eq "plain" && $line !~ /^(From|To|Cc|Bcc):/i);
push @email, $line;
}
}
if ($add2email)
{
push @email, "\n$add2email";
push @email, "---2099962873-1165733044-991133573=:5283--\n";
}
return @email;
}#ParseEmail

sub isEmailBad
{
$value = shift @_;
return (($value =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/) or
($value !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,6}|[0-9]{1,3})(\]?)$/));
}#isEmailBad

sub SendMailBySmtp
{
my($line, $var_name, @message);

unless ($smtp_used) {
eval "use Net::SMTP";
if ($@) {
Error('Net::SMTP init error', "Can't load Net::SMTP module");
return 0;
}
$smtp_used = 1;
}

@message = @_;
foreach $line (@message)
{
if ($line =~ /^(to|from|b?cc): (.+)$/i)
{
$mail_param = $1;
$mail_val = $2;

if ($mail_val =~ /<(.+)>/)
{
$mail_val = $1;
}

$var_name = "mail_".lc($mail_param);
# $$var_name = $mail_val;
@$var_name = split(/\x2c(\s*)?/,$mail_val);
}
}


$smtp = Net::SMTP->new($mailserver);
$smtp->mail($mail_from);
foreach $mt (@mail_to) {$smtp->recipient($mt);}
foreach $mt (@mail_cc) {$smtp->recipient($mt);}
foreach $mt (@mail_bcc) {$smtp->recipient($mt);}
$smtp->data();
$smtp->datasend(@_);
$smtp->dataend();
$smtp->quit;

}#SendMailBySmtp

sub SendMail
{
if ($mail_cmd ne "") {
open(MAIL,"|$mail_cmd") or Error('Mailer Open Error',"An error occurred when trying to open the mailer ($mail_cmd): $!.");
print MAIL @_;
# print "\n\n",@_;
close(MAIL) or Error('Mail Send Error',"An error occurred when sending the email: $?. Please check the email's headers.");
}
}#SendMail

sub encode_base64
{
my $res = "";
pos($_[0]) = 0;
while ($_[0] =~ /(.{1,45})/gs) {
$res .= substr(pack('u', $1), 1);
chop($res);
}
$res =~ tr|` -_|AA-Za-z0-9+/|;
my $padding = (3 - length($_[0]) % 3) % 3;
$res =~ s/.{$padding}$/'=' x $padding/e if $padding;
$res =~ s/(.{1,76})/$1\n/g;
return $res;
}#encode_base64

sub ManagePage
{
$ENV{'OUT_TITLE'} = "eMail Form Script Administrative Section";
$ENV{'OUT_MSG'} = "";
open (CFILE, "<cform.html") or Error('Config Form Open Error',"An error occurred when opening config form (cform.html): $!. Please check paths and file.");
@msg = <CFILE>;
close (CFILE) or Error('Config Form Close Error','An error occured while closing the file (cform.html): $!.');
@msg = ParseText(@msg);
BrowserOut(@msg);
1;
}#ManagePage

sub SavePage {
&ParseForm;
$mas=0;
@lines = ReadFile2('Configuration File', $cfg_file);
#BrowserOut($cfg_file."<br>");
open (FILE, ">$cfg_file") or Error('Config Form Open Error',"An error occurred when opening config file($cfg_file): $!. Please check paths and file permissions (Must be 766).");
foreach $line (@lines) {
if ($line =~ /^(Referers)\s*=\s*(.+?)\s*(\x23|$)/)
{
$var_name=$1; $var_value=$2;
$line=~s/$var_value/$FORM{$var_name.$mas}/ if defined($FORM{$var_name.$mas});
#print "$var_name === $FORM{$var_name.$mas}<br>";
$mas++;
}
elsif ($line =~ /^(\w+)\s*=\s*(.+?)\s*(\x23|$)/)
{
$var_name=$1; $var_value=$2;
$line=~s/$var_value/$FORM{$var_name}/ if defined($FORM{$var_name});
}
print FILE $line;
}
close (FILE) or Error('Config Form Close Error','An error occured while closing the file ($cfg_file): $!.');
1;
}#SavePage

sub StartPage {
$ENV{'UPDATED'} = "" unless ($ENV{'UPDATED'});
$ENV{'OUT_TITLE'} = "INTTRA - Outage Notification Form";
$ENV{'OUT_MSG'} = qq~The latest version of this script and documentation is available from. <form action=$ENV{'SCRIPT_NAME'} method=POST><p align=center>To access configuration, please enter password: <br>
<input type=password name="pass09123" value="" style="border: 1 outset rgb(50,50,50);">
<input type="Submit" value=" ..:: OK ::.. " style="font: bold 8pt Verdana; color: #FFFFFF;background-color: #666699"></form></p>
~;
@msg = (<DATA>);
@msg = ParseText(@msg);
BrowserOut(@msg);
1;
}#StartPage
__END__

<html>
<head>
<title>[%OUT_TITLE]</title>
</head>

<body bgcolor="#FFFFFF" text="#000000" link="navy" vlink="navy" alink="red"
style="font-family: verdana, arial, sans-serif; font-size: 8;">
<center>
<table border="0" cellpadding="0" cellspacing="0" width="500"
style="font-family: verdana, arial, sans-serif; font-size: 12;">
<tr>
<td><h2 align="center">[%OUT_TITLE]</h2>
[%UPDATED]
<p align="center">[%OUT_MSG]</p>

</tr>
</table>
</center>
</body>
</html>