[REpresentational State Transfer, REST%|%REST] stands for representational state transfer [[Add pointers to other discussions of REST here]] A [tcllib] module implementing REST is being considered at this time. See the tcllib cvs head for the current code. The code is not yet installed by the standard makefile. I was trying to get the google docs interface to support "update" but had no joy. [restful gdocs] ---- [DKF]: This is my REST client support class. ====== package require Tcl 8.5 package require http package require TclOO # RESTful service core package provide rest 0.1 # Support class for RESTful web services. This wraps up the http package to # make everything appear nicer. oo::class create REST { variable base wadls acceptedmimetypestack constructor baseURL { set base $baseURL my LogWADL $baseURL } # TODO: Cookies! method ExtractError {tok} { return [http::code $tok],[http::data $tok] } method OnRedirect {tok location} { upvar 1 url url set url $location # By default, GET doesn't follow redirects; the next line would # change that... #return -code continue set where $location my LogWADL $where if {[string equal -length [string length $base/] $location $base/]} { set where [string range $where [string length $base/] end] return -level 2 [split $where /] } return -level 2 $where } method LogWADL url { return;# do nothing set tok [http::geturl $url?_wadl] set w [http::data $tok] http::cleanup $tok if {![info exist wadls($w)]} { set wadls($w) 1 puts stderr $w } } method PushAcceptedMimeTypes args { lappend acceptedmimetypestack [http::config -accept] http::config -accept [join $args ", "] return } method PopAcceptedMimeTypes {} { set old [lindex $acceptedmimetypestack end] set acceptedmimetypestack [lrange $acceptedmimetypestack 0 end-1] http::config -accept $old return } method DoRequest {method url {type ""} {value ""}} { for {set reqs 0} {$reqs < 5} {incr reqs} { if {[info exists tok]} { http::cleanup $tok } set tok [http::geturl $url -method $method -type $type -query $value] if {[http::ncode $tok] > 399} { set msg [my ExtractError $tok] http::cleanup $tok return -code error $msg } elseif {[http::ncode $tok] > 299 || [http::ncode $tok] == 201} { set location {} if {[catch { set location [dict get [http::meta $tok] Location] }]} { http::cleanup $tok error "missing a location header!" } my OnRedirect $tok $location } else { set s [http::data $tok] http::cleanup $tok return $s } } error "too many redirections!" } method GET args { return [my DoRequest GET $base/[join $args /]] } method POST {args} { set type [lindex $args end-1] set value [lindex $args end] set m POST set path [join [lrange $args 0 end-2] /] return [my DoRequest $m $base/$path $type $value] } method PUT {args} { set type [lindex $args end-1] set value [lindex $args end] set m PUT set path [join [lrange $args 0 end-2] /] return [my DoRequest $m $base/$path $type $value] } method DELETE args { set m DELETE my DoRequest $m $base/[join $args /] return } export GET POST PUT DELETE } # Local Variables: # mode: tcl # tab-width: 4 # End: ====== <> Tcllib | Internet