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.