websh/examples/emailform.ws3 - tcl-site - Git at Google

 # "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 {<html><head><title>{web::put $title}</title></head>
 	<body bgcolor="#ffffff" text="#000000">
 	<h1>{web::put $title}</h1>
     }
     uplevel $code
     web::put "</body></html>\n"
 }

 # utility command to handle an html form
 proc form {page code} {
     web::put "<form method=\"post\" action=\"[web::cmdurl $page]\">"
     uplevel $code
     web::put "</form>"
 }

 # 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 {
 		<dl>
 		<dt><b>Name:</b> {
 		    # if "error" flag is set, show the red error message asking for input
 		    if {$error == 1} {
 			web::put "<font color=\"\#990000\">Please enter your name</font>\n"
 		    }
 		}
 		<dd><input type="text" name="name" value="{web::put [web::htmlify [web::formvar name]]}" size="30"><p>
 		<dt><b>Address:</b>
 		<dd><textarea name="addr" rows="4" cols="30" wrap="auto">{web::put [web::htmlify [web::formvar addr]]}</textarea><p>
 		<dt><b>E-Mail:</b> {
 		    # if "error" flag is set, ask for valid e-mail address
 		    if {$error == 2} {
 			web::put "<font color=\"\#990000\">Please enter a valid email addres</font>\n"
 		    }
 		}
 		<dd><input type="text" name="email" value="{web::put [web::htmlify [web::formvar email]]}" size="30"><p>
 		</dl>
 		<input type="submit" name="ok" value="Send">
 	    }
 	}
     }
 }

 # 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 "<a href=\"[web::cmdurl default]\">try</a>"} again
 	    <br><br>
 	    If the problem persists, please contact the
 	    {web::put "<a href=\"mailto:webmaster@websh.com\">webmaster</a>"}.
 	}
     }
 }

 proc showConfirmationPage {} {

     page "Confirmation" {

 	web::putx {
 	    <h3>Thank you for your order</h3>
 	    We have recieved the following information:
 	    <dl>
 	    <dt><b>Name:</b>
 	    <dd>{web::put [web::htmlify [web::formvar name]]}<p>
 	    <dt><b>Address:</b>
 	    <dd>{
 		# take care of linebreaks in address
 		regsub -all "\r\n" [web::htmlify [web::formvar addr]] "<br>" addr
 		web::put $addr
 	    }<p>
 	    <dt><b>E-Mail:</b>
 	    <dd>{web::put [web::htmlify [web::formvar email]]}<p>
 	    </dl>
 	    You should recieve a confirmation by e-mail shortly.

 	    <p><b>Note: to prevent misue, sending the actual email is disabled, so please don't wait for the mail ;-)</b></p>

 	    {web::put "<a href=\"[web::cmdurl default]\">Order more</a>"}
 	    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
	# "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 {<html><head><title>{web::put $title}</title></head>
	<body bgcolor="#ffffff" text="#000000">
	<h1>{web::put $title}</h1>
	}
	uplevel $code
	web::put "</body></html>\n"
	}

	# utility command to handle an html form
	proc form {page code} {
	web::put "<form method=\"post\" action=\"[web::cmdurl $page]\">"
	uplevel $code
	web::put "</form>"
	}

	# 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 {
	<dl>
	<dt><b>Name:</b> {
	# if "error" flag is set, show the red error message asking for input
	if {$error == 1} {
	web::put "<font color=\"\#990000\">Please enter your name</font>\n"
	}
	}
	<dd><input type="text" name="name" value="{web::put [web::htmlify [web::formvar name]]}" size="30"><p>
	<dt><b>Address:</b>
	<dd><textarea name="addr" rows="4" cols="30" wrap="auto">{web::put [web::htmlify [web::formvar addr]]}</textarea><p>
	<dt><b>E-Mail:</b> {
	# if "error" flag is set, ask for valid e-mail address
	if {$error == 2} {
	web::put "<font color=\"\#990000\">Please enter a valid email addres</font>\n"
	}
	}
	<dd><input type="text" name="email" value="{web::put [web::htmlify [web::formvar email]]}" size="30"><p>
	</dl>
	<input type="submit" name="ok" value="Send">
	}
	}
	}
	}

	# 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 "<a href=\"[web::cmdurl default]\">try</a>"} again
	<br><br>
	If the problem persists, please contact the
	{web::put "<a href=\"mailto:webmaster@websh.com\">webmaster</a>"}.
	}
	}
	}

	proc showConfirmationPage {} {

	page "Confirmation" {

	web::putx {
	<h3>Thank you for your order</h3>
	We have recieved the following information:
	<dl>
	<dt><b>Name:</b>
	<dd>{web::put [web::htmlify [web::formvar name]]}<p>
	<dt><b>Address:</b>
	<dd>{
	# take care of linebreaks in address
	regsub -all "\r\n" [web::htmlify [web::formvar addr]] "<br>" addr
	web::put $addr
	}<p>
	<dt><b>E-Mail:</b>
	<dd>{web::put [web::htmlify [web::formvar email]]}<p>
	</dl>
	You should recieve a confirmation by e-mail shortly.

	<p><b>Note: to prevent misue, sending the actual email is disabled, so please don't wait for the mail ;-)</b></p>

	{web::put "<a href=\"[web::cmdurl default]\">Order more</a>"}
	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