#!/usr/local/bin/perl
# Copyright (c) 1998 David Muir Sharnoff
#############################################################################
#
# formsave will can verify form submissions, write form submissions
# to a file, and email form submissions. Each copy of formsave.cgi
# must be customized for a particular form.
#
# The customization is done with templates. Each template is has
# has substitutions performed on it. The general substitution is
# to have
# $NAME()
# replaced by the form value named by NAME.
#
# For example, if you had a form element called age (<input type=text
# name=age>) then you could substutute in the submitted value using
# $age().
#
# There are a few special substututions. Don't have form elements of
# these names:
#
# $date(format) - see Time::CTime for format conversions
# $gmt(format) - see Time::CTime for format conversions
# $env(name) - an environment variable (often from CGI)
# $hidden() - submitted data as hidden variables
# $username() - current username
# $thisurl() - the url of this CGI
# $dollar() - a literal dollar sign ($)
#
# With normal substututions (from form values) modifiers are possible.
# The name of the modifier goes in the parens.
#
# (wrap) - wrap text at 70 columns (see Text::Wrap)
# (wrap,initial,indent): - wrap text at 70 columns (see Text::Wrap)
# (upper) - convert to upper case
# (lower) - convert to lower case
# (default,value) - provide default value if no value
# (addafter,value) - provide value if there is a value
# (addbefore,value) - provide value if there is a value
#
#
# This is the template for form verification.
#
my $verify = <<'ENDVERIFY';
<html><head><title>Are you sure?</title></head>
<body>
$date(%D)<br>
<strong>$Abstracts.Title.t(upper)</strong><br>
$Abstracts.Author1.t(default,NO AUTHOR PROVIDED) $Abstracts.Address1.t()<br>
$Abstracts.Author2.t() $Abstracts.Address2.t(addafter,<br>)
$Abstracts.Author3.t() $Abstracts.Address3.t(addafter,<br>)
$Abstracts.Author4.t() $Abstracts.Address4.t(addafter,<br>)
$Abstracts.Author5.t() $Abstracts.Address5.t(addafter,<br>)
<p>
$Abstracts.Abstract.t(sizelimit,1500,Content-type: text/html
<html><head><title>Abstract too big</title></head>
<body><h1>The abstract is limited to 1500 characters</h2>
<p>
Please hit the back button on your browser, edit your
abstract, and try again.
</body></html>)
<br>
<i>Presenter:</i> $Abstracts.FirstName.t(addafter, )$Abstracts.MiddleInitial.t(addafter, )$Abstracts.LastName.t()<br>
$Abstracts.Organization.t(addafter,<br>)
$Abstracts.Addressa.t(addafter,<br>)
$Abstracts.Addressb.t(addafter,<br>)
$Abstracts.City.t(), $Abstracts.State.t() $Abstracts.ZipCode.t()
$Abstracts.Country.t(addbefore,<br> )
<br>
<i>Telephone:</i> $Abstracts.Phone.t()
<i>Fax:</i> $Abstracts.FaxPhone.t()<br>
<i>E-mail:</i> $Abstracts.Email.t()<br>
<i>Keywords:</i>
$Abstracts.Key1.t()
$Abstracts.Key2.t()
$Abstracts.Key3.t()
$Abstracts.Key4.t()
$Abstracts.Key5.t()
<hr>
<form method=POST action=$thisurl()>
$hidden()
<input type=submit value=submit name=submit>
</form>
or hit your back button to change a value.
ENDVERIFY
#
# This is the template for writing a form to a file. If you don't
# want the form written to a file, set the variable $write to the
# empty string.
#
my $write = <<'ENDWRITE';
-------------------------------------------------------------------------------
$date(%D)<br>
$Abstracts.Title.t(upper)
$Abstracts.Author1.t(default,NO AUTHOR PROVIDED) $Abstracts.Address1.t()>
$Abstracts.Author2.t() $Abstracts.Address2.t(addafter,)
$Abstracts.Author3.t() $Abstracts.Address3.t(addafter,)
$Abstracts.Author4.t() $Abstracts.Address4.t(addafter,)
$Abstracts.Author5.t() $Abstracts.Address5.t(addafter,)
$Abstracts.Abstract.t(wrap)
Presenter: $Abstracts.FirstName.t(addafter, )$Abstracts.MiddleInitial.t(addafter, )$Abstracts.LastName.t()
$Abstracts.Organization.t(addafter,)
$Abstracts.Addressa.t(addafter,)
$Abstracts.Addressb.t(addafter,)
$Abstracts.City.t(), $Abstracts.State.t() $Abstracts.ZipCode.t()
$Abstracts.Country.t(addbefore, )
Telephone: $Abstracts.Phone.t()
Fax: $Abstracts.FaxPhone.t()
E-mail: $Abstracts.Email.t()
Keywords:
$Abstracts.Key1.t()
$Abstracts.Key2.t()
$Abstracts.Key3.t()
$Abstracts.Key4.t()
$Abstracts.Key5.t()
ENDWRITE
#
# This is the template for mailing a form. If you don't want the form
# submission emailed, set $mail to the empty string ('')
#
my $mail = <<ENDMAIL;
To: muir-local\@idiom.com
From: muir-local\@idiom.com
Subject: a test
$write
ENDMAIL
#
# This specifies the file that forms should be appeneded to
#
my $writeto = "/cgi/home/muir/public_html/shared/sra/abstract.files";
#
# This specifies where forms should be mailed and what their
# return address should be.
#
my $mailto = 'muir-local@idiom.com';
my $mailfrom = 'muir-local@idiom.com';
#
# This specifies the names of the mail servers to try when sending
# mail.
#
my (@mailhosts) = qw(
localhost
mx0.idiom.com
mx1.idiom.com
mx2.idiom.com
mx3.idiom.com
);
#
# This specifies the URL to or text to display after the form
# has been submitted. This can either be a Redirect or a
# web page. If it's a web page, it should being with
# Content-type: text/html\r\n\r\n. If it's a redirect, it should
# begin with Redirect: some-url\r\n\r\n
#
my $next = <<ENDNEXT;
Content-type: text/html\n\n
<html><head><title>Thanks for you submission</title></head>
<meta http-equiv=refresh content="5;URL=http://www.idiom.com">
<body>
<h1>Thank you for your submission</h1>
<a href="http://www.idiom.com">Idiom's home</a>
</body></html>
ENDNEXT
#############################################################################
# END CONFIGURATION SECTION
# DO NOT EDIT BELOW THIS LINE
#############################################################################
use strict;
use CGI;
use CGI::Carp;
use Text::Wrap;
use File::Flock;
use Net::SMTP;
use Sys::Hostname;
use Time::CTime;
my $query = new CGI;
my $hidden;
my (%builtins) = (
'thisurl' => sub { return $ENV{'SCRIPT_NAME'}; },
'env' => sub { return $ENV{$_[0]}; },
'date' => sub { return strftime($_[0], localtime(time)); },
'gmt' => sub { return strftime($_[0], gmt(time)); },
'hidden' => sub { return $hidden; },
'dollar' => sub { return '$'; },
);
my (%modifiers) = (
'wrap' => sub {
my($t, $initial, $indent) = @_;
return wrap($initial, $indent, $t);
},
'upper' => sub { return "\U$_[0]"; },
'lower' => sub { return "\L$_[0]"; },
'default' => sub { return ($_[0] || $_[1]) },
'addbefore' => sub {
my ($v, $addon) = @_;
return "$addon$v" if $v ne '';
return '';
},
'addafter' => sub {
my ($v, $addon) = @_;
return "$v$addon" if $v ne '';
return '';
},
'sizelimit' => sub {
my ($text, $limit, @error) = @_;
if (length($text) > $limit) {
print @error;
exit(0);
}
return $text;
},
);
$hidden = "<input type=hidden name=verified value=1>\n";
for my $name ($query->param()) {
my @values = $query->param($name);
my $n = $name;
$n =~ s/"/"/g;
if (@values > 1) {
for my $v (@values) {
$v =~ s/"/"/g;
$hidden .= qq'<input type=hidden name="$n"'
.qq' value="$v">\n';
}
} else {
my $v = $values[0];
$v =~ s/"/"/g;
$hidden .= qq'<input type=hidden name="$n" value="$v">\n';
}
}
if ($verify && ! $query->param('verified')) {
my $text = substitute($verify);
print "Content-type: text/html\n\n";
print $text;
exit(0);
}
my @bomb;
DOWRITE: {
if ($writeto && $write) {
my $text = substitute($write);
lock $writeto;
unless (open(FILE, ">>$writeto")) {
@bomb = ('write to file failed',
"Could not open $writeto: $!");
last DOWRITE;
}
unless (print FILE $text) {
@bomb = ('write to file failed',
"Could not write to $writeto: $!");
last DOWRITE;
}
unless (close(FILE)) {
@bomb = ('write to file failed',
"Could not write to $writeto: $!");
last DOWRITE;
}
}
}
DOMAIL: {
if ($mailto && $mail) {
my $text = substitute($mail);
my $smtp;
while (! $smtp && @mailhosts) {
$smtp = new Net::SMTP shift(@mailhosts);
}
if (! $smtp) {
@bomb = ('could mail form data',
"Could open a connection to a mail server");
last DOMAIL;
}
$smtp->mail($mailfrom);
$smtp->to($mailto);
$smtp->data();
$smtp->datasend($text);
$smtp->dataend();
$smtp->quit();
}
}
bomb(@bomb) if @bomb;
my $nt = substitute($next);
print $nt;
exit(0);
sub substitute
{
my ($text) = @_;
my $new = '';
my $lastpos = 0;
while ($text =~ m/(?:\G|^)(.*?)\$([\w.]+)\((.*?)\)/gs) {
$new .= $1;
my $var = $2;
my $mods = $3;
if (exists $builtins{$var}) {
$new .= &{$builtins{$var}}($mods);
} else {
my (@mods) = (split(',',$mods));
my $m = shift(@mods);
my (@v) = $query->param($var);
for my $v (@v) {
if (exists $modifiers{$m}) {
$new .= &{$modifiers{$m}}($v, @mods);
} else {
$new .= $v;
}
}
}
$lastpos = pos($text);
}
$new .= substr($text, $lastpos);
return $new;
}
sub bomb
{
my($head, $body) = @_;
print <<"";
Content-type: text/html\r\n\r\n
<html><head><title>Error: \u$head</title></head>
<body>
<h1>\u$head</h1>
<p>
Error in $0:
$body
<p>
</body></html>
carp "$0 error: $head\n";
exit(0);
}