Updated 2012-01-16 11:53:17 by dkf

A tcl api to everyone's favorite social bookmarking site, by AF. This code should work but you can check [1] for a possibly more up to date version.

See [2] 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=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

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.