#! /bin/sh
# -*- tcl -*- \
exec tclsh "$0" ${1+"$@"}

# Script to create a short url via http://tinyurl.com
# 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>
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA

# 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

### required external (Debian) packages are:
# - tclcurl for TclCurl
# - tcllib for htmlparse etc.

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

    ::struct::tree t
    htmlparse::2tree $rpage t
    htmlparse::removeVisualFluff t
    htmlparse::removeFormDefs t
    foreach nodeakt [t children -all [t rootname]] {
        #puts "DEBUG: [t getall $nodeakt ] NODE: $nodeakt"
	if {[t get $nodeakt type] == "PCDATA"} {
	    set nodedata [t get $nodeakt data]
	    if {[string match -nocase "*$shortname*" $nodedata]} {
		puts $nodedata
	    }
	}
    }
    t destroy
}

proc main {argv0 argv} {
    regsub -all "(http://)" $argv "" saneargv
    #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
    }

}

main $argv0 $argv