Posted to tcl by colin at Thu May 06 05:18:49 GMT 2010view pretty
# hello-direct - a hello world example of a Direct domain namespace eval ::Hello { proc / {r args} { # this is the default set content { <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> <html> <head> <title>Hello World</title> </head> <body> <h1>Hello World</h1> <ul> <li><a href='text'>Plain Text</a></li> <li><a href='html'>Html Fragment</a></li> <li><a href='error'>Intentional Error</a></li> <li><a href='redirect'>Redirection</a></li> <li><a href='form'>Form sample</a></li> <li><a href='show'>Display arguments passed in.</a></li> </body> </html> } return [Http Ok $r $content text/html] } proc /text {r args} { # [Http Ok] can return other mime types: # Here, text/plain can be used to return just the literal text set content { <p>Hello World</p> } return [Http Ok $r $content text/plain] } proc /html {r args} { # Here, content is returned as an x-text/html-fragment # which is wrapped and filled in by the Convert module # to present an HTML page to the client set content { <p>Hello World</p> } return [Http Ok $r $content x-text/html-fragment] } proc /html2 {r args} { } proc /show {r args} { # Here we display the args passed from the client # we use the utilities from [Html] to construct the page append content [<p> "Form Submission Result"] set vartable "" foreach {n v} $args { append vartable [<tr> "[<td> $n] [<td> $v]"] } append content [<table> $vartable] return [Http Ok $r $content] ;# we default mime type } proc /form {r args} { # here we will display whatever args are passed in. # we also use the [Form] utility to construct the page dict with args { set content [<form> xxx action show { [<p> "This is a form to enter your account details"] [<fieldset> details vertical 1 title "Account Details" { [<legend> "Account Details"] [<text> user label "User name" title "Your preferred username (only letters, numbers and spaces)"] [<text> email label "Email Address" title "Your email address" moop] [<hidden> hidden moop] }] [<fieldset> passwords maxlength 16 size 16 { [<legend> "Passwords"] [<p> "Type in your preferred password, twice. Leaving it blank will generate a random password for you."] [<password> password] [<password> repeat] }] [<radioset> illness legend "Personal illnesses" { +none 0 lameness 1 haltness 2 blindness 2 }] [<checkset> illness vertical 1 legend "Personal illnesses" { +none 0 lameness 1 haltness 2 blindness 2 }] [<select> selname legend "Shoe Size" title "Security dictates that we know your approximate shoe size" { [<option> value moop1 label moop1 value 1 "Petit"] [<option> label moop2 value moop2 value 2 "Massive"] }] [<fieldset> personal tabular 1 legend "Personal Information" { [<text> fullname label "full name" title "Full name to be used in email."] [<text> phone label phone title "Phone number for official contact"] }] [<p> "When you create the account instructions will be emailed to you. Make sure your email address is correct."] [<textarea> te compact 1 { This is some default text to be getting on with It's fairly cool. Note how it's left aligned. }] <br>[<submit> submit "Create New Account"] [<br>] [<fieldset> permissions -legend Permissions { [<fieldset> gpermF style "float:left" title "Group Permissions." { [<legend> Group] [<checkbox> gperms title "Can group members read this page?" value 1 checked 1 read] [<checkbox> gperms title "Can group members modify this page?" value 2 checked 1 modify] [<checkbox> gperms title "Can group members add to this page?" value 4 checked 1 add] [<br>][<text> group title "Which group owns this page?" label "Group: "] }] [<fieldset> opermF style "float:left" title "Default Permissions." { [<legend> Anyone] [<checkbox> operms title "Can anyone read this page?" value 1 checked 1 read] [<checkbox> operms title "Can anyone modify this page?" value 2 modify] [<checkbox> operms title "Can anyone add to this page?" value 4 add] }] }] [<br>] [<div> class buttons [subst { [<submit> class positive { [<img> src /images/icons/tick.png alt ""] Save }] [<a> href /password/reset/ [subst { [<img> src /images/icons/textfield_key.png alt ""] Change Password }]] [<a> href "#" class negative [subst { [<img> src /images/icons/cross.png alt ""] Cancel }]] }]] }] } return [Http Ok $r $content x-text/html-fragment] } proc /error {r args} { # errors are caught and presented to the client error "This is an intentional error." } proc /redirect {r args} { # You can redirect URLs using the facilities of the Http utility return [Http Moved $r hello] ;# this redirects you to /hello } # Nub will call this with args presented to the Nub proc new {args} { # we do nothing with the args } namespace export -clear * namespace ensemble create -subcommands {} } # this Nub inserts the Hello namespace into the URL space at /hello/ Nub domain /hello/ Direct namespace ::Hello