Raccourcir une url avec TinyURL

[CrazyCat]

Ce code permet d'utiliser directement l'API tinyurl.com pour raccourcir une url. Il est directement extrait du script Acronym Fetcher fait par MenzAgitat

tclcopier

# Après combien de secondes décide-t-on que le site web 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.
set ::TinyURL_timeout 5
 
proc ::tinyurl_conversion {url} {
   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
   }
}

Attention : le package http est bien évidemment requis pour faire fonctionner ce code.
Source modifiable

[MenzAgitat]

tclcopier

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