You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
103 lines
3.0 KiB
103 lines
3.0 KiB
# -*- tcl -*- |
|
# # ## ### ##### ######## ############# |
|
# (C) 2009 Andreas Kupries |
|
|
|
# @@ Meta Begin |
|
# Package tcl::transform::adler32 1.1 |
|
# Meta as::author {Andreas Kupries} |
|
# Meta as::copyright 2009 |
|
# Meta as::license BSD |
|
# Meta as::notes For other observers see crc32, counter, |
|
# Meta as::notes identity, and observer (stream copy). |
|
# Meta description Implementation of an adler32 checksum |
|
# Meta description transformation. Based on Tcl 8.6's |
|
# Meta description transformation reflection support (TIP |
|
# Meta description 230), and its zlib support (TIP 234) for |
|
# Meta description the adler32 functionality. An observer |
|
# Meta description instead of a transformation. For details |
|
# Meta description on the adler checksum see |
|
# Meta description http://en.wikipedia.org/wiki/Adler-32 . |
|
# Meta description The observer saves the checksums into two |
|
# Meta description namespaced external variables specified |
|
# Meta description at construction time. Exports a single |
|
# Meta description command adding a new transformation of |
|
# Meta description this type to a channel. One argument, |
|
# Meta description the channel to extend, plus options to |
|
# Meta description specify the variables for the checksums. |
|
# Meta description No result. |
|
# Meta platform tcl |
|
# Meta require tcl::transform::core |
|
# Meta require {Tcl 8.6} |
|
# @@ Meta End |
|
|
|
# # ## ### ##### ######## ############# |
|
|
|
package require Tcl 8.6 9 |
|
package require tcl::transform::core |
|
|
|
# # ## ### ##### ######## ############# |
|
|
|
namespace eval ::tcl::transform {} |
|
|
|
proc ::tcl::transform::adler32 {chan args} { |
|
::chan push $chan [adler32::implementation new {*}$args] |
|
} |
|
|
|
oo::class create ::tcl::transform::adler32::implementation { |
|
superclass tcl::transform::core ;# -> initialize, finalize, destructor |
|
|
|
# This transformation continuously computes a checksum from the |
|
# data it sees. This data may be arbitrary parts of the input or |
|
# output if the channel is seeked while the transform is |
|
# active. This may not be what is wanted and the desired behaviour |
|
# may require the destruction of the transform before seeking. |
|
|
|
method write {c data} { |
|
my Adler32 -write-variable $data |
|
return $data |
|
} |
|
|
|
method read {c data} { |
|
my Adler32 -read-variable $data |
|
return $data |
|
} |
|
|
|
# # ## ### ##### ######## ############# |
|
|
|
constructor {args} { |
|
array set options { |
|
-read-variable {} |
|
-write-variable {} |
|
} |
|
# todo: validity checking of options (legal names, legal |
|
# values, etc.) |
|
array set options $args |
|
my Init -read-variable |
|
my Init -write-variable |
|
return |
|
} |
|
|
|
# # ## ### ##### ######## ############# |
|
|
|
variable options |
|
|
|
# # ## ### ##### ######## ############# |
|
|
|
method Init {o} { |
|
if {$options($o) eq ""} return |
|
upvar #0 $options($o) adler |
|
set adler 1 |
|
return |
|
} |
|
|
|
method Adler32 {o data} { |
|
if {$options($o) eq ""} return |
|
upvar #0 $options($o) adler |
|
set adler [zlib adler32 $data $adler] |
|
return |
|
} |
|
} |
|
|
|
# # ## ### ##### ######## ############# |
|
package provide tcl::transform::adler32 1.1 |
|
return
|
|
|