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 Sven Hoexter <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.2 2007-04-17
29 # - made the service chooseable via cmdline options
30 # - added support for http://jbot.de and made it default
32 # Version: 0.1 2007-04-15
35 ### required external (Debian) packages are:
36 # - tclcurl for TclCurl
37 # - tcllib for htmlparse etc.
39 package require TclCurl
41 package require htmlparse
42 package require struct
43 package require cmdline
47 set USERAGENT "mtinyurl.tcl version $VERSION by http://sven.stormbind.net/misc"
51 set uri http://tinyurl.com/create.php?
52 append uri [http::formatQuery url $args_t]
53 set curlopts [http::formatQuery url $args_t]
54 set shortname "http://tinyurl.com"
55 maketiny $uri $curlopts $shortname
59 set uri http://jbot.de/create.php
60 set curlopts [http::formatQuery url $args_j]
61 set shortname "http://jbot.de"
62 maketiny $uri $curlopts $shortname
65 proc maketiny {uri curlopts shortname} {
67 set chandle [curl::init]
68 $chandle configure -url $uri \
69 -useragent $USERAGENT \
72 -postfields $curlopts \
78 htmlparse::2tree $rpage t
79 htmlparse::removeVisualFluff t
80 htmlparse::removeFormDefs t
81 foreach nodeakt [t children -all [t rootname]] {
82 #puts "DEBUG: [t getall $nodeakt ] NODE: $nodeakt"
83 if {[t get $nodeakt type] == "PCDATA"} {
84 set nodedata [t get $nodeakt data]
85 if {[string match -nocase "*$shortname*" $nodedata]} {
93 proc main {argv0 argv} {
94 regsub -all "(http://)" $argv "" saneargv
95 #puts "DEBUG: $argv0 -- $argv -- $saneargv"
97 {t.arg -1 "Use http://tinyurl.com service to create a short URL"}
98 {j.arg -1 "Use http://jbot.de service to create a short URL (default)"}
100 set saneargv0 [::cmdline::getArgv0]
101 set usage "$saneargv0 \[options] URL"
102 if { [catch {array set args [::cmdline::getoptions saneargv $options $usage]}] } {
104 puts "-t Use http://tinyurl.com service to create a short URL"
105 puts "-j Use http://jbot.de service to create a short URL (default)"
109 # Handle -t for http://tinyurl.com
110 if {$args(t) != -1} {
114 # Handle -j for http://jbot.de (default)
115 if {$args(j) != -1} {
119 # No option given? Fall back to a default service (jbot.de)
120 if {$args(j) == -1 && $args(t) == -1} {