3 exec tclsh "$0" ${1+"$@"}
5 # Script to create a short url via http://tinyurl.com
6 # and similar services right away from the command line.
7 # Default is http://jbot.de provided by my friend Ralf.
9 # Copyright (c) 2007-2010 Sven <sven@timegate.de>
11 # This program is free software; you can redistribute it and/or modify
12 # it under the terms of the GNU General Public License as published by
13 # the Free Software Foundation; either version 2 of the License, or
14 # (at your option) any later version.
16 # This program is distributed in the hope that it will be useful,
17 # but WITHOUT ANY WARRANTY; without even the implied warranty of
18 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 # GNU General Public License for more details.
21 # You should have received a copy of the GNU General Public License
22 # along with this program; if not, write to the Free Software
23 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
25 # For updates see http://sven.stormbind.net/misc/
28 # Version: 0.3 2010-08-27
29 # - Added http://nd.gd as the -n option, currently a pretty stupid
30 # service which just started linear counting at /01.
32 # Version: 0.2 2007-04-17
33 # - made the service chooseable via cmdline options
34 # - added support for http://jbot.de and made it default
36 # Version: 0.1 2007-04-15
39 ### required external (Debian) packages are:
40 # - tclcurl for TclCurl
41 # - tcllib for htmlparse etc.
43 package require TclCurl
45 package require htmlparse
46 package require struct
47 package require cmdline
51 set USERAGENT "mtinyurl.tcl version $VERSION by http://sven.stormbind.net/misc"
55 set uri http://tinyurl.com/create.php?
56 append uri [http::formatQuery url $args_t]
57 set curlopts [http::formatQuery url $args_t]
58 set shortname "http://tinyurl.com"
59 maketiny $uri $curlopts $shortname
63 set uri http://jbot.de/create.php
64 set curlopts [http::formatQuery url $args_j]
65 set shortname "http://jbot.de"
66 maketiny $uri $curlopts $shortname
71 set curlopts "[http::formatQuery longurl http://$args_n]&OMG%21+SHORT_ME%21"
72 set shortname "http://nd.gd/"
73 maketiny $uri $curlopts $shortname
76 proc maketiny {uri curlopts shortname} {
78 set chandle [curl::init]
79 $chandle configure -url $uri \
80 -useragent $USERAGENT \
83 -postfields $curlopts \
89 htmlparse::2tree $rpage t
90 htmlparse::removeVisualFluff t
91 htmlparse::removeFormDefs t
92 foreach nodeakt [t children -all [t rootname]] {
93 #puts "DEBUG: [t getall $nodeakt ] NODE: $nodeakt"
94 if {[t get $nodeakt type] == "PCDATA"} {
95 set nodedata [t get $nodeakt data]
96 if {[string match -nocase "*$shortname*" $nodedata]} {
104 proc main {argv0 argv} {
105 regsub -all "(http://)" $argv "" saneargv
106 #puts "DEBUG: $argv0 -- $argv -- $saneargv"
108 {t.arg -1 "Use http://tinyurl.com service to create a short URL"}
109 {j.arg -1 "Use http://jbot.de service to create a short URL (default)"}
110 {n.arg -1 "Use http://nd.gd service to create a short URL"}
112 set saneargv0 [::cmdline::getArgv0]
113 set usage "$saneargv0 \[options] URL"
114 if { [catch {array set args [::cmdline::getoptions saneargv $options $usage]}] } {
116 puts "-t Use http://tinyurl.com service to create a short URL"
117 puts "-j Use http://jbot.de service to create a short URL (default)"
118 puts "-n Use http://nd.gd service to create a short URL"
122 # Handle -t for http://tinyurl.com
123 if {$args(t) != -1} {
127 # Handle -j for http://jbot.de (default)
128 if {$args(j) != -1} {
132 # Handle -n for http://nd.gd
133 if {$args(n) != -1} {
137 # No option given? Fall back to a default service (jbot.de)
138 if {$args(j) == -1 && $args(t) == -1 && $args(n) == -1} {