Reinhard Max - 2004-11-08
This little tool is another example of web scraping. It allows one to create a tiny URL (http://tinyurl.com ) from the command line.
The TinyURL proc can also be used in other scripts for TinyURL creation.
package require http
# - TinyURL
#
# Create a simple alias URL from a possibly long and complicated one
# using the http://tinyurl.com service
#
# in: The URL to be made tiny
# out: The tiny URL
#
proc TinyURL {url} {
set query [::http::formatQuery url $url]
set token [::http::geturl http://tinyurl.com/create.php -query $query]
if {[::http::ncode $token] != 200} {
return -code error [::http::data $token]
}
set RE {^<input type=hidden name=tinyurl value="(.*)">$}
if {![regexp -line $RE [::http::data $token] -> turl]} {
return -code error \
"http://tinyurl.com has probably changed the output format."
}
::http::cleanup $token
return $turl
}
if {$argc != 1} {
puts "usage: [info script] url"
exit 1
}
puts [TinyURL [lindex $argv 0]]MG The output format does indeed seem to have changed since this was written - replacing the regexp line with
set RE {<blockquote><b>(.+?)</b>}seems to get it going again now. (Though, the comments in the HTML code ask you not to web scrape, and to contact them about their API instead - I just emailed, will try and comment here again when I hear back, hopefully it'll be something that can be done simply in Tcl like the above.)
AF: I added an example for using bit.ly to the tcllib rest module [L1 ] which may be a good alternative
mw: This example uses the tinyurl API instead. Consider it public domain. 2013-02-08
proc tinyurl {url} {
set result {}
set query [::http::formatQuery url $url]
catch {
set tok [::http::geturl "http://tinyurl.com/api-create.php" -query $query]
upvar #0 $tok state
if {$state(status) == "ok" && $state(type) == "text/plain"} {
set result [lindex [split $state(body) \n] 0]
}
::http::cleanup $tok
}
return $result
}