1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
|
# -*- tcl -*-
# ### ### ### ######### ######### #########
##
# Class for the handling of stream sources.
# ### ### ### ######### ######### #########
## Requirements
package require transfer::copy ; # Data transmission core
package require snit
# ### ### ### ######### ######### #########
## Implementation
snit::type ::transfer::data::source {
# ### ### ### ######### ######### #########
## API
# Source is ...
option -string {} ; # a string.
option -channel {} ; # an open & readable channel.
option -file {} ; # a file.
option -variable {} ; # a string held by the named variable.
option -size -1 ; # number of characters to transfer.
method type {} {}
method data {} {}
method size {} {}
method valid {mv} {}
method transmit {sock blocksize done} {}
# ### ### ### ######### ######### #########
## Implementation
method type {} {
return $xtype
}
method data {} {
switch -exact -- $etype {
undefined {
return -code error "Data source is undefined"
}
string - chan {
return $value
}
variable {
upvar \#0 $value thevalue
return $thevalue
}
file {
return [open $value r]
}
}
}
method size {} {
if {$options(-size) < 0} {
switch -exact -- $etype {
undefined {
return -code error "Data source is undefined"
}
string {
return [string length $value]
}
variable {
upvar \#0 $value thevalue
return [string length $thevalue]
}
chan - file {
# Nothing, -1 passes through
# We do not use [file size] for a file, as a
# user-specified encoding may distort the
# counting.
}
}
}
return $options(-size)
}
method valid {mv} {
upvar 1 $mv message
switch -exact -- $etype {
undefined {
set message "Data source is undefined"
return 0
}
string - variable {
if {[$self size] > [string length [$self data]]} {
set message "Not enough data to transmit"
return 0
}
}
chan {
# Additional check of option ?
}
file {
# Additional check of option ?
}
}
return 1
}
method transmit {sock blocksize done} {
::transfer::copy::do \
[$self type] [$self data] $sock \
-size [$self size] \
-blocksize $blocksize \
-command $done
return
}
# ### ### ### ######### ######### #########
## Internal helper commands.
onconfigure -string {newvalue} {
set etype string
set xtype string
set value $newvalue
return
}
onconfigure -variable {newvalue} {
set etype variable
set xtype string
if {![uplevel \#0 {info exists $newvalue}]} {
return -code error "Bad variable \"$newvalue\", does not exist"
}
set value $newvalue
return
}
onconfigure -channel {newvalue} {
if {![llength [file channels $newvalue]]} {
return -code error "Bad channel handle \"$newvalue\", does not exist"
}
set etype chan
set xtype chan
set value $newvalue
return
}
onconfigure -file {newvalue} {
if {![file exists $newvalue]} {
return -code error "File \"$newvalue\" does not exist"
}
if {![file readable $newvalue]} {
return -code error "File \"$newvalue\" not readable"
}
if {![file isfile $newvalue]} {
return -code error "File \"$newvalue\" not a file"
}
set etype file
set xtype chan
set value $newvalue
return
}
# ### ### ### ######### ######### #########
## Data structures
variable etype undefined
variable xtype undefined
variable value
##
# ### ### ### ######### ######### #########
}
# ### ### ### ######### ######### #########
## Ready
package provide transfer::data::source 0.1
|
