Tkx in Perl
Putting this here so I don’t loose it.
To get Tkx to load without segfaulting, the following environment variable must be set.
export PERL_DL_NONLAZY=1
If it’s set, it works fine
Update: This can be set in a BEGIN block as follows:
BEGIN {
$ENV{PERL_DL_NONLAZY} = 1;
}
Tcl Version of Blog generator
In my continuing re-implementing of things, I’ve also created a version of the site generation in Tcl.
Here’s the equivalent Tcl for generating the Table of Contents:
#!/usr/bin/env tclsh8.5
set output {}
foreach arg $argv {
set fh [open $arg "r"]
while {[gets $fh line] >= 0} {
if {[regexp {^\#\#\#} $line]} {
set date $arg
regsub {^\#\#\# } $line "" line
lappend output "<a href=\"index.html#$date\">$line</a><br>"
}
}
}
foreach line [lreverse $output] {
puts $line
}
Simple Tcl Webserver
Here’s a simple webserver written in Tcl (Modified from here or here.
I added the ability to choose a port and a user and group to run as, when started as root.
# [Modified from] DustMotePlus - with a subset of CGI support
package require Tclx
set default index.html
set port [lindex $argv 0]
set user [lindex $argv 1]
set group [lindex $argv 2]
set root "./public"
set encoding iso8859-1
proc bgerror msg {puts stdout "bgerror: $msg\n$::errorInfo"}
proc answer {sock host2 port2} {
fileevent $sock readable [list serve $sock]
}
proc serve sock {
fconfigure $sock -blocking 0
gets $sock line
if {[fblocked $sock]} {
return
}
fileevent $sock readable ""
set tail /
regexp {(/[^ ?]*)(\?[^ ]*)?} $line -> tail args
if {[string match */ $tail]} {
append tail $::default
}
set name [string map {%20 " "} $::root$tail]
if {[file readable $name]} {
puts $sock "HTTP/1.0 200 OK"
if {[file extension $name] eq ".tcl"} {
set ::env(QUERY_STRING) [string range $args 1 end]
set name [list |tclsh $name]
} else {
puts $sock "Content-Type: text/html;charset=$::encoding\n"
}
set inchan [open $name]
fconfigure $inchan -translation binary
fconfigure $sock -translation binary
fcopy $inchan $sock -command [list done $inchan $sock]
} else {
# puts $sock "HTTP/1.0 404 Not found\n"
puts $sock "Error - Path was: $name"
close $sock
}
}
proc done {file sock bytes {msg {}}} {
close $file
close $sock
}
socket -server answer $port
id group $group
id user $user
puts "User/Group changed to [id user] : [id group]"
puts "Server ready..."
vwait forever
I’ll probably try serving this website for a little while with this.
Fedora vs Ubuntu
As I’ve been playing around with Tcl, I’ve been struck with how much more up to date the default Tcl and libraries seem to be in Fedora rather than Ubuntu.
The default tcllib and Tclx packages in Ubuntu are still based on Tcl 8.4.
I think that’s probably at least 5 years old.
Actually 