Version 5 of transform

Updated 2008-12-23 21:20:32 by lars_h

A channel transform is a mapping applied at the byte-level to a channel. Note that it does not operate on strings; Tcl converts to/from the channel's encoding at a level that is closer to the script level than transforms operate at.

The TLS extension uses transforms internally.

Transforms may be implemented in Tcl (from 8.6 onwards) with the help of chan push and chan pop.

PT: Here is an example of a base64 channel transform using Tcl 8.6 features. You push this transform onto any other sort of channel and it will base64 encode the data as it passes through.

 # A base64 channel transform.
 #
 # usage:  chan push $channel ::tcl::binary::transform_base64
 #
 package require Tcl 8.6

 proc ::tcl::binary::K {a b} {set a}

 proc ::tcl::binary::transform_base64 {cmd handle args} {
    upvar #0 [namespace current]::_transform_r_$handle rstate
    upvar #0 [namespace current]::_transform_w_$handle wstate
    switch -exact -- $cmd {
        initialize {
            set rstate ""; set wstate ""
            return [list initialize finalize read write flush drain]
        }
        finalize {
            unset rstate wstate
            return
        }
        write {
            foreach {buffer} $args break
            append wstate $buffer
            set len [string length $wstate]
            set end [expr {$len - ($len % 3)}]
            set edge [expr {$end - 1}]
            set res [binary encode base64 [string range $wstate 0 $edge]]
            set wstate [string range $wstate $end end]
            return $res
        }
        flush {
            set buffer [K $wstate [set wstate ""]]
            set res [binary encode base64 $buffer]
            return $res
        }
        read {
            foreach {buffer} $args break
            append rstate $buffer
            set len [string length $rstate]
            set end [expr {$len - ($len % 4)}]
            set edge [expr {$end - 1}]
            set res [string range $rstate 0 $edge]
            set rstate [string range $rstate $end end]
            set resx [binary decode base64 $res]
            if {[string length $resx]%3 != 0} { puts stderr "alert: $res" }
            return $resx
        }
        drain {
            set res [K [binary decode base64 $rstate] [set rstate ""]]
            return $res
        }
    }
 }

The above channel transform will not wrap lines so you end up with a file with one line of base64 encoded data. It is more common to see such files broken into lines every 60 characters or so. As channel transforms are stackable we can choose to have a second transform deal with writing such files.

 proc ::tcl::binary::maxlen {maxlen wrapchar cmd handle args} {
    upvar #0 [namespace current]::_maxlen_$handle state
    switch -exact -- $cmd {
        initialize {
            set state ""
            return [list initialize finalize write flush read]
        }
        finalize { unset state }
        write {
            foreach {data} $args break
            append state $data
            set mark 0
            set edge [expr {$maxlen - 1}]
            set res ""
            while {([string length $state] - $mark) > $maxlen} {
                append res [string range $state $mark $edge]$wrapchar
                incr mark $maxlen
                incr edge $maxlen
            }
            set state [string range $state $mark end]
            return $res
        }
        flush { return [K $state [set state ""]] }
        read { return [lindex $args 0] }
    }
 }

This transform buffers the output data, injecting a wrapchar every maxlen characters. To use this we first stack this transform and then the base64 transform onto the primary channel. For instance,

 set f [open $filename w]
 chan push $f [list ::tcl::binary::maxlen 60 \n]
 chan push $f [list ::tcl::binary::transform_base64]
 puts $f $data
 seek $f 0
 read $f
 close $f

Lars H: Here is a rewrite of the above maxlen as an ensemble with parameters:

 namespace eval ::tcl::binary::maxlen {
    namespace export initialize finalize write flush read
    namespace ensemble create -parameters {maxlen wrapchar}
    proc initialize {maxlen wrapchar handle mode} {
        variable $handle ""
        return [namespace export]
    }
    proc finalize {maxlen wrapchar handle} {
        unset [namespace current]::$handle
    }
    proc write {maxlen wrapchar handle data} {
        namespace upvar ::tcl::binary::maxlen $handle state
        append state $data
        set mark 0
        set edge [expr {$maxlen - 1}]
        set res ""
        while {([string length $state] - $mark) > $maxlen} {
            append res [string range $state $mark $edge]$wrapchar
            incr mark $maxlen
            incr edge $maxlen
        }
        set state [string range $state $mark end]
        return $res
    }
    proc flush {maxlen wrapchar handle} {
        namespace upvar ::tcl::binary::maxlen $handle state
        return $state[set state ""]
    }
    proc read {maxlen wrapchar handle data} {return $data}
 }

See also stacked channel.