#!/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 () 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';
Are you sure?
$date(%D) $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, )
Please hit the back button on your browser, edit your
abstract, and try again.
)
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()
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)
$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 = <Thanks for you submission
Thank you for your submission
Idiom's home
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 = "\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'\n';
}
} else {
my $v = $values[0];
$v =~ s/"/"/g;
$hidden .= qq'\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
Error: \u$head