if
if
command:
if boolean ?then? body1 ?else? ?body2?
Note that the words "then" and "else" are optional, as is the entire
else clause. The most basic if
statement looks like
this:
if {condition} {
body
}
where condition is an expression (see http://www.tcl.tk/man/tcl8.4/TclCmd/expr.htm) that evaluates to true or
false, typically represented in Tcl by 1 or 0. Here are concrete
examples:
if { $last_visit != "" } {
# this is a return visitor
append page "welcome back"
}
if { $state == "California" && $city == "Pico Rivera" && $status == "taxable" } {
# order being shipped to Pico Rivera, California
# AND (note use of logical operator "&&") item is taxable
append page "We have to charge you the nation's highest sales tax rate, 9.75 percent"
}
if { $status == "subscriber" || $referred_by_google_news } {
# the requestor is a subscriber OR was directed here by Google News
# so bypass the paywall by setting "apply_paywall" to false
set apply_paywall 0
}
It is conventional to leave out the "then", but if else
or elseif
clauses are included, to use "else" and "elseif":
if {condition} {
body
} elseif {other_condition} {
alternate_body
} else {
another_body
}
Note how the curly braces and keywords are artfully positioned so that
the entire if
statement is on one line as far as the
interpreter is concerned, i.e., all the newlines are grouped within
curly braces. An easy way to break your program is to rewrite the
above statement as follows:
if {condition} {
body
}
elseif {other_condition} {
alternate_body
} else {
another_body
}
The Tcl interpreter will think that the if
statement has
ended after the first body and will next try to evaluate "elseif" as a
procedure.
Let's look at an example from a user login page, at a point in the flow where a user has already typed his or her email address.
# Get the user ID
set selection [ns_db 0or1row $db "select user_id, user_state,
converted_p
from users
where upper(email)=upper('$QQemail')"]
if {$selection == ""} {
# Oracle didn't find a row; this email addres is not in the database
# redirect this person to the new user registration page
ns_returnredirect "user-new.tcl?[export_url_vars return_url email]"
return
}
The same page provides an example both of nested if
and
if then else
:
if [ad_parameter AllowPersistentLoginP "" 1] {
# publisher has elected to provide an option to issue
# a persistent cookie with user_id and crypted password
if [ad_parameter PersistentLoginDefaultP "" 1] {
# persistent cookie shoudl be the default
set checked_option "CHECKED"
} else {
set checked_option ""
}
ns_write "<input type=checkbox name=persistent_cookie_p value=t $checked_option>
Remember this address and password?
(<a href=\"explain-persistent-cookies.adp\">help</a>)"
}
Notice that the conventional programming style in Tcl is to call
if
for effect rather than value. It would work just as
well to write the inner if
in a more Lisp-y style:
set checked_option [if [ad_parameter ...] {
subst "CHECKED"
} else {
subst ""
}]
This works because if
returns the value of the last
expression evaluated. However, being correct and being comprehensible
to the community of Tcl programmers are different things. It is best
to write code adhering to indentation and other stylistic
conventions. You don't want to be the only person in the world
capable of maintaining a service that has to be up 24x7.
switch
switch
dispatches on the value of its first argument:
particular variable as follows:
switch flags value {
pattern1 body1
pattern2 body2
...
}
If the user login page finds a user in the database, it uses a
switch
on the user's state to decide what to do next:
switch $user_state {
"authorized" { # just move on }
"banned" {
ns_returnredirect "banned-user.tcl?user_id=$user_id"
return
}
"deleted" {
ns_returnredirect "deleted-user.tcl?user_id=$user_id"
return
}
"need_email_verification_and_admin_approv" {
ns_returnredirect "awaiting-email-verification.tcl?user_id=$user_id"
return
}
"need_admin_approv" {
ns_returnredirect "awaiting-approval.tcl?user_id=$user_id"
return
}
"need_email_verification" {
ns_returnredirect "awaiting-email-verification.tcl?user_id=$user_id"
return
}
"rejected" {
ns_returnredirect "awaiting-approval.tcl?user_id=$user_id"
return
}
default {
ns_log Warning "Problem with registration state machine on user-login.tcl"
ad_return_error "Problem with login" "There was a problem authenticating the account: $user_id. Most likely, the database contains users with no user_state."
return
}
}
In this case, we're using the standard switch
behavior of
matching strings exactly. We're also provide a "default" keyword at
the end that indicates some code to run if nothing else matched.
It is possible to use more sophisticated patterns in
switch
. Here's a fragment that sends different email
depending on the pattern of the address:
switch -glob $email {
{*mit.edu} { ns_sendmail $email $from $subject $body }
{*cmu.edu} { ns_sendmail $email $from $subject "$body\n\nP.S. Consider applying to MIT. Boston is much nicer than Pittsburgh"}
{*harvard.edu} { ns_sendmail $email $from $subject "$body\n\nP.S. Please ask your parents to invest in our tech startup."}
}
The third behavior for switch
is invoked using the
"-regexp" flag. See the pattern
matching chapter for more on how these patterns work.
while
,
foreach
, and for
while
command in Tcl operates as follows:
while { conditional_statement } {
loop_body_statements
}
The conditional statement is evaluated; if it
is true, the loop body statement is executed, and then the conditional
statement is reevaluated and the process repeats. If the conditional
statement is ever false, the interpreter does not execute the loop
body statements, and continues to the next line after the conditional.
Here is a while
statement used to display the last name,
first name of each MIT nerd using a Web service. The conditional
is the result of calling AOLserver's
ns_db getrow
API procedure. This procedure returns 1 if
it can fetch the next row from the SQL cursor, 0 if there aren't any
more rows to fetch.
set selection [ns_db select $db "select first_names, last_name
from users
where lower(email) like '%mit.edu'"]
while { [ns_db getrow $db $selection] } {
# set local variables to the SQL column names
set_variables_after_query
ns_write "<LI>$last_name, $first_names"
}
More: see http://www.tcl.tk/man/tcl8.4/TclCmd/while.htm
The Tcl foreach
command loops through the elements of a
list, setting a loop variable to each element in term:
foreach variable_name list {
body
}
Here's an example from a page that displays current server activity:
# ask AOLserver to return a list of lists, one for each current connection
set connections [ns_server active]
foreach connection $connections {
# separate the sublist elements with "" tags
ns_write $conn " [join $connection " "]"
}
Suppose that we want a link checking program to go through every HTML
file on a server and look for dead links. Here's a helper procedure
that works on one file:
proc check_file {f} {
# alert the administrator that we're working on this file
ns_write "<li>$f\n<ul>\n"
# read the contents into $content
set stream [open $f]
set content [read $stream]
close $stream
# loop through each reference, relying on API call ns_hrefs
# to parse the HTML and tell us where this file points
foreach url [ns_hrefs $content] {
# do all the hard work
...
}
ns_write "</ul>\n"
}
Notice how easy this procedure was to write thanks to the AOLserver
developers thoughtfully providing us with ns_hrefs
, which
takes an HTML string and returns a list of every HREF target.
More: see http://www.tcl.tk/man/tcl8.4/TclCmd/foreach.htm
The last looping command, for
, is good for traditional
"for i from 1 to 10" kind of iteration. Here's the syntax:
for start test next body
We used this to pick winners in a contest module.
The input to this page specifies a time period, a contest, and how
many winners are to be picked. Here the result of executing the
for
loop is a list of N elements, where N is the number
of desired winners:
for {set i 1} {$i <= $n_winners} {incr i} {
# we'll have winner_numbers between 0 and $n_contestants - 1
# because randomRange returns a random integer between 0
# and its argument
lappend winner_numbers [randomRange $n_contestants]
}
More: see http://www.tcl.tk/man/tcl8.4/TclCmd/for.htm
Error-handling command: catch
If a Tcl command throws an error in a CGI script or an AOLserver API
page, by default the user will be presented with an error page. If
you don't want that to happen, fix your bugs! Sometimes it isn't
possible to fix your bugs. For example, the ns_httpget
API procedure fetches a Web page from the wider Internet. Under
certain network-dependent conditions, it may throw an error. If you
don't want your users to be exposed to that as an error, put in a
catch:
catch script ?variable_name?
catch
returns 1 if script
threw an error, 0
otherwise. If you supply the second argument
(variable_name
), catch
will set that
variable to the result of executing script
, whether or
not the script threw an error.
Our classic example always involves ns_httpget. Here's one from
/WealthClock:
# define a procedure that computes the entire page
proc wealth_ReturnWholePage {} {
# do a couple of ns_httpgets and some arithmetic
# to produce the user-visible HTML
...
}
# this is the procedure registered to http://www.webho.com/WealthClock
proc wealth_Top {ignore} {
if [catch {set moby_string [Memoize wealth_ReturnWholePage]} errmsg] {
# something went wrong with our sources
... return an apology message to the users
} else {
# we computed the result (or Memoize got it from the cache)
ns_return 200 text/html $moby_string
}
}
Sending email is another time that a Web server has to go outside its
carefully controlled world and might experience an error. Here is a
central "email someone for help" facility for all of the software on a
Web server. The idea is that programmers can put in "email the
administrator if broken" instructions on pages that won't result in a
nightmare for the administrator if the page is getting hit every few
seconds.
# the overall goal here is that the ad_host_administrator gets
# notified if something is horribly wrong, but not more than once
# every 15 minutes
# we store the last [ns_time] (seconds since 1970) notification time
# in ad_host_administrator_last_notified
ns_share -init { set ad_host_administrator_last_notified 0 } ad_host_administrator_last_notified
proc ad_notify_host_administrator {subject body {log_p 0}} {
ns_share ad_host_administrator_last_notified
if $log_p {
# usually the error will be in the error log anyway
ns_log Notice "ad_notify_host_administrator: $subject\n\n$body\n\n"
}
if { [ns_time] > [expr $ad_host_administrator_last_notified + 900] } {
# more than 15 minutes have elapsed since last note
set ad_notify_host_administrator [ns_time]
if [catch { ns_sendmail [ad_host_administrator] [ad_system_owner] $subject $body } errmsg] {
ns_log Error "failed sending email note to [ad_host_administrator]"
}
}
}
Make sure that you don't overuse catch. The last thing that you want
is a page failing silently. Genuine errors should always be brought
to a user's attention and ideally to the site administrator's. Users
should not think that a server has done something on their behalf when
in fact the task was not accomplished.
More: http://www.tcl.tk/man/tcl8.4/TclCmd/catch.htm
Miscellaneous commands: break
,
continue
, return
, and error
When inside a looping command, it is sometimes desirable to get the
command to stop looping or to stop executing the current iteration but
to continue on the next one. The break
command is
used to permanently escape the loop; the continue
command is used to escape the current iteration of the loop but to
start again at the next iteration. The syntax for each consists only
of the appropriate word written on a line by itself within a loop.
We often use the break
command when we want to limit the
number of rows to display from the database. Here's an example from
the photo.net neighbor-to-neighbor system. By default, we only want
to show a "reasonable" number of postings on one page:
set selection [ns_db select $db ... big SQL query ... ]
set list_items ""
# see what the publisher thinks is a reasonable number (default to 100)
set n_reasonable [ad_parameter NReasonablePostings neighbor 100]
# initialize a counter of the number of rows displayed so far
set counter 0
while {[ns_db getrow $db $selection]} {
set_variables_after_query
incr counter
if { $counter > $n_reasonable) } {
# append ellipses
append list_items "<p>\n..."
# flush the database cursor (tell Oracle that we don't need the
# rest of the rows)
ns_db flush $db
# break out of the loop
break
}
append list_items "<li><a href=\"view-one.tcl ..."
}
More: http://www.tcl.tk/man/tcl8.4/TclCmd/break.htm
The return
command has been shown before. It
quits the proc it's in and returns the supplied value. Remember that
any procedure lines after return
aren't executed. Too
many times we've seen code of the following form:
proc a_new_programmers_proc {} {
set db [ns_db gethandle]
# do a bunch of stuff with the database
return $result
# release the database handle
ns_db releasehandle $db
}
The most interesting thing that you can do with return is write
procedures that force their callers to return as well. Here's an
example from a program that requires user registration for certain
pages:
proc ad_maybe_redirect_for_registration {} {
if { [ad_verify_and_get_user_id] != 0 } {
# user is in fact logged in, return happiness
return
} else {
ns_returnredirect "/register/index.tcl?return_url=[ns_urlencode [ns_conn url]$url_args]"
# blow out of 2 levels
return -code return
}
}
A .tcl page can simply call this in-line
ad_maybe_redirect_for_registration
# the code below will never get executed if the user isn't registered
# ... update the database or whatever ...
More: http://www.tcl.tk/man/tcl8.4/TclCmd/return.htm
The error
command returns from a proc and and raises an
error that, if not caught by a catch
statement, will
result in the user seeing a server error page. The first argument to
error
is displayed in the debugging backtrace:
proc divide {x y} {
if {$y == 0} {
error "Can't divide by zero."
} else {
return [expr $x / $y]
}
}
More: http://www.tcl.tk/man/tcl8.4/TclCmd/error.htm
Continue on to procedures.
Return to Table of Contents
lsandon@alum.mit.edu
Add a comment | Add a link