if {0} {<<br>>
[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
======

----
!!!!!!
%| [Category TclHttpd] |%
!!!!!!