[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 [http://tcllib.cvs.sourceforge.net/viewvc/tcllib/tcllib/modules/rest/bitly?revision=1.1] 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
}
======

<<categories>> Application | Internet