V.7 Control Structure

Control structures let you say "run this fragment of code if X is true" or "do this a few times" or "do this until something is no longer true". The available control structures in Tcl may be grouped into the following categories:

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

 

The Fundamental Conditional Command: if

The most basic Tcl control structure is the 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
}

In the ArsDigita Community System, we always leave out the "then", but if we include an else or elseif clause, we put in those optional words. Consistency is the hobgoblin of little minds...

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 http://software.arsdigita.com/www/register/user-login.tcl. At this point in the ArsDigita Community System flow, 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 {[parameter::get -parameter AllowPersistentLoginP -default 1]} {
    # publisher has elected to provide an option to issue
    # a persistent cookie with user_id and crypted password
    if {[parameter::get -parameter PersistentLoginDefaultP -default 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 {[parameter::get ...]} {
    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.

 

Another Conditional Command: switch

The switch dispatches on the value of its first argument: particular variable as follows:

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

If http://software.arsdigita.com/www/register/user-login.tcl 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.

More: http://www.tcl.tk/man/tcl8.4/TclCmd/switch.htm

 

Looping commands while, foreach, and for

The 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: 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 http://software.arsdigita.com/www/monitor.tcl, 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 "
        
        "]"
}
      
      

The program http://sofware.arsdigita.com/www/admin/static/link-check.tcl checks every HTML file in an ArsDigita Community System 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: 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 use this control structure in the winner picking admin page of the ArsDigita Comunity System's contest module: http://software.arsdigita.com/www/admin/contest/pick-winners.tcl. 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: 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 http://www.webho.com/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 the entire http://software.arsdigita.com/tcl/ad-monitor.tcl, which implements a central facility for other sections in the ArsDigita Community System. 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 [parameter::get -parameter NReasonablePostings -default 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 http://software.arsdigita.com/tcl/ad-security.tcl:

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

---

based on Tcl for Web Nerds