This is a framework to allow one to easily develop bindings for ''restful web services'' [http://www.networkworld.com/ee/2003/eerest.html]. Below the framework itself are examples of varying completeness that should give one a decent understanding of how to use the framework. **some minimal documentation** a binding consists of definitions of rest calls where each call is an array element. the name of the bindings and the namespace it is created in is taken from the array name. the array keys become the commands. each call definition is in the form of a dict where the keys and values are option names and values. the recognized options and their allowed values are as follows copy: this copies the definition of a previously defined call. this should probably the first element in a definition. after copying you can override selected options by defining them again. unset: removes the named option. useful when using copy. headers: the value must be another dict containing header fields and their values. default is empty. content-type: specify the content type for the request url: kind of self explanatory. the url may contain tokens in the form %name% where name becomes a required argument and the value is substituted into the url at call time. tokens in the form of %name:default_value% will be an optional argument with a default value. method: the method to use on the url. valid values are the normal get/post/put/delete. default is get req_args: a list of the required arguments. names ending in a colon will require a value. opt_args: arguments that may be present but are not required. static_args: arguments that are always the same. no sense in troubling the user with these. auth: currently only accepts the value "basic". if this argument is used you can configure basic auth with the proc auth_basic which takes 2 arguments, the username and password. sign: ? pre_transform: this value takes the form of a proc which should perform some action on $result and return a value. it is run on the result before the output (xml/json/etc) transformation is done. result: may have the value xml, json, raw, or auto. the default is auto and should auto detect [json] or [xml] results and transform them into a tcl list. this is here if you want to specify it explicitly. post_transform: this value takes the form of a proc which should perform some action on $result and return a value. it is run on the result after the output transformation but before returning the value to the calling procedure. check_result: this value should be a list of 2 expressions either of which may be empty. the first expression is checks the OK condition, it must return true when the result is satisfactory. the second expression is the error condition, it must return false unless there is an error. after creating the definitions simple call rest::create_interface on the array. you may also use rest::save to save the created procedures as a standalone module. ---- **Code** package require dict package require http package require json package require tdom package require tls package require base64 ::http::register https 443 [list ::tls::socket] package provide rest 1.0 namespace eval ::rest {} proc ::rest::create_interface {name} { upvar $name in namespace eval ::$name {} foreach call [array names in] { set config $in($call) set proc [list] if {[dict exists $config copy]} { set config [dict merge $in([dict get $config copy]) $config] } if {[dict exists $config unset]} { set config [dict unset $config [dict get $config unset]] } lappend proc "set config \{$config\}" lappend proc "set headers \[list]" lappend proc "set url [dict get $config url]" set opts [list] if {[dict exists $config static_args]} { foreach {k v} [dict get $config static_args] { if {$v != ""} { dict lappend config req_args ${k}: lappend proc "lappend args -$k $v" } else { dict lappend config req_args $k lappend proc "lappend args -$k" } } } if {[dict exists $config headers]} { foreach val [dict values [dict get $config headers]] { foreach {junk x} [regexp -all -inline {%([a-z0-9_-]+)%} $val] { dict lappend config req_args $x: } } } lappend opts [expr {[dict exists $config req_args] ? [dict get $config req_args] : ""}] lappend opts [expr {[dict exists $config opt_args] ? [dict get $config opt_args] : ""}] lappend proc "set parsed \[::rest::_parse_opts \$url $opts \$args]" lappend proc "set url \[lindex \$parsed 0]" lappend proc "set query \[lindex \$parsed 1]" lappend proc "set body \[lindex \$parsed 2]" if {[dict exists $config auth]} { set auth [dict get $config auth] if {$auth == "basic"} { lappend proc "lappend headers Authorization \"Basic \[base64::encode \$\{::${name}::user\}:\$\{::${name}::password\}]\"" } } if {[dict exists $config headers]} { lappend proc "eval lappend headers \[::rest::_headers \{[dict get $config headers]\} query]" } if {[dict exists $config cookie]} { lappend proc "lappend headers Cookie [join [dict get $config cookie] \;]" } if {[dict exists $config sign]} { lappend proc "set query [::${name}::[dict get $config sign] \$query]" } else { lappend proc "set query \[eval ::http::formatQuery \$query]" } lappend proc "set result \[::rest::_call \$headers \$url \$query \$body]" if {[dict exists $config pre_transform]} { lappend proc "set result \[::${name}::_pre_transform_$call \$result]" proc ::${name}::_pre_transform_$call result [dict get $config pre_transform] } if {[dict exists $config result]} { lappend proc "set result \[::rest::_format_[dict get $config result] \$result]" } else { lappend proc "set result \[::rest::_format_auto \$result]" } if {[dict exists $config post_transform]} { lappend proc "set result \[::${name}::_post_transform_$call \$result]" proc ::${name}::_post_transform_$call result [dict get $config post_transform] } if {[dict exists $config check_result]} { lappend proc "::rest::_check_result \$result [dict get $config check_result]" } lappend proc "return \$result" proc ::${name}::$call args [join $proc \n] } proc ::${name}::basic_auth {u p} { variable user $u variable password $p } return $name } proc ::rest::save {name file} { set fh [open $file w] puts $fh {package require dict package require http package require json package require tdom package require tls package require base64 ::http::register https 443 [list ::tls::socket]} puts $fh "namespace eval ::$name \{\}" foreach x {_call _parse_opts _check_result _format_xml _format_json} { puts $fh "proc ::${name}::$x \{[info args $x]\} \{[info body $x]\n\}\n" } foreach x [info commands ::${name}::*] { puts $fh "proc $x \{[info args $x]\} \{[info body $x]\n\}\n" } close $fh } proc ::rest::parameters {url args} { set dict [list] foreach x [split [lindex [split $url ?] 1] &] { set x [split $x =] if {[llength $x] < 2} { lappend x "" } eval lappend dict $x } if {[llength $args] > 0} { return [dict get $dict [lindex $args 0]] } return $dict } proc ::rest::_call {headers url query body} { upvar config config if {$body != ""} { set url $url?$query set query $body } elseif {![dict exists $config method] || [dict get $config method] == "get"} { set url $url?$query } #puts "geturl $url" #return set opts [list] if {[dict exists $config content-type]} { lappend opts -type [dict get $config content-type] } if {[dict exists $config method]} { if {[dict get $config method] == "post"} { lappend opts -query $query } else { lappend opts -method [dict get $config method] } } set t [eval [list http::geturl $url -headers $headers] $opts] if {![string match 2* [http::ncode $t]]} { #parray $t if {[http::ncode $t] == "302"} { upvar #0 $t a return -code error "HTTP 302 [dict get $a(meta) Location]" } return -code error "HTTP [http::ncode $t]" } set data [http::data $t] #parray $t #puts "data: $data" http::cleanup $t return $data } proc ::rest::_parse_opts {url required optional options} { set args $options set query [list] if {[set params [regexp -all -inline {%([a-z0-9_:-]+)%} $url]] != ""} { foreach {junk x} $params { if {[string match *:* $x]} { set x [split $x :] lappend optional [lindex $x 0]: } else { lappend required $x: } } } foreach opt $required { set hasarg 0 if {[string index $opt end] == ":"} { set opt [string range $opt 0 end-1] set hasarg 1 } if {[set i [lsearch -exact $args -$opt]] < 0} { return -code error "the -$opt argument is required" } if {$hasarg} { lappend query $opt [lindex $args [expr {$i+1}]] set args [lreplace $args $i [expr {$i+1}]] } else { lappend query $opt "" set args [lreplace $args $i $i] } } for {set i 0} {$i < [llength $args]} {incr i} { set opt [lindex $args $i] if {![string match -* $opt]} break set opt [string range $opt 1 end] if {[set j [lsearch -exact $optional $opt:]] > -1} { lappend query $opt [lindex $args [expr {$i+1}]] set args [lreplace $args $i [expr {$i+1}]] incr i -1 } elseif {[set j [lsearch -exact $optional $opt]] > -1} { lappend query $opt "" set args [lreplace $args $i $i] } else { return -code error "Unknown option $opt" } } foreach {junk x} $params { if {[string match *:* $x]} { set x [split $x :] if {![dict exists $query [lindex $x 0]]} { eval lappend query $x } } else { set val [dict get $query $x] set query [dict remove $query $x] set url [string map [list %$x% $val] $url] } } puts "url: $url\nquery: $query\nbody: [join $args]" return [list $url $query [join $args]] } proc ::rest::_headers {headers q} { upvar $q query dict for {key val} $headers { foreach {junk x} [regexp -all -inline {%([a-z0-9_-]+)%} $val] { set replace [dict get $query $x] set query [dict remove $query $x] set val [string map [list %$x% $replace] $val] set headers [dict replace $headers $key $val] } } return $headers } proc ::rest::_check_result {result ok err} { if {$err != "" && ![catch {expr $err} out] && [expr {$out}]} { return -code error "Error expression failed or returned true" } if {$ok != "" && ![catch {expr $ok} out] && [expr {$out}]} { return -code ok } return -code error "Ok expression failed or returned false" } proc ::rest::_format_raw {data} { return $data } proc ::rest::_format_auto {data} { if {[string match {<*} [string trimleft $data]]} { return [_format_xml $data] } if {[regexp {":\s*\{} $data]} { return [_format_json $data] } return $data } proc ::rest::_format_json {data} { #if {[regexp -nocase {^[a-z_.]+ *= *(.*)} $data -> json]} { # set data $json #} #puts $data return [json::json2dict $data] } proc ::rest::_format_xml {data} { set d [[dom parse -simple $data] documentElement] return [$d asList] return $data } ---- **bindings for del.icio.us** set delicious(updated) { url https://api.del.icio.us/v1/posts/update auth basic post_transform { regexp { update return [clock scan [string map {T " " Z " UTC"} $update]] } } set delicious(add_post) { url https://api.del.icio.us/v1/posts/add auth basic req_args { url: description: } opt_args { extended: tags: dt: replace: shared: } check_result { {[regexp {done} $result]} {} } } set delicious(rename_tag) { url { https://api.del.icio.us/v1/tags/rename } auth basic req_args { old: new: } check_result { {[regexp {done} $result]} {} } } set delicious(get_bundles) { url { https://api.del.icio.us/v1/bundles/all } auth basic opt_args { bundle: } result xml } set delicious(set_bundle) { url { https://api.del.icio.us/v1/bundles/set } auth basic req_args { bundle: tags: } check_result { {[regexp {ok} $result]} {} } } set delicious(delete_bundle) { url { https://api.del.icio.us/v1/bundles/delete } auth basic req_args { bundle: } check_result { {[regexp {done} $result]} {} } } set delicious(public_posts) { url http://feeds.delicious.com/v2/json/%user% opt_args { count: } pre_transform { regexp {Delicious.posts = (.*)} $result -> json return $json } result json } ---- **bindings for twitter** set twitter(public_timeline) { url http://twitter.com/statuses/public_timeline.json result json } set twitter(friends_timeline) { url http://twitter.com/statuses/friends_timeline.json auth basic opt_args { since: since_id: count: page: } } set twitter(user_timeline) { url http://twitter.com/statuses/user_timeline.json auth basic opt_args { id: since: since_id: count: page: } } set twitter(show_status) { url http://twitter.com/statuses/show/%id%.json auth basic } set twitter(update) { url http://twitter.com/statuses/update.json auth basic method post req_args { status: } opt_args { in_reply_to_status_id: } } set twitter(replies) { url http://twitter.com/statuses/replies.json auth basic opt_args { since: since_id: page: } } set twitter(destroy) { url http://twitter.com/statuses/destroy/%id%.json auth basic method post } set twitter(friends) { url http://twitter.com/statuses/friends.json auth basic opt_args { id: page: lite: since: } } set twitter(followers) { url http://twitter.com/statuses/followers.json auth basic opt_args { id: page: lite: } } set twitter(featured) { url http://twitter.com/statuses/featured.json auth basic } set twitter(show_user) { url http://twitter.com/users/show/%id%.json auth basic opt_args { email: } } ---- **bindings for yahoo boss** (build your own search service) set yboss(web) { url http://boss.yahooapis.com/ysearch/web/v1/%query% req_args { appid: } opt_args { start: count: lang: region: sites: filter: type: } #result json post_transform { return [dict get $result ysearchresponse] } check_result { {[dict get $result responsecode] == "200"} {} } } set yboss(news) { url http://boss.yahooapis.com/ysearch/news/v1/%query% req_args { appid: } opt_args { start: count: lang: region: sites: age: } result json check_result { {[dict $result responsecode] == "200"} {} } } ---- **bindings for google calendar** set gcal(auth) { url https://www.google.com/accounts/ClientLogin method post req_args { Email: Passwd: source: } static_args { service cl } post_transform { regexp {Auth=(.*)} $result -> result return $result } } set gcal(all_calendars) { url http://www.google.com/calendar/feeds/default/allcalendars/full headers { Authorization {GoogleLogin auth=%token%} } opt_args { gsessionid: } } set gcal(own_calendars) { url http://www.google.com/calendar/feeds/default/owncalendars/full headers { Authorization {GoogleLogin auth=%token%} } opt_args { gsessionid: } } set gcal(new_calendar) { url http://www.google.com/calendar/feeds/default/owncalendars/full method post content-type application/atom+xml headers { Authorization {GoogleLogin auth=%token%} } opt_args { gsessionid: } } set gcal(edit_calendar) { url http://www.google.com/calendar/feeds/default/owncalendars/full/%calendar% method put content-type application/atom+xml headers { Authorization {GoogleLogin auth=%token%} } opt_args { gsessionid: } } set gcal(delete_calendar) { url http://www.google.com/calendar/feeds/default/owncalendars/full/%calendar% method delete headers { Authorization {GoogleLogin auth=%token%} } opt_args { gsessionid: } } set gcal(all_events) { url http://www.google.com/calendar/feeds/%user:default%/%calendar%/%visibility:private%/full headers { Authorization {GoogleLogin auth=%token%} } opt_args { gsessionid: } } set gcal(new_event) { url http://www.google.com/calendar/feeds/default/private/full method post content-type application/atom+xml headers { Authorization {GoogleLogin auth=%token%} } opt_args { gsessionid: } } proc ::gcal::handle_redir {args} { if {[catch {eval $args} out]} { if {[lindex $out 1] == "302"} { puts $out eval [linsert $args 1 -gsessionid [rest::parameters [lindex $out 2] gsessionid]] } else { return -code error $out } } } ---- ***Usage Examples*** set auth [gcal::auth -Email user@gmail.com -Passwd password -source tcl] puts [gcal::handle_redir gcal::all_events -token $auth -calendar] puts [delicious::get_posts -url http://wiki.tcl.tk/] delicious::basic_auth user password puts [delicious::add_post -url http://wiki.tcl.tk -description "the tclers wiki"] twitter::auth user password puts [twitter::user_timeline] set appid X set data [yboss::web -appid $appid -count 50 -start 250 -query tcl] foreach x [dict get $data resultset_web] { puts [dict get $x abstract] } <> Internet | Interprocess Communication