Mise en forme de code: pensez à utiliser les balises [ tcl ] et [ /tcl ] (sans les espaces bien sûr) autour de vos codes tcl afin d'avoir un meilleur rendu et une coloration syntaxique. x


Raccourcir une url avec TinyURL
#1
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

tcl
# 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
  Répondre
#2
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
Toute l'actualité de mes scripts ici     (dernière mise à jour le 22/04/2020)

Tout programme comporte au moins un bug et pourrait être raccourci d'au moins une instruction, de quoi l'on peut déduire que tout programme peut être réduit à une seule instruction qui ne fonctionne pas.
  Répondre


Atteindre :


Utilisateur(s) parcourant ce sujet : 1 visiteur(s)