$Header: /cvsroot/aolserver/aolserver.com/docs/devel/tcl/tcl-examples.html,v 1.1 2002/03/07 19:15:35 kriston Exp $
Example 1: hello The following example script implements a simple request procedure which returns 'Hello World'. # Example 1: Hello World # # This simple operation just returns a plain text message. # # Things to notice: # # * ns_register_proc takes as arguments: # * the HTTP method # * the URL that the procedure handles # * the procedure that is executed # # * ns_return takes as arguments: # * the passed in connection # * a return status, in this case 200 for success # * a MIME type # * the actual string to return # # * ns_return properly formats the HTTP response for you. ns_register_proc GET /example/hello hello proc hello {conn context} { ns_return $conn 200 text/plain "Hello World"} Example 2: showhdrs The following example script shows how to access the HTTP headers sent by the client within a Tcl script. # Example 2: Show header data # # Things to notice: # # * The same function is registered for two different URLs # with different context. # # * The headers are pulled out of the conn using the # ns_conn function. # # * The value for a particular header line is extracted # with "ns_set iget", the case insensitive counterpart to # "ns_set get". ns_register_proc GET /example/showbrowser showheader USER-AGENT ns_register_proc GET /example/showrefer showheader REFERER proc showheader {conn key} { set value [ns_set iget [ns_conn headers $conn] $key] ns_return $conn 200 text/plain "$key: $value" } Example 3a: genstory The following example script provides two request procedures. The first procedure returns an HTML page for collecting a few fields of data from the user. The second procedure utilizes the data to generate a short story. # Example 3a: Form generation and handling # # Two functions are registered. One generates and # returns an HTML form, and the other processes # the data in the form. # # Things to notice: # # * Different functions are registered to the same # URL with different methods. Note that some browsers # do not cache results properly when you do this. # # * The genstory function returns an error status # (500) if the client doesn't pass in any form data. # # * Form data is stored in an ns_set, and accessed # like any other set (e.g., header data). # # * A counter is used to loop through all the key # value pairs in the form. ns_register_proc GET /example/genstory genstoryform ns_register_proc POST /example/genstory genstory proc genstoryform {conn context} { ns_return $conn 200 text/html \ "<HTML> <HEAD> <TITLE>Automatic Story Generator</TITLE> </HEAD> <BODY> <H1> Automatic Story Generator </H1> <FORM ACTION=http:/example/genstory METHOD=POST> Noun: <INPUT TYPE=text NAME=noun1><BR> Noun: <INPUT TYPE=text NAME=noun2><BR> Name: <INPUT TYPE=text NAME=name1><BR> Name: <INPUT TYPE=text NAME=name2><BR> Adjective: <INPUT TYPE=text NAME=adjective1><BR> Adjective: <INPUT TYPE=text NAME=adjective2><BR> Verb: <INPUT TYPE=text NAME=verb1><BR> Verb: <INPUT TYPE=text NAME=verb2><BR> <P><INPUT TYPE=submit VALUE=\"Generate\"> </FORM> <P> </BODY></HTML> "} proc genstory {conn ignore} { set formdata [ns_conn form $conn] if {$formdata == ""} { ns_return $conn 200 text/plain "Need form data!" return } # Build up a human-readable representation of the form data. set hrformdata "<dl>" set size [ns_set size $formdata] for {set i 0} {$i < $size} {incr i} { append hrformdata "<dt>[ns_set key $formdata $i]</dt>\ <dd>[ns_set value $formdata $i]</dd>" } append hrformdata "</dl>" ns_return $conn 200 text/html \ "<HTML> <HEAD> <TITLE>The story of [ns_set get $formdata name1] and [ns_set get $formdata name2]</TITLE> </HEAD> <BODY> <H1> The story of [ns_set get $formdata name1] and [ns_set get $formdata name2] </H1> <P>Once upon a time [ns_set get $formdata name1] and [ns_set get $formdata name2] went for a walk in the woods looking for a [ns_set get $formdata noun1]. [ns_set get $formdata name1] was feeling [ns_set get $formdata adjective1] because [ns_set get $formdata name2] was so [ns_set get $formdata adjective2]. So [ns_set get $formdata name1] decided to [ns_set get $formdata verb1] [ns_set get $formdata name2] with a [ns_set get $formdata noun2]. This made [ns_set get $formdata name2] [ns_set get $formdata verb2] [ns_set get $formdata name1]. <P><CENTER>The End</CENTER> The form data that made this possible:<BR> $hrformdata </BODY></HTML>" } Example 3b: pagetcl/genstory The following example script implements the same story generating function of genstory (the previous example) but is implemented as a page Tcl script instead of a library Tcl script. Note that the associated HTML file (genstory.htm) is also included after the Tcl script. # Example 3b: Form generation and handling # # This operation generates a story based on the # form data submitted from the form genstory.htm. # # Things to notice: # # * This file should be stored with the HTML pages # of the server. When a client requests the URL corresponding # to the file, the AOLserver sets the "conn" variable and # evaluates the Tcl. # # * An error status (500) is returned if the client doesn't # doesn't pass in any form data. # # * Form data is stored in an ns_set, and accessed # like any other set (e.g., header data). # # * A counter is used to loop through all the key # value pairs in the form. set formdata [ns_conn form $conn] if {$formdata == ""} { ns_return $conn 200 text/plain "Need form data!" return } # Build up a human-readable representation of the form data. set hrformdata "<dl>" set size [ns_set size $formdata] for {set i 0} {$i < $size} {incr i} { append hrformdata "<dt>[ns_set key $formdata $i]</dt>\ <dd>[ns_set value $formdata $i]</dd>" } append hrformdata "</dl>" ns_return $conn 200 text/html \ "<HTML> <HEAD> <TITLE>The story of [ns_set get $formdata name1] and [ns_set get $formdata name2]</TITLE> </HEAD> <BODY> <H1> The story of [ns_set get $formdata name1] and [ns_set get $formdata name2] </H1> <P>Once upon a time [ns_set get $formdata name1] and [ns_set get $formdata name2] went for a walk in the woods looking for a [ns_set get $formdata noun1]. [ns_set get $formdata name1] was feeling [ns_set get $formdata adjective1] because [ns_set get $formdata name2] was so [ns_set get $formdata adjective2]. So [ns_set get $formdata name1] decided to [ns_set get $formdata verb1] [ns_set get $formdata name2] with a [ns_set get $formdata noun2]. This made [ns_set get $formdata name2] [ns_set get $formdata verb2] [ns_set get $formdata name1]. <P><CENTER>The End</CENTER> The form data that made this possible:<BR> $hrformdata </BODY></HTML>" Here's the associated HTML file: <HTML> <HEAD> <TITLE>Automatic Story Generator</TITLE> </HEAD> <BODY> <H1> Automatic Story Generator </H1> <FORM ACTION=genstory.tcl METHOD=POST> Noun: <INPUT TYPE=text NAME=noun1><BR> Noun: <INPUT TYPE=text NAME=noun2><BR> Name: <INPUT TYPE=text NAME=name1><BR> Name: <INPUT TYPE=text NAME=name2><BR> Adjective: <INPUT TYPE=text NAME=adjective1><BR> Adjective: <INPUT TYPE=text NAME=adjective2><BR> Verb: <INPUT TYPE=text NAME=verb1><BR> Verb: <INPUT TYPE=text NAME=verb2><BR> <P><INPUT TYPE=submit VALUE="Generate"> </FORM> <P> </BODY></HTML> Example 4: redirect The following example script shows how to use an AOLserver simple response command (in this case, ns_returnredirect) and the equivalent code when sending raw data to the client. # Example 4: Implementing redirects with ns_respond and # ns_write # # /example/not_here uses ns_respond to return an HTTP # redirect to /example/finaldest. # /example/not_here2 does the same thing using ns_write # /example/not_here3 does the same thing with # ns_returnredirect # # Things to notice: # # * When you use ns_write, you need to compose the # entire response. # # * "ns_conn location" returns the http://hostname # part of the URL that you can use to generate # fully qualified URLs. # # * ns_returnredirect is a lot simpler than either # ns_respond or ns_write. ns_register_proc GET /example/finaldest finaldest ns_register_proc GET /example/not_here not_here ns_register_proc GET /example/not_here2 not_here2 ns_register_proc GET /example/not_here3 not_here3 proc not_here {conn ignore} { set headers [ns_set new myheaders] ns_set put $headers Location \ [ns_conn location $conn]/example/finaldest ns_respond $conn -status 302 -type text/plain \ -string "Redirection" -headers $headers } proc not_here2 {conn context} { set content \ "<HTML><HEAD><TITLE>Redirection</TITLE></HEAD><BODY> <H1>Redirection</H1>The actual location of what you were looking for is <A HREF=\"[ns_conn location $conn]/example/finaldest\"> here.</A> </BODY></HTML>" ns_write $conn \ "HTTP/1.0 302 Document follows MIME-Version: 1.0 Content-Type: text/html Content-Length: [string length $content] Location: [ns_conn location $conn]/example/finaldest $content" } proc finaldest {conn context} { ns_return $conn 200 text/plain \ "You have arrived at the final destination." } proc not_here3 {conn context} { ns_returnredirect $conn \ [ns_conn location $conn]/example/finaldest } Example 5: desctable The following example script provides a request procedure which describes the columns of a database table using the AOLserver "ns_tableinfo" command . # Example 5: Describing a database table # # /example/describetable prints out a column-by-column # description of a database table. The database # pool name and table name are specified at the end # of the URL -- e.g., # # /example/describetable/nsdbpool/ns_users # # Note: You must have the ns_db module loaded into your virtual # server for this example to work. # # Things to notice: # # * ns_returnbadrequest returns a nicely formatted message # telling the client they submitted an invalid request. # # * "ns_conn urlv" returns a Tcl array whose elements are the # slash-delimited parts of the URL. # # * The describetable function loops through all the columns # and uses "ns_column valuebyindex" to get the type of each # one. # # * ns_returnnotice nicely formats the return value. ns_register_proc GET /example/describetable describetable proc describetable {conn ignore} { if {[ns_conn urlc $conn] != 4} { return [ns_returnbadrequest $conn \ "Missing table name and/or poolname"] } set pool [lindex [ns_conn urlv $conn] 2] if {[lsearch $pool [ns_db pools]] == -1} { return [ns_returnbadrequest $conn \ "Pool $pool does not exist"] } set db [ns_db gethandle $pool] set table [lindex [ns_conn urlv $conn] 3] set tinfo [ns_table info $db $table] if {$tinfo == ""} { return [ns_returnbadrequest $conn \ "Table $table does not exist"] } set output "<dl>" set size [ns_column count $tinfo] for {set i 0} {$i < $size} {incr i} { append output "<dt>[ns_column name $tinfo $i] \ <dd>[ns_column typebyindex $tinfo $i]</dd>" } append output "</dl><hr>" ns_returnnotice $conn 200 "Table $table in pool $pool" $output } Example 6: getemps The following example script shows how to query a table in the database. # Example 6: Getting data from the database # # /example/getemps queries a database in the default # pool and returns a list of all the employees listed # in the employees table. It assumes a table called # employees exists with the column emp_name. You can # use the /NS/Db/Admin to create the table. # # Note: You must have the ns_db module loaded into your virtual # server for this example to work. # # Things to notice: # # * Use "ns_db gethandle" to get a handle for the database # from the default database pool of the virtual server. # # * Use "ns_db select" to query the database and # "ns_db getrow" to retrieve data. # # * Rows are returned as ns_sets. # ns_register_proc GET /example/getemps getemps proc getemps {conn context} { set ul "<UL>" set db [ns_db gethandle [ns_config [ns_dbconfigpath] "DefaultPool"]] set row [ns_db select $db \ "select emp_name from employees order by emp_name;"] while { [ns_db getrow $db $row] } { append ul "<LI>[ns_set get $row emp_name] \n" } append ul "</UL>" ns_returnnotice $conn 200 "Employee list" $ul } Example 7: wincgi The following example script is a simple emulation of the WebSite WinCGI interface. # # Example 7: simple emulation of the WebSite WinCGI interface # # This Tcl script emulates the WinCGI interface of the WebSite server. # To use, move this file to your Tcl library directory (normally the # modules/tcl directory of the AOLserver directory), set the # following nsd.ini variables in the [ns\server\<server-name>\wincgi] # section, and restart the server. # # key default description # --- ------- ----------- # prefix /cgi-win URL prefix for WinCGI. # debug off Set to on to keep temp files for debugging. # gmtoff 0 Minutes West of GMT for the "GMT Offset" variable. # dir c:\wincgi Directory of WinCGI programs. # # # Note: This script is unsupported and not a complete emulation of the # WebSite WinCGI interface. In particular, not all the WinCGI variables # are set. Full support for WinCGI will be incorporated into the nscgi # module in a future AOLserver release. # # # Fetch the variables from the configuration file. # global WinCGI set WinCGI(section) "ns\\server\\[ns_info server]\\wincgi" if {[set WinCGI(prefix) [ns_config $WinCGI(section) prefix]] == ""} { set WinCGI(prefix) /cgi-win } if {[set WinCGI(dir) [ns_config $WinCGI(section) dir]] == ""} { set WinCGI(dir) [ns_info home]/$WinCGI(prefix) } if {[set WinCGI(gmtoff) [ns_config $WinCGI(section) gmtoff]] == ""} { set WinCGI(gmtoff) 0 } if {[set WinCGI(debug) [ns_config -bool $WinCGI(section) debug]] == ""} { set WinCGI(debug) 0 } # # Register the win-cgi procedure to handle requests for WinCGI executables. # ns_register_proc POST $WinCGI(prefix)/*.exe win-cgi ns_register_proc GET $WinCGI(prefix)/*.exe win-cgi # # win-cgi - The Tcl request procedure which emulates WinCGI. # proc win-cgi {conn ignored} { global WinCGI # The program is the second part of the WinCGI URL. set args [join [split [ns_conn query $conn] &]] set pgm [lindex [ns_conn urlv $conn] 1] regsub -all {\+} $args " " args foreach e [split $WinCGI(dir)/$pgm /] { if {$e != ""} {lappend exec $e} } set exec [join $exec \\] if ![file executable $exec] { return [ns_returnnotfound $conn] } # WinCGI requires a few temporary files. set ini [ns_tmpnam] set inp [ns_tmpnam] set out [ns_tmpnam] # Copy the request content to the input file. set fp [open $inp w] ns_writecontent $conn $fp set len [tell $fp] close $fp # Create the WinCGI variables .ini file. set fp [open $ini w] puts $fp {[CGI]} puts $fp \ "Request Protocol=HTTP/1.0 Request Method=[ns_conn method $conn] Executable Path=$WinCGI(prefix)/$pgm Server Software=[ns_info name]/[ns_info version] Server Name=[ns_info name] Server Port=[ns_info version] Server Admin=[ns_config AOLserver WebMaster] CGI Version=CGI/1.2 (Win) Remote Address=[ns_conn peeraddr $conn] Authentication Method=Basic Authentication Realm=[ns_conn location $conn] Content Type=application/x-www-form-urlencoded Content Length=$len" puts $fp "" puts $fp {[System]} puts $fp \ "GMT Offset=$WinCGI(gmtoff) Debug Mode=Yes Output File=$out Content File=$inp" # Set any POST or query form variables. puts $fp "" puts $fp {[Form Literal]} set form [ns_conn form $conn] if {$form != ""} { for {set i 0} {$i < [ns_set size $form]} {incr i} { set key [ns_set key $form $i] set value [ns_set value $form $i] puts $fp "$key=$value" } } # Set the accept headers and accumulate the extra headers. puts $fp "" puts $fp {[Accept]} set headers [ns_conn headers $conn] set extras "" for {set i 0} {$i < [ns_set size $headers]} {incr i} { set key [ns_set key $headers $i] set ukey [string toupper $key] set value [ns_set value $headers $i] if {$ukey == "ACCEPT"} { puts $fp "$value=Yes" } elseif {$key != "CONTENT-LENGTH" && $key != "CONTENT-TYPE"} { append extras "$key=$value\n" } } puts $fp "" puts $fp {[Extra Headers]} puts $fp $extras close $fp # Execute the WinCGI program. # NB: "catch" the exec and open because a WinCGI # program can be misbehaved, returning a non-zero # exit status or not creating the output file. catch {exec "$exec $ini $inp $out $args"} if [catch {set fp [open $out]}] { ns_returnerror $conn 500 "WinCGI exec failed" } else { set type text/html set status 200 while {[gets $fp line] > 0} { set line [string trim $line] if {$line == ""} break set head [split $line :] set key [string tolower [string trim [lindex $head 0]]] set value [string trim [lindex $head 1]] if {$key == "content-type"} { set type $value } elseif {$key == "location"} { set location $value } elseif {$key == "status"} { set status $status } } set page [read $fp] close $fp if [info exists location] { ns_returnredirect $conn $location } else { ns_return $conn $status $type $page } } if $WinCGI(debug) { ns_log Notice "CGI $pgm: ini: $ini, inp: $inp, out: $out" } else { ns_unlink -nocomplain $ini ns_unlink -nocomplain $inp ns_unlink -nocomplain $out } }