1# -*- tcl -*-
2# # ## ### ##### ######## #############
3# (C) 2009 Andreas Kupries
4
5# @@ Meta Begin
6# Package tcl::transform::adler32 1
7# Meta as::author {Andreas Kupries}
8# Meta as::copyright 2009
9# Meta as::license BSD
10# Meta as::notes   For other observers see crc32, counter,
11# Meta as::notes   identity, and observer (stream copy).
12# Meta description Implementation of an adler32 checksum
13# Meta description transformation. Based on Tcl 8.6's
14# Meta description transformation reflection support (TIP
15# Meta description 230), and its zlib support (TIP 234) for
16# Meta description the adler32 functionality. An observer
17# Meta description instead of a transformation. For details
18# Meta description on the adler checksum see
19# Meta description http://en.wikipedia.org/wiki/Adler-32 .
20# Meta description The observer saves the checksums into two
21# Meta description namespaced external variables specified
22# Meta description at construction time. Exports a single
23# Meta description command adding a new transformation of
24# Meta description this type to a channel. One argument,
25# Meta description the channel to extend, plus options to
26# Meta description specify the variables for the checksums.
27# Meta description No result.
28# Meta platform tcl
29# Meta require tcl::transform::core
30# Meta require {Tcl 8.6}
31# @@ Meta End
32
33# # ## ### ##### ######## #############
34
35package require Tcl 8.6
36package require tcl::transform::core
37
38# # ## ### ##### ######## #############
39
40namespace eval ::tcl::transform {}
41
42proc ::tcl::transform::adler32 {chan args} {
43    ::chan push $chan [adler32::implementation new {*}$args]
44}
45
46oo::class create ::tcl::transform::adler32::implementation {
47    superclass tcl::transform::core ;# -> initialize, finalize, destructor
48
49    # This transformation continuously computes a checksum from the
50    # data it sees. This data may be arbitrary parts of the input or
51    # output if the channel is seeked while the transform is
52    # active. This may not be what is wanted and the desired behaviour
53    # may require the destruction of the transform before seeking.
54
55    method write {c data} {
56	my Adler32 -write-variable $data
57	return $data
58    }
59
60    method read {c data} {
61	my Adler32 -read-variable $data
62	return $data
63    }
64
65    # # ## ### ##### ######## #############
66
67    constructor {args} {
68	array set options {
69	    -read-variable  {}
70	    -write-variable {}
71	}
72	# todo: validity checking of options (legal names, legal
73	# values, etc.)
74	array set options $args
75	my Init -read-variable
76	my Init -write-variable
77	return
78    }
79
80    # # ## ### ##### ######## #############
81
82    variable options
83
84    # # ## ### ##### ######## #############
85
86    method Init {o} {
87	if {$options($o) eq ""} return
88	upvar #0 $options($o) adler
89	set adler 1
90	return
91    }
92
93    method Adler32 {o data} {
94	if {$options($o) eq ""} return
95	upvar #0 $options($o) adler
96	set adler [zlib adler32 $data $adler]
97	return
98    }
99}
100
101# # ## ### ##### ######## #############
102package provide tcl::transform::adler32 1
103return
104