home/mtinyurl.tcl

   1 #! /bin/sh
   2 # -*- tcl -*- \
   3 exec tclsh "$0" ${1+"$@"}
   4
   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.
   8
   9 #   Copyright (c) 2007-2010  Sven <sven@timegate.de>
  10 #
  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.
  15 #
  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.
  20 #
  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
  24
  25 # For updates see http://sven.stormbind.net/misc/
  26
  27 ### Changelog
  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.
  31 #
  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
  35 #
  36 # Version: 0.1 2007-04-15
  37 #  - initial release
  38
  39 ### required external (Debian) packages are:
  40 # - tclcurl for TclCurl
  41 # - tcllib for htmlparse etc.
  42
  43 package require TclCurl
  44 package require http
  45 package require htmlparse
  46 package require struct
  47 package require cmdline
  48
  49 #GLOBAL VALUES
  50 set VERSION "0.2"
  51 set USERAGENT "mtinyurl.tcl version $VERSION by http://sven.stormbind.net/misc"
  52
  53
  54 proc use_t {args_t} {
  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
  60 }
  61
  62 proc use_j {args_j} {
  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
  67 }
  68
  69 proc use_n {args_n} {
  70     set uri http://nd.gd
  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
  74 }
  75
  76 proc maketiny {uri curlopts shortname} {
  77     global USERAGENT
  78     set chandle [curl::init]
  79     $chandle configure -url $uri \
  80         -useragent $USERAGENT \
  81         -autoreferer 1 \
  82         -followlocation 1 \
  83         -postfields $curlopts \
  84         -bodyvar rpage
  85     $chandle perform
  86     $chandle cleanup
  87
  88     ::struct::tree t
  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]} {
  97                 puts $nodedata
  98             }
  99         }
 100     }
 101     t destroy
 102 }
 103
 104 proc main {argv0 argv} {
 105     regsub -all "(http://)" $argv "" saneargv
 106     #puts "DEBUG: $argv0 -- $argv -- $saneargv"
 107     set options {
 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"}
 111     }
 112     set saneargv0 [::cmdline::getArgv0]
 113     set usage "$saneargv0 \[options]  URL"
 114     if { [catch {array set args [::cmdline::getoptions saneargv $options $usage]}] } {
 115         puts $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"
 119         exit 1
 120     }
 121
 122     # Handle -t for http://tinyurl.com
 123     if {$args(t) != -1} {
 124         use_t $args(t)
 125     }
 126
 127     # Handle -j for http://jbot.de (default)
 128     if {$args(j) != -1} {
 129         use_j $args(j)
 130     }
 131
 132     # Handle -n for http://nd.gd
 133     if {$args(n) != -1} {
 134         use_n $args(n)
 135     }
 136
 137     # No option given? Fall back to a default service (jbot.de)
 138     if {$args(j) == -1 && $args(t) == -1 && $args(n) == -1} {
 139         use_j $saneargv
 140     }
 141
 142 }
 143
 144 main $argv0 $argv