My original LiveJournal Tcl/Tk client

lj.tcl

#!/bin/sh
# restart wish \
exec wish "$0" "$@"

#
# LiveJournal -- TCL/Tk client
# http://www.livejournal.com/
#
# Brad Fitzpatrick
# livejournal@bradfitz.com
#
# NOTE: this client is very, very minimal, and doesn't even
#       do things it should to be minimally minimal, like
#       checking the server's return message to see if the
#       update worked.  i'll add that stuff later.  this was
#       a very quick hack.
#
# To make your life easier, make a ~/.livejournal.rc file like:
#
#      user: username
#      password: password
#      use_proxy: 1
#      proxy_host: my.proxy.com
#      proxy_port: 81
#
# (etc, etc..... whatever you see in rc(...) below you can set in your
# .rc file)
#

set ClientPlatform  TCL
set ClientVersion   0.1

puts "LiveJournal Client $ClientPlatform/$ClientVersion starting..."

set rc(user) {}
set rc(password) {}
set rc(server) {www.livejournal.com}
set rc(use_proxy) 0

proc get_userpass_vars {topl} {
    global rc
    set rc(user) [$topl.userf.usere get]
    set rc(password) [$topl.passf.passe get]
}

proc post_event {event} {

    global rc
    array set req [list user $rc(user)]
    array set req [list password $rc(password)]
    array set req [list event $event]
    array set req [list mode postevent]

    # snarf the date stuff
    array set req [clock format [clock seconds] -format "
    year %Y 
    mon %m
    day %d 
    hour %H
    min %M
    "]
    
    .event configure -state disabled
    .send configure -state disabled

    set reqs [array2url req]
    set sock {}

    if {$rc(use_proxy)} {
	if {[catch {set sock [socket $rc(proxy_host) $rc(proxy_port)] } ]} {
	    tk_dialog .error Error {Could not establish proxy connection.} {} 0 Okay
	    return
	}
	puts $sock "POST http://$rc(server)/cgi-bin/log.cgi HTTP/1.0"
    } else {
	if {[catch {set sock [socket $rc(server) 80] } ]} {
	    tk_dialog .error Error {Could not establish connection to server.} {} 0 Okay
	    return
	}
	puts $sock "POST /cgi-bin/log.cgi HTTP/1.0"
    }

    puts "Socket is $sock"

    puts $sock "Host: $rc(server)"
    puts $sock "Content-type: multi-part/form-data"
    puts $sock "Content-length: [string length $reqs]"
    puts $sock {}
    puts $sock $reqs
    puts $reqs

    while {0 && ![fblocked $sock] && ![eof $sock]} {
	gets $sock line
	puts $line
    }

    close $sock

    .event configure -state normal
    .event delete 0 [string length [.event get]]
    .send configure -state normal
}

set rcf ""
if {[catch { set rcf [open "~/.livejournal.rc" r] } ]} {
    puts stderr "Config file ~/.livejournal.rc not found."
} else {
    while {![eof $rcf]} {
	gets $rcf line
	if {[string first # $line] == 0} {
	    # ignoring comment line
	} elseif {![regexp {[a-zA-Z0-9_:\.]} $line]} {
	    # ignoring blank line
	} else {
	    if {[regexp {^([a-zA-Z0-9_]+)[ ]*:[ ]*([a-zA-Z0-9_.]+)} $line match var val]} {
		array set rc [list $var $val]
		puts "Config: $var = $val"
	    }
	}
    }
    close $rcf
}

wm title . "LiveJournal"
entry .event -width 50
pack .event -fill both -side left -expand 1
button .send -text "Send" -command {post_event [.event get]}
pack .send -side left -fill y

if {![string length $rc(user)]} {
    wm withdraw .
    set w .getuserpass
    toplevel $w
    wm title $w "Login"

    frame $w.userf 
    label $w.userf.userl -text "Username: "
    entry $w.userf.usere 
    pack $w.userf.userl -side left
    pack $w.userf.usere -side left
    pack $w.userf

    frame $w.passf
    label $w.passf.passl -text "Password: " 
    entry $w.passf.passe -show *
    pack $w.passf.passl -side left
    pack $w.passf.passe -side left
    pack $w.passf

    button $w.okay -text "Okay" -command "get_userpass_vars $w; grab release $w; wm withdraw $w; wm deiconify ."
    pack $w.okay
    
    grab $w
 
}


proc array2url {array_to_urlitize} {
	upvar $array_to_urlitize ar

	set ret {}
	foreach key [array names ar] {
		if {[string length $ret] > 0} {
			append ret &
		}
		append ret [urlescape $key]
		append ret =
		append ret [urlescape $ar($key)]
	}
	return $ret
}

proc escape_char {unes} {

	if {$unes == " "} { return + }
	return %[format %.2x $unes]

}

proc urlescape {text} {
    global urlEChar
    for {set i 0} {$i < 256} {incr i} {
	set c [format %c $i]
	if {[string match {[a-zA-Z0-9_.]} $c]} {
	    set urlEChar($c) $c
	} else {
	    array set urlEChar [list $c %[format %.2x $i]]
	}
    }
    array set urlEChar {" " +}
    
    proc urlescape {text} {
	global urlEChar		
	foreach char [split $text ""] {
	    append ret $urlEChar($char)
	}
	return $ret
    }
    
    return [urlescape $text]
}