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.4 2014-06-22
29 # Remove nd.gd support - dead
31 # Version: 0.3 2010-08-27
32 # - Added http://nd.gd as the -n option, currently a pretty stupid
33 # service which just started linear counting at /01.
35 # Version: 0.2 2007-04-17
36 # - made the service chooseable via cmdline options
37 # - added support for http://jbot.de and made it default
39 # Version: 0.1 2007-04-15
42 ### required external (Debian) packages are:
43 # - tclcurl for TclCurl
44 # - tcllib for htmlparse etc.
46 package require TclCurl
48 package require htmlparse
49 package require struct
50 package require cmdline
54 set USERAGENT "mtinyurl.tcl version $VERSION by http://sven.stormbind.net/misc"
58 set uri http://tinyurl.com/create.php?
59 append uri [http::formatQuery url $args_t]
60 set curlopts [http::formatQuery url $args_t]
61 set shortname "http://tinyurl.com"
62 maketiny $uri $curlopts $shortname
66 set uri http://jbot.de/create.php
67 set curlopts [http::formatQuery url $args_j]
68 set shortname "http://jbot.de"
69 maketiny $uri $curlopts $shortname
72 proc maketiny {uri curlopts shortname} {
74 set chandle [curl::init]
75 $chandle configure -url $uri \
76 -useragent $USERAGENT \
79 -postfields $curlopts \
85 htmlparse::2tree $rpage t
86 htmlparse::removeVisualFluff t
87 htmlparse::removeFormDefs t
88 foreach nodeakt [t children -all [t rootname]] {
89 #puts "DEBUG: [t getall $nodeakt ] NODE: $nodeakt"
90 if {[t get $nodeakt type] == "PCDATA"} {
91 set nodedata [t get $nodeakt data]
92 if {[string match -nocase "*$shortname*" $nodedata]} {
100 proc main {argv0 argv} {
101 regsub -all "(http://)" $argv "" saneargv
102 #puts "DEBUG: $argv0 -- $argv -- $saneargv"
104 {t.arg -1 "Use http://tinyurl.com service to create a short URL"}
105 {j.arg -1 "Use http://jbot.de service to create a short URL (default)"}
107 set saneargv0 [::cmdline::getArgv0]
108 set usage "$saneargv0 \[options] URL"
109 if { [catch {array set args [::cmdline::getoptions saneargv $options $usage]}] } {
111 puts "-t Use http://tinyurl.com service to create a short URL"
112 puts "-j Use http://jbot.de service to create a short URL (default)"
116 # Handle -t for http://tinyurl.com
117 if {$args(t) != -1} {
121 # Handle -j for http://jbot.de (default)
122 if {$args(j) != -1} {
126 # No option given? Fall back to a default service (jbot.de)
127 if {$args(j) == -1 && $args(t) == -1 } {