tcl
package require http
# Après combien de secondes décide-t-on que le site web http://www.tinyurl.com
# est offline (ou trop lent) en l'absence de réponse de sa part ?
# Remarque : en cas de timeout, l'URI intégrale sera affichée à la place de sa
# version raccourcie.
variable TinyURL_timeout 5
proc shorten_url {url} {
variable TinyURL_timeout
set url [::tcl::string::map -nocase {"&" "&"} $url]
set query "http://tinyurl.com/api-create.php?[::http::formatQuery url $url]"
if { ![catch { set token [::http::geturl $query -timeout [expr {$::TinyURL_timeout * 1000}]] }] } {
set short_url [::http::data $token]
::http::cleanup $token
if { ($short_url != 0) && ($short_url ne "") } {
return $short_url
} else {
return $url
}
} else {
::http::cleanup $token
return $url
}
}
Source : http://www.boulets.oqp.me/tcl/routines/t...-0010.html