1# -*- tcl -*- 2# ### ### ### ######### ######### ######### 3## 4# Transfer class. Reception of data. 5## 6# Utilizes data destination and connect components to handle the 7# general/common parts. 8 9# ### ### ### ######### ######### ######### 10## Requirements 11 12package require snit 13package require transfer::data::destination ; # Data destination 14package require transfer::connect ; # Connection startup 15 16# ### ### ### ######### ######### ######### 17## Implementation 18 19snit::type ::transfer::receiver { 20 21 # ### ### ### ######### ######### ######### 22 ## Convenient fire and forget file/channel reception 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 receiver [eval $cmd] 42 $receiver configure \ 43 -command [mytypemethod Done \ 44 [$receiver cget -command]] 45 46 # Begin transmission (or wait for other side to connect). 47 return [$receiver start] 48 } 49 50 typemethod {stream file} {file host port args} { 51 set chan [open $file w] 52 fconfigure $chan -translation binary 53 54 set receiver [eval [linsert $args 0 $type stream channel $chan $host $port]] 55 56 # Redo completion command callback. 57 $receiver configure \ 58 -command [mytypemethod DoneFile $chan \ 59 [lindex [$receiver cget -command] end]] 60 return $receiver 61 } 62 63 typemethod Done {command receiver n {err {}}} { 64 $receiver destroy 65 66 if {![llength $command]} return 67 68 after 0 [linsert $command end $n $err] 69 return 70 } 71 72 typemethod DoneFile {chan command receiver n {err {}}} { 73 close $chan 74 $receiver destroy 75 76 if {![llength $command]} return 77 78 after 0 [linsert $command end $n $err] 79 return 80 } 81 82 # ### ### ### ######### ######### ######### 83 ## API 84 85 ## Data destination sub component 86 87 delegate option -channel to mydestination 88 delegate option -file to mydestination 89 delegate option -variable to mydestination 90 delegate option -progress to mydestination 91 92 ## Connection management sub component 93 94 delegate option -host to myconnect 95 delegate option -port to myconnect 96 delegate option -mode to myconnect 97 delegate option -translation to myconnect 98 delegate option -encoding to myconnect 99 delegate option -eofchar to myconnect 100 delegate option -socketcmd to myconnect 101 102 ## Receiver configuration, and API 103 104 option -command -default {} 105 106 constructor {args} {} 107 108 method start {} {} 109 method busy {} {} 110 111 # ### ### ### ######### ######### ######### 112 ## Implementation 113 114 constructor {args} { 115 set mybusy 0 116 install mydestination using ::transfer::data::destination ${selfns}::dest 117 install myconnect using ::transfer::connect ${selfns}::conn 118 119 $self configurelist $args 120 return 121 } 122 123 method start {} { 124 if {$mybusy} { 125 return -code error "Object is busy" 126 } 127 128 if {![$mydestination valid msg]} { 129 return -code error $msg 130 } 131 132 if {$options(-command) eq ""} { 133 return -code error "Completion callback is missing" 134 } 135 136 set mybusy 1 137 return [$myconnect connect [mymethod Begin]] 138 } 139 140 method busy {} { 141 return $mybusy 142 } 143 144 # ### ### ### ######### ######### ######### 145 ## Internal helper commands. 146 147 method Begin {__ sock} { 148 # __ == myconnect 149 $mydestination receive $sock \ 150 [mymethod Done $sock] 151 return 152 } 153 154 method Done {sock args} { 155 # args is either (n), 156 # or (n errormessage) 157 158 set mybusy 0 159 close $sock 160 $self Complete $args 161 return 162 } 163 164 method Complete {arguments} { 165 # 8.5: {*}$options(-command) $self {*}$arguments 166 set cmd $options(-command) 167 lappend cmd $self 168 foreach a $arguments {lappend cmd $a} 169 170 uplevel #0 $cmd 171 return 172 } 173 174 # ### ### ### ######### ######### ######### 175 ## Data structures 176 177 component mydestination ; # Data destination the transfered bytes are delivered to 178 component myconnect ; # Connector controlling where to get the data from. 179 variable mybusy 0 ; # Transfer status. 180 181 ## 182 # ### ### ### ######### ######### ######### 183} 184 185# ### ### ### ######### ######### ######### 186## Ready 187 188package provide transfer::receiver 0.2 189