# "order" form example
#
# The "customer" fills out a form, say an order form.
# The form data is validated and a confirmation page
# displayed. ALso, a confirmation e-mail is sent to the
# customer.
#
# In addition, logging is used.
# turn on logging
#
# web::logfilter determines which log messages will be sent to the log
# destination. The rule here is: let all log messages pass which have
# facilities that match "*" and which have a level up to and including
# level "debug"
web::logfilter add *.-debug
# define where to send log messages to. Here we use a file
# and again define a log destination based filter, which is again
# "*.-debug" as above
web::logdest add *.-debug file /tmp/websh/emailform.log
# because log directory might not exist in this environment
# (note: in a production environment you make sure that this exists
# at install time. You don't want to create that directory with every request)
catch {file mkdir /tmp/websh}
# utility command to handle an HTML page
proc page {title code} {
web::putx {{web::put $title}
{web::put $title}
}
uplevel $code
web::put "\n"
}
# utility command to handle an html form
proc form {page code} {
web::put ""
}
# define the form where address is entered
proc showForm {error} {
# generate a page with Title "Form"
page "Order Form" {
# generate a form with action "submit"
form "submit" {
web::putx {
Name: {
# if "error" flag is set, show the red error message asking for input
if {$error == 1} {
web::put "Please enter your name\n"
}
}
Address:
E-Mail: {
# if "error" flag is set, ask for valid e-mail address
if {$error == 2} {
web::put "Please enter a valid email addres\n"
}
}
}
}
}
}
# validator:
#
# make sure we have a name of non-zero length.
# Also, make sure the e-mail address is not completely wrong.
proc checkFormData {} {
# check if a value is in the name field
if { [string length [web::formvar name]] < 1} {
# return error code
return 1
}
# log (facility: emailform, level: debug)
web::log emailform.debug {name [web::formvar name] is valid}
# check email
set email [web::formvar email]
# make sure we have alpha-numeric stuff separated by "@"
if {![regexp -nocase {^([a-z._0-9-]+)@([a-z._0-9-]+)\.+([a-z]+)$} \
$email email name domain]} {
# return error code
return 2
}
# check length of domain
if {[string length $domain] < 3} {
return 2
}
web::log emailform.debug {email [web::formvar email] is valid}
# looks good: no error
return 0
}
# sendEmail
#
# create the e-mail message and send it to the given e-mail address
proc sendEmail {} {
# disabled for security reasons, and because there is no
# sendmail on www.apache.org ;-)
return 1
set emailtxt {
Thank you for your submission.
We have recieved the following information:}
append emailtxt "\nName:\n[web::formvar name]\n"
append emailtxt "Address:\n"
append emailtxt [web::formvar addr]
append emailtxt {
Find more information about Webshell at http://tcl.apache.org/websh/
The team.
}
# log message
web::log emailform.debug "e-mail: $emailtxt"
if { [catch {
# Open pipe for e-mail
set fh [open "| /usr/lib/sendmail [web::formvar email]" w]
puts $fh "From: info@tcl.apache.org"
puts $fh "Subject: websh3 sample application - sample confirmation"
puts $fh ""
puts $fh $emailtxt
close $fh
} cmsg ] } {
return 0
}
return 1
}
proc showErrorPage {} {
page "Error" {
web::putx {
An error occurred while processing your request.
Please {web::put "try"} again
If the problem persists, please contact the
{web::put "webmaster"}.
}
}
}
proc showConfirmationPage {} {
page "Confirmation" {
web::putx {
Thank you for your order
We have recieved the following information:
Name:
{web::put [web::htmlify [web::formvar name]]}
Address:
{
# take care of linebreaks in address
regsub -all "\r\n" [web::htmlify [web::formvar addr]] " " addr
web::put $addr
}
E-Mail:
{web::put [web::htmlify [web::formvar email]]}
You should recieve a confirmation by e-mail shortly.
Note: to prevent misue, sending the actual email is disabled, so please don't wait for the mail ;-)
{web::put "Order more"}
cool stuff.
}
}
}
# register the "default" command
#
# This command will be used whenever no specific command has been specified.
# We use it to show an empty form for address submission.
web::command default {
showForm 0
}
# register command "submit"
#
# This is the "action" of our form. The form data is validated. If
# the formdata is incomplete or invalid, the form is re-displayed with
# an error info, where the original input is displayed as well.
#
# If the data is valid, the confirmation page is shown and
# an e-mail is sent to the specified address.
web::command submit {
if { [set res [checkFormData]] == 0 } {
if {[sendEmail]} {
showConfirmationPage
} else {
showErrorPage
}
} else {
showForm $res
}
}
web::dispatch