[Richard Suchenwirth] 2007-12-19 - I love the [Tcl chatroom]. It's like my peer group. So I was quite frustrated when good old Ralfchat (a Perl script) on mini.net was closed down, because that was my only way to participate in the chat from my cellphone.
But isn't Tcl an enabling language? Why not put parts from [picoIRC 0.2] and [Playing CGI] together, and build my own bridge between [IRC] and [http]? Here goes:
#!/usr/bin/env tclsh
# webchain.tcl - HTTP <-> IRC bridge
set port 80
set encoding iso8859-1 ;# utf-8
set nick someone
set ircserver irc.freenode.org
set ircport 6667
set chan #tcl
set ircnick webchain
set log {webchain Welcome.}
proc irc_recv {} {
gets $::fd line
if {[string trim $line] ne ""} {puts $line}
# handle PING messages from server
if {[lindex [split $line] 0] eq "PING"} {
send "PONG [info hostname] [lindex [split $line] 1]"; return
}
if {[regexp {:([^!]*)![^ ].* +PRIVMSG ([^ :]+) +:(.*)} $line -> \
nick target msg]} {
set tag ""
if [regexp {\001ACTION(.+)\001} $msg -> msg] {set tag italic}
if [in {azbridge ijchain} $nick] {
regexp {<([^>]+)>(.+)} $msg -> nick msg
}
if {$tag eq "italic"} {set msg $msg}
lappend ::log $nick $msg
} else {lappend ::log - $line}
}
proc in {list element} {expr {[lsearch -exact $list $element]>=0}}
proc post msg {
if [regexp {^/me (.+)} $msg -> action] {set msg "\001ACTION $action\001"}
foreach line [split $msg \n] {send "PRIVMSG $::chan :<$::nick> $line"}
}
proc send str {puts $::fd $str; flush $::fd}
proc answer {sock host2 port2} {
fileevent $sock readable [list serve $sock]
}
proc encmap enc {string map {utf- UTF iso ISO-} $enc}
proc serve sock {
fconfigure $sock -blocking 0 -encoding $::encoding
gets $sock line
if {[fblocked $sock]} return
fileevent $sock readable ""
set args ""
regexp {(/[^ ?]*)\??([^ ]*)?} $line -> tail args
puts $sock "HTTP/1.0 200 OK"
puts $sock "Content-Type: text/html;charset=$[encmap $::encoding]\n"
puts $sock webchain
array set a [concat {MSG "" NICK "" CNT 30} [kvsplit $args]]
if {$a(MSG) ne ""} {
lappend ::log $a(NICK) $a(MSG)
set ::log [lrange $::log end-999 end]
set ::nick $a(NICK)
post $a(MSG)
}
foreach {nick post} [lrange $::log end-[expr {$a(CNT)*2-1}] end] {
puts $sock "$nick: $post
"
}
puts $sock "
"
puts $sock
close $sock
}
proc kvsplit kv {
set res ""
foreach i [split $kv &] {
foreach {k v} [split $i =] break
lappend res $k [unescape $v]
}
set res
}
proc unescape str {
regsub -all {%(..)} [string map {+ " "} $str] {\u00\1} str
subst $str
}
#-- connect to IRC...
set ::fd [socket $::ircserver $::ircport]
send "NICK $::ircnick"
send "USER $::ircnick 0 * :Tcl user"
send "JOIN $::chan"
fileevent $::fd readable irc_recv
socket -server answer $port
puts "Server ready..."
vwait forever
----
!!!!!!
%| [Category Example]|%
!!!!!!