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  Sven Hoexter <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.2 2007-04-17
  29 #  - made the service chooseable via cmdline options
  30 #  - added support for http://jbot.de and made it default
  31 #
  32 # Version: 0.1 2007-04-15
  33 #  - initial release
  34
  35 ### required external (Debian) packages are:
  36 # - tclcurl for TclCurl
  37 # - tcllib for htmlparse etc.
  38
  39 package require TclCurl
  40 package require http
  41 package require htmlparse
  42 package require struct
  43 package require cmdline
  44
  45 #GLOBAL VALUES
  46 set VERSION "0.2"
  47 set USERAGENT "mtinyurl.tcl version $VERSION by http://sven.stormbind.net/misc"
  48
  49
  50 proc use_t {args_t} {
  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
  56 }
  57
  58 proc use_j {args_j} {
  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
  63 }
  64
  65 proc maketiny {uri curlopts shortname} {
  66     global USERAGENT
  67     set chandle [curl::init]
  68     $chandle configure -url $uri \
  69         -useragent $USERAGENT \
  70         -autoreferer 1 \
  71         -followlocation 1 \
  72         -postfields $curlopts \
  73         -bodyvar rpage
  74     $chandle perform
  75     $chandle cleanup
  76
  77     ::struct::tree t
  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]} {
  86                 puts $nodedata
  87             }
  88         }
  89     }
  90     t destroy
  91 }
  92
  93 proc main {argv0 argv} {
  94     regsub -all "(http://)" $argv "" saneargv
  95     #puts "DEBUG: $argv0 -- $argv -- $saneargv"
  96     set options {
  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)"}
  99     }
 100     set saneargv0 [::cmdline::getArgv0]
 101     set usage "$saneargv0 \[options]  URL"
 102     if { [catch {array set args [::cmdline::getoptions saneargv $options $usage]}] } {
 103         puts $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)"
 106         exit 1
 107     }
 108
 109     # Handle -t for http://tinyurl.com
 110     if {$args(t) != -1} {
 111         use_t $args(t)
 112     }
 113
 114     # Handle -j for http://jbot.de (default)
 115     if {$args(j) != -1} {
 116         use_j $args(j)
 117     }
 118
 119     # No option given? Fall back to a default service (jbot.de)
 120     if {$args(j) == -1 && $args(t) == -1} {
 121         use_j $saneargv
 122     }
 123
 124 }
 125
 126 main $argv0 $argv