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