"
foreach i {0 1 2 3 4 5 6 7 8 9 A B C D E F} {
append text [subst \\u250$i]
}
append text
set middot \u2022
set uni [string repeat $middot 10]
append text $uni
append text äöüéîâ
append text
append text [string repeat $x $n]
append text
set bin [encoding convertto utf-8 $text]
set blen [string bytelength $bin]
set res [zlib gzip $bin]
set rlen [string length $res]
append rlen .
set data(headers) [list Content-Encoding: gzip Cache-Control: none ratio: [format %.2f [expr {$rlen/$blen}]]]
set ::gzip "text/html; charset=utf-8"
return $res
}
Direct_Url /gzip ::gzip
======
[fr] experimental: '''How to serve a pre-compressed html-file with [tclhttpd]'''
Place an example file "file.html" in document-root, which will be cached and delivered with [gzip] encoding.
Place the code below in `custom/gz.tcl`.
Place a file file.html in document-root directory
Start the server: `wish84.exe bin\httpd.tcl -library custom -debug 1`
Point your browser to `http://localhost:8015/gz/file.htm`
Package gzip from `http://www.mail-archive.com/aolserver@listserv.aol.com/msg04572/gzip.tcl`
----
======
package provide gzip 1.0
package require Trf 2.0
namespace eval gzip {
variable crc
array set crc {}
variable size
array set size {}
proc open {filestream {compression_level 6}} {
variable crc
variable size
# just in case they've forgotten
fconfigure $filestream -translation binary
# initialize the crc and size variables for this stream
set crc($filestream) 0
set size($filestream) 0
# write the gzip header (minimal form)
puts -nonewline $filestream \
[binary format H8iH4 1f8b0800 [clock seconds] 0003]
# turn zip compression on for the stream
zip -attach $filestream -mode compress -level $compression_level \
-nowrap 1
# attach a crc calculator to the stream
crc-zlib -attach $filestream -mode transparent \
-write-destination gzip::crc($filestream) \
-write-type variable
# and a size calculator
transform -attach $filestream \
-command [namespace code [list filesize $filestream]]
}
proc close {filestream} {
variable crc
variable size
# unstack the three channel handlers we've added
unstack $filestream
unstack $filestream
unstack $filestream
# finish off the stream with the crc and original size
puts -nonewline $filestream $crc($filestream)
puts -nonewline $filestream [binary format i $size($filestream)]
unset crc($filestream)
unset size($filestream)
}
proc filesize {stream op buffer} {
variable size
# this is called to calculate the data size
# the only op we're interested in is "write"
switch -exact -- $op {
write {
incr size($stream) [string length $buffer]
}
}
set buffer
}
}
proc JH_gzip {htdocs_file} {
set path [file dirname [info script]]
set path [file dirname $path]
set path [file join $path htdocs]
set filename [file join $path $htdocs_file]
set gz $filename.gz
if {![file exists $gz]} {
package require gzip; # in turn requires Trf
set ifid [open $filename]
set ofid [open $gz w]
gzip::open $ofid; # actually attaches transforms, writes header
fcopy $ifid $ofid
gzip::close $ofid; # detaches transforms, writes crc trailer
close $ifid
close $ofid
}
set in [open $gz r]
fconfigure $in -translation binary
set ::compressed_file_cache [read $in]
close $in
}
JH_gzip file.html
set ::tentative ""
set body [info body HttpdRespondHeader]
set pattern {^\s*append reply \"Content-Type: \$type\" \\n}
regsub -line $pattern [info body HttpdRespondHeader] \
{if {[string equal $::tentative gz]} {set ::tentative "";append reply "Content-Type: text/html" \n;append reply "Content-Encoding: gzip" \n } else {append reply "Content-Type: $type" \n}} body
proc HttpdRespondHeader [info args HttpdRespondHeader] $body
proc ::tentative {} {
set ::tentative gz
return $::compressed_file_cache
}
Direct_Url /gz/file.html ::tentative
======
<