# gravatar.tcl
# (c) 2010 Sébastien Santoro aka Dereckson <[email protected]>
# Released under BSD license
#
# Provides a Gravatar library in TCL.
#
# Gravatar is a service allowing website engines, blogs, etc. to
# display an avatar from an e-mail address.
#
# This library currently handles image requests.
# You're welcome to contribute code to handle profile requests.

package require http
package require md5;    #comment if you don't handle MD5 with tcllib

namespace eval gravatar {
    variable version 1.0.0

    namespace export md5 get_hash get_url
}

#Gets MD5 hash
proc ::gravatar::md5 {string} {
    #tcllib way:
    string tolower [::md5::md5 -hex $string]

    #BSD way:
    #exec -- md5 -q -s $string

    #Linux way:
    #exec -- echo -n $string | md5sum | sed "s/\ *-/\ \ /"

    #Solaris way:
    #lindex [exec -- echo -n $string | md5sum] 0

    #OpenSSL way:
    #exec -- echo -n $string | openssl md5
}

#Gets Gravatar e-mail hash
#http://en.gravatar.com/site/implement/hash/
proc ::gravatar::get_hash {mail} {
    md5 [string tolower [string trim $mail]]
}

#Gets Gravatar URL
#http://en.gravatar.com/site/implement/images/
#size: 1-512 (in pixels, default 80px
#default: what to print if hash not found, default gravatar logo
#         values: 404 mm identicon monsterid wavatar retro or an URL
#rating: g pg r x
#We don't validate parameters, are API is unstable and evolves often.
proc ::gravatar::get_url {mail {size 0} {default ""} {rating ""}} {
    set url http://www.gravatar.com/avatar/
    append url [get_hash $mail]

    set params {}
    if {$size != 0} {
        lappend params s $size
    }
    if {$default != ""} {
        lappend params d $default
    }
    if {$rating != ""} {
        lappend params r $rating
    }
    if {[llength $params] > 0} {
        append url ?[::http::formatQuery {*}$params]
    }
    return $url
}

proc ::gravatar::get_secure_url {mail {size 0} {default ""} {rating ""}} {
    set url [::gravatar::get_url $mail $size $default $rating]
    return https://secure.[string range $url 11 end]
}

package provide gravatar 1.0

package require gravatar 1.0
puts "<img src=\"[::gravatar::get_url [email protected]]\" alt=\"username's avatar\" />"