From 29191a71b0ac897cf620499986f223ebab51e572 Mon Sep 17 00:00:00 2001
From: Sven Hoexter <sven@timegate.de>
Date: Mon, 17 Jan 2011 18:28:57 +0100
Subject: [PATCH] Update mtinyurl.tcl up to version 2

---
 home/mtinyurl.tcl | 94 +++++++++++++++++++++++++++++++++++------------
 1 file changed, 71 insertions(+), 23 deletions(-)

diff --git a/home/mtinyurl.tcl b/home/mtinyurl.tcl
index f05fa10..6114129 100755
--- a/home/mtinyurl.tcl
+++ b/home/mtinyurl.tcl
@@ -3,7 +3,8 @@
 exec tclsh "$0" ${1+"$@"}
 
 # Script to create a short url via http://tinyurl.com
-# right away from the command line.
+# and similar services right away from the command line.
+# Default is http://jbot.de provided by my friend Ralf.
 
 #   Copyright (c) 2007  Sven Hoexter <sven@timegate.de>
 #
@@ -24,6 +25,10 @@ exec tclsh "$0" ${1+"$@"}
 # For updates see http://sven.stormbind.net/misc/
 
 ### Changelog
+# Version: 0.2 2007-04-17
+#  - made the service chooseable via cmdline options
+#  - added support for http://jbot.de and made it default
+#
 # Version: 0.1 2007-04-15
 #  - initial release
 
@@ -35,8 +40,40 @@ package require TclCurl
 package require http
 package require htmlparse
 package require struct
+package require cmdline
+
+#GLOBAL VALUES
+set VERSION "0.2"
+set USERAGENT "mtinyurl.tcl version $VERSION by http://sven.stormbind.net/misc"
+
+
+proc use_t {args_t} {
+    set uri http://tinyurl.com/create.php?      
+    append uri [http::formatQuery url $args_t]
+    set curlopts [http::formatQuery url $args_t]
+    set shortname "http://tinyurl.com"
+    maketiny $uri $curlopts $shortname
+}
+
+proc use_j {args_j} {
+    set uri http://jbot.de/create.php
+    set curlopts [http::formatQuery url $args_j]
+    set shortname "http://jbot.de"
+    maketiny $uri $curlopts $shortname
+}
+
+proc maketiny {uri curlopts shortname} {
+    global USERAGENT
+    set chandle [curl::init]
+    $chandle configure -url $uri \
+	-useragent $USERAGENT \
+	-autoreferer 1 \
+	-followlocation 1 \
+	-postfields $curlopts \
+	-bodyvar rpage
+    $chandle perform
+    $chandle cleanup
 
-proc parse {rpage} {
     ::struct::tree t
     htmlparse::2tree $rpage t
     htmlparse::removeVisualFluff t
@@ -45,34 +82,45 @@ proc parse {rpage} {
         #puts "DEBUG: [t getall $nodeakt ] NODE: $nodeakt"
 	if {[t get $nodeakt type] == "PCDATA"} {
 	    set nodedata [t get $nodeakt data]
-	    if {[string match -nocase "*http://tinyurl.com*" $nodedata]} {
+	    if {[string match -nocase "*$shortname*" $nodedata]} {
 		puts $nodedata
-		puts ""
 	    }
 	}
     }
+    t destroy
 }
 
-
-proc main {argv} {
-    #puts "DEBUG: $argv"
+proc main {argv0 argv} {
     regsub -all "(http://)" $argv "" saneargv
-    #puts "DEBUG: $saneargv"
-    set useragent "Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.7.12) Gecko/20050922"
-    set uri http://tinyurl.com/create.php?      
-    append uri [http::formatQuery url $saneargv]
-    #puts "DEBUG: $uri"
-    
-    set chandle [curl::init]
-    $chandle configure -url $uri \
-	-useragent $useragent \
-	-autoreferer 1 \
-	-followlocation 1 \
-	-bodyvar rpage
-    $chandle perform
-    $chandle cleanup
+    #puts "DEBUG: $argv0 -- $argv -- $saneargv"
+    set options {
+	{t.arg -1 "Use http://tinyurl.com service to create a short URL"}
+	{j.arg -1 "Use http://jbot.de service to create a short URL (default)"}	
+    }
+    set saneargv0 [::cmdline::getArgv0]
+    set usage "$saneargv0 \[options]  URL"
+    if { [catch {array set args [::cmdline::getoptions saneargv $options $usage]}] } {
+	puts $usage
+	puts "-t Use http://tinyurl.com service to create a short URL"
+	puts "-j Use http://jbot.de service to create a short URL (default)"
+	exit 1
+    }
+
+    # Handle -t for http://tinyurl.com
+    if {$args(t) != -1} {
+	use_t $args(t)
+    }
+
+    # Handle -j for http://jbot.de (default)
+    if {$args(j) != -1} {
+	use_j $args(j)
+    }
+
+    # No option given? Fall back to a default service (jbot.de)
+    if {$args(j) == -1 && $args(t) == -1} {
+	use_j $saneargv
+    }
 
-    parse $rpage
 }
 
-main $argv
\ No newline at end of file
+main $argv0 $argv
\ No newline at end of file
-- 
2.39.5