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=http://wiki.tcl.tk "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:
- one second wait between queries are required
- library must watch for http 503 errors and respect them