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