1# -*- tcl -*-
2# ### ### ### ######### ######### #########
3##
4# Transfer class. Sending of data.
5##
6# Utilizes data source and connect components to handle the
7# general/common parts.
8
9# ### ### ### ######### ######### #########
10## Requirements
11
12package require snit
13package require transfer::data::source ; # Data source
14package require transfer::connect      ; # Connection startup
15
16# ### ### ### ######### ######### #########
17## Implementation
18
19snit::type ::transfer::transmitter {
20
21    # ### ### ### ######### ######### #########
22    ## Convenient fire and forget file/channel transmission operations.
23
24    typemethod {stream channel} {chan host port args} {
25	# Select stream configuration ( host => active, otherwise
26	# passive)
27	if {$host eq {}} {
28	    set cmd [linsert $args 0 $type %AUTO% \
29			 -channel $chan -port $port \
30			 -mode passive -translation binary]
31	} else {
32	    set cmd [linsert $args 0 $type %AUTO% \
33			 -channel $chan -host $host -port $port \
34			 -mode active -translation binary]
35	}
36
37	# Create a transient transmitter controller, and wrap our own
38	# internal completion handling around the user supplied
39	# callback.
40
41	set transmitter [eval $cmd]
42	$transmitter configure \
43	    -command [mytypemethod Done \
44			  $chan [$transmitter cget -command]]
45
46	# Begin transmission (or wait for other side to connect).
47	return [$transmitter start]
48    }
49
50    typemethod {stream file} {file host port args} {
51	set chan [open $file r]
52	fconfigure $chan -translation binary
53
54	return [eval [linsert $args 0 $type stream channel $chan $host $port]]
55    }
56
57    typemethod Done {chan command transmitter n {err {}}} {
58	close $chan
59	$transmitter destroy
60
61	if {![llength $command]} return
62
63	after 0 [linsert $command end $n $err]
64	return
65    }
66
67    # ### ### ### ######### ######### #########
68    ## API
69
70    ## Data source sub component
71
72    delegate option -string   to mysource
73    delegate option -channel  to mysource
74    delegate option -file     to mysource
75    delegate option -variable to mysource
76    delegate option -size     to mysource
77    delegate option -progress to mysource
78
79    ## Connection management sub component
80
81    delegate option -host        to myconnect
82    delegate option -port        to myconnect
83    delegate option -mode        to myconnect
84    delegate option -translation to myconnect
85    delegate option -encoding    to myconnect
86    delegate option -eofchar     to myconnect
87    delegate option -socketcmd   to myconnect
88
89    ## Transmitter configuration, and API
90
91    option -command   -default {}
92    option -blocksize -default 1024 -type {snit::integer -min 1}
93
94    constructor {args} {}
95
96    method start {} {}
97    method busy  {} {}
98
99    # ### ### ### ######### ######### #########
100    ## Implementation
101
102    constructor {args} {
103	set mybusy 0
104	install mysource  using ::transfer::data::source ${selfns}::source
105	install myconnect using ::transfer::connect      ${selfns}::conn
106	$self configurelist $args
107	return
108    }
109
110    method start {} {
111	if {$mybusy} {
112	    return -code error "Object is busy"
113	}
114
115	if {![$mysource valid msg]} {
116	    return -code error $msg
117	}
118
119	if {$options(-command) eq ""} {
120	    return -code error "Completion callback is missing"
121	}
122
123	set mybusy 1
124	return [$myconnect connect [mymethod Begin]]
125    }
126
127    method busy {} {
128	return $mybusy
129    }
130
131    # ### ### ### ######### ######### #########
132    ## Internal helper commands.
133
134    method Begin {__ sock} {
135	# __ <=> myconnect
136	$mysource transmit $sock \
137		$options(-blocksize) \
138		[mymethod Done $sock]
139	return
140    }
141
142    method Done {sock args} {
143	# args is either (n),
144	#             or (n errormessage)
145
146	set mybusy 0
147	close $sock
148	$self Complete $args
149	return
150    }
151
152    method Complete {arguments} {
153	# 8.5: {*}$options(-command) $self {*}$arguments
154	set     cmd $options(-command)
155	lappend cmd $self
156	foreach a $arguments {lappend cmd $a}
157
158	uplevel #0 $cmd
159	return
160    }
161
162    # ### ### ### ######### ######### #########
163    ## Data structures
164
165    component mysource    ; # Data source providing the bytes to transfer
166    component myconnect   ; # Connector controlling where to the data transfered to.
167    variable  mybusy    0 ; # Transfer status.
168
169    ##
170    # ### ### ### ######### ######### #########
171}
172
173# ### ### ### ######### ######### #########
174## Ready
175
176package provide transfer::transmitter 0.2
177