Posted to tcl by mjanssen at Sun Jul 01 16:59:44 GMT 2007view pretty

package require sqlite3

sqlite3 db c:/temp/ts.sqlite

socket -server OnConnect 9999

proc OnConnect {sock ip port} {
    puts "------------------------------------"
    puts "Connection on $sock"
    fconfigure $sock -blocking 0 -buffering none -translation binary
    fileevent $sock readable [list GetData $sock]
}


proc GetData {sock} {
    set data [read $sock]
    after idle [list after 0 [list HandleRequest $sock $data]]
}

proc HandleRequest {sock data_read} {
    set end_of_length [string first : $data_read]

    # If we don't know the length yet continue reading
    if {$end_of_length == -1} {
        set data [read $sock]
        after idle [list after 0 [list HandleRequest $sock $data_read$data]]
        return
    }
    set length [string range $data_read 0 $end_of_length-1]
    puts "Length: $length"
    set rest [string range $data_read $end_of_length+1 end]
    if { [string length $rest] < $length } {
        # we dont have all the headers yet
        set data [read $sock]
        after idle [list after 0 [list HandleRequest $sock $data_read$data]]
        return
    } else {
        array set headers [lrange [split [string range $rest 0 $length-1] \0] 0 end-1] ; # drop the final {}
    }
    parray headers
    puts $sock "Status: 200 OK"
    puts $sock "Content-Type: text/html"
    puts $sock ""
    puts $sock "<HTML><table>"
    foreach key [array names headers] {
        puts $sock "<tr><td>$key</td><td>$headers($key)</td></tr>"
    }
    puts $sock "</table></html>"
    close $sock
}

vwait forever