Control Structure

• conditional
• looping (iteration)
• error-handling
• miscellaneous (non-local exit)

The Fundamental Conditional Command: if

if boolean ?then? body1 ?else? ?body2?

if {condition} {
   body
}

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
}

if {condition} {
   body
} elseif {other_condition} {
   alternate_body
} else {
   another_body
}

if {condition} {
   body
} 
elseif {other_condition} {
   alternate_body
} else {
   another_body
}

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
} 

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>)"
}

set checked_option [if [ad_parameter ...] {
    subst "CHECKED" 
} else {
    subst ""
}]

Another Conditional Command: switch

switch flags value {
   pattern1 body1
   pattern2 body2
   ...
}

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
    }
}

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."}
}

Looping commands while, foreach, and for

while { conditional_statement } {
   loop_body_statements
}

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"
}

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
}

# 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 ""]"
}

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"
}

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

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]
}

Error-handling command: catch

catch script ?variable_name?

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

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 ..."

}

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 
}

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
    }
}

ad_maybe_redirect_for_registration 

# the code below will never get executed if the user isn't registered
# ... update the database or whatever ...

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]
   }
}