A tcl api to everyone's favorite social bookmarking site, by AF. This code should work but you can check [L1 ] for a possibly more up to date version.
See [L2 ] for documentation.
package require http
package require tls
package require tdom
package require base64
package require json
package require md5
package provide delicious 1.0
::http::register https 443 [list ::tls::socket]
namespace eval delicious {
variable user {}
variable pass {}
namespace export get_posts recent_posts get_all_posts post_dates \
add_post delete_post updated get_tags rename_tag set_bundle \
delete_bundle get_bundles public_network public_tags public_url \
public_posts public_fans
}
proc ::delicious::_call {url} {
variable user
variable pass
lappend headers Authorization "Basic [base64::encode $user:$pass]"
#puts "geturl $url"
set t [http::geturl $url -headers $headers]
if {[http::ncode $t] != "200"} {
#parray $t
return -code error "HTTP [http::ncode $t]"
}
set data [http::data $t]
#puts "data: $data"
http::cleanup $t
return $data
}
proc ::delicious::_xml_to_list {xml top each} {
set data {}
set d [[dom parse -simple $xml] getElementsByTagName $top]
foreach node [$d getElementsByTagName $each] {
lappend data [lindex [$node asList] 1]
}
return $data
}
proc ::delicious::_check_result {xml} {
if {[regexp {<result code=\"(.*)\"} $xml -> result]} {
if {$result != "done"} {
return -code error $result
}
return -code ok
}
if {[regexp {<result>(.*)</result>} $xml -> result]} {
if {$result != "ok" && $result != "done"} {
return -code error $result
}
return -code ok
}
return -code error "could not parse result"
}
proc ::delicious::_options {valid in var} {
upvar $var blah
set query {}
foreach x $in {
set opt [split $x =]
if {[lsearch -exact $valid [lindex $opt 0]] > -1} {
if {[lindex $opt 0] == "dt"} {
lappend query dt [clock format [clock scan [lindex $opt 1]] -format "%Y-%m-%dT%TZ"]
} else {
lappend query [lindex $opt 0] [lindex $opt 1]
}
}
}
append blah [eval ::http::formatQuery $query]
}
proc delicious::get_posts {args} {
set url https://api.del.icio.us/v1/posts/get?
_options {url tag dt} $args url
return [_xml_to_list [_call $url] posts post]
}
proc ::delicious::recent_posts {args} {
set url https://api.del.icio.us/v1/posts/recent?
_options {tag count} $args url
return [_xml_to_list [_call $url] posts post]
}
proc ::delicious::get_all_posts {args} {
set url https://api.del.icio.us/v1/posts/all?
_options {tag} $args url
return [_xml_to_list [_call $url] posts post]
}
proc ::delicious::post_dates {args} {
set url https://api.del.icio.us/v1/posts/dates?
_options {tag} $args url
return [_xml_to_list [_call $url] dates date]
}
proc ::delicious::add_post {args} {
set url https://api.del.icio.us/v1/posts/add?
_options {url description extended tags dt replace shared} $args url
return [_check_result [_call $url]]
}
proc ::delicious::delete_post {args} {
set url https://api.del.icio.us/v1/posts/delete?
_options {url} $args url
return [_check_result [_call $url]]
}
proc ::delicious::updated {} {
set url https://api.del.icio.us/v1/posts/update
set xml [_call $url]
regexp {<update time=\"(.*)\"} $xml -> update
return [clock scan [string map {T " " Z " UTC"} $update]]
}
proc ::delicious::get_tags {} {
set url https://api.del.icio.us/v1/tags/get
return [_xml_to_list [_call $url] tags tag]
}
proc ::delicious::rename_tag {old new} {
set url https://api.del.icio.us/v1/tags/rename?
_options {old new} [list old=$old new=$new] url
return [_check_result [_call $url]]
}
proc ::delicious::set_bundle {bundle tags} {
set url https://api.del.icio.us/v1/tags/bundles/set?
_options {bundle tags} [list bundle=$bundle tags=$tags] url
return [_check_result [_call $url]]
}
proc ::delicious::delete_bundle {bundle} {
set url https://api.del.icio.us/v1/tags/bundles/set?
_options {old new} [list bundle=$bundle] url
return [_check_result [_call $url]]
}
proc ::delicious::get_bundles {} {
set url https://api.del.icio.us/v1/tags/bundles/all
return [_xml_to_list [_call $url] bundles bundle]
}
proc ::delicious::public_network {user} {
set url http://del.icio.us/feeds/json/network/$user
return [json::json2dict [_call $url]]
}
proc ::delicious::public_tags {user args} {
set url http://del.icio.us/feeds/json/tags/$user?
_options {atleast count sort} $args url
regexp {Delicious.tags = (.*)} [_call $url] -> json
return [json::json2dict $json]
}
proc ::delicious::public_fans {user} {
set url http://del.icio.us/feeds/json/fans/$user
return [json::json2dict [_call $url]]
}
proc ::delicious::public_posts {user args} {
set url http://del.icio.us/feeds/json/$user?
_options {count} $args url
regexp {Delicious.posts = (.*)} [_call $url] -> json
return [json::json2dict $json]
}
proc ::delicious::public_url {urls} {
set url http://badges.del.icio.us/feeds/json/url/data?
foreach u $urls {
append url &hash=[string tolower [md5::md5 -hex $u]]
}
return [json::json2dict [_call $url]]
}
proc ::delicious::modify_post {post args} {
foreach x $args {
set x [split $x =]
set new([lindex $x 0]) [lindex $x 1]
}
foreach {k v} $post {
if {$v == ""} { continue }
if {$k == "hash" || $k == "others" } { continue }
if {$k == "href"} { lappend string url=$v; continue }
if {$k == "tag"} { set k tags }
if {$k == "time"} {
set k dt
if {[info exists new(dt)]} { set v $new(dt) }
set v [string trimright $v Z]
} elseif {[info exists new($k)]} { set v $new($k) }
lappend string $k=$v
}
# shared attribute may not exist in post so check for it after
if {[info exists new(shared)] && [lsearch -glob $string shared=*] < 0} {
lappend string shared=$new(shared)
}
eval delicious::add_post $string
}
proc ::delicious::add_tag {post tags} {
array set in $post
set out [split $in(tag)]
foreach x $tags {
if {[lsearch -exact $out $x] < 0} { lappend out $x }
}
modify_post $post "tags=[join $out]"
}
proc ::delicious::delete_tag {post tags} {
array set in $post
set out [split $in(tag)]
foreach x $tags {
if {[set i [lsearch -exact $out $x]] < 0} { continue }
set out [lreplace $out $i $i]
}
modify_post $post "tags=[join $out]"
}An example:
package require delicious
set delicious::user username
set delicious::pass password
if [catch {delicious::add_post url=https://wiki.tcl-lang.org "description=the tclers wiki" tags=tcl} result]} {
}I would love to see examples of using this package. Anyone tried it?
LV 2007-Aug-09 In looking at the api web page mentioned above, I see a few requirements listed for libraries:
AF Well I know it says "library", but I left these up to the user of the library. Http errors are returned so the user can watch for 503s (or any other error) and do whatever needs to be done. its also up to the user to throttle the requests.