| [8597867d] | 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 | |
|---|
| 12 | package require snit |
|---|
| 13 | package require transfer::data::destination ; # Data destination |
|---|
| 14 | package require transfer::connect ; # Connection startup |
|---|
| 15 | |
|---|
| 16 | # ### ### ### ######### ######### ######### |
|---|
| 17 | ## Implementation |
|---|
| 18 | |
|---|
| 19 | snit::type ::transfer::receiver { |
|---|
| 20 | |
|---|
| 21 | # ### ### ### ######### ######### ######### |
|---|
| 22 | ## API |
|---|
| 23 | |
|---|
| 24 | ## Data destination sub component |
|---|
| 25 | |
|---|
| 26 | delegate option -channel to dest |
|---|
| 27 | delegate option -file to dest |
|---|
| 28 | delegate option -variable to dest |
|---|
| 29 | |
|---|
| 30 | ## Connection management sub component |
|---|
| 31 | |
|---|
| 32 | delegate option -host to conn |
|---|
| 33 | delegate option -port to conn |
|---|
| 34 | delegate option -mode to conn |
|---|
| 35 | delegate option -translation to conn |
|---|
| 36 | delegate option -encoding to conn |
|---|
| 37 | delegate option -eofchar to conn |
|---|
| 38 | |
|---|
| 39 | ## Receiver configuration, and API |
|---|
| 40 | |
|---|
| 41 | option -command {} |
|---|
| 42 | |
|---|
| 43 | constructor {args} {} |
|---|
| 44 | |
|---|
| 45 | method start {} {} |
|---|
| 46 | method busy {} {} |
|---|
| 47 | |
|---|
| 48 | # ### ### ### ######### ######### ######### |
|---|
| 49 | ## Implementation |
|---|
| 50 | |
|---|
| 51 | constructor {args} { |
|---|
| 52 | set dest [::transfer::data::destination ${selfns}::dest] |
|---|
| 53 | set conn [::transfer::connect ${selfns}::conn] |
|---|
| 54 | set busy 0 |
|---|
| 55 | |
|---|
| 56 | $self configurelist $args |
|---|
| 57 | return |
|---|
| 58 | } |
|---|
| 59 | |
|---|
| 60 | method start {} { |
|---|
| 61 | if {$busy} { |
|---|
| 62 | return -code error "Object is busy" |
|---|
| 63 | } |
|---|
| 64 | |
|---|
| 65 | if {![$dest valid msg]} { |
|---|
| 66 | return -code error $msg |
|---|
| 67 | } |
|---|
| 68 | |
|---|
| 69 | if {$options(-command) eq ""} { |
|---|
| 70 | return -code error "Completion callback is missing" |
|---|
| 71 | } |
|---|
| 72 | |
|---|
| 73 | set busy 1 |
|---|
| 74 | return [$conn connect [mymethod Begin]] |
|---|
| 75 | } |
|---|
| 76 | |
|---|
| 77 | method busy {} { |
|---|
| 78 | return $busy |
|---|
| 79 | } |
|---|
| 80 | |
|---|
| 81 | # ### ### ### ######### ######### ######### |
|---|
| 82 | ## Internal helper commands. |
|---|
| 83 | |
|---|
| 84 | method Begin {__ sock} { |
|---|
| 85 | # __ == conn |
|---|
| 86 | $dest receive $sock \ |
|---|
| 87 | [mymethod Done $sock] |
|---|
| 88 | return |
|---|
| 89 | } |
|---|
| 90 | |
|---|
| 91 | method Done {sock args} { |
|---|
| 92 | # args is either (n), |
|---|
| 93 | # or (n errormessage) |
|---|
| 94 | |
|---|
| 95 | set busy 0 |
|---|
| 96 | close $sock |
|---|
| 97 | $self Complete $args |
|---|
| 98 | return |
|---|
| 99 | } |
|---|
| 100 | |
|---|
| 101 | method Complete {alist} { |
|---|
| 102 | set cmd $options(-command) |
|---|
| 103 | lappend cmd $self |
|---|
| 104 | foreach a $alist {lappend cmd $a} |
|---|
| 105 | |
|---|
| 106 | uplevel #0 $cmd |
|---|
| 107 | return |
|---|
| 108 | |
|---|
| 109 | # 8.5: {*}$options(-command) {*}$alist |
|---|
| 110 | } |
|---|
| 111 | |
|---|
| 112 | # ### ### ### ######### ######### ######### |
|---|
| 113 | ## Data structures |
|---|
| 114 | |
|---|
| 115 | variable dest |
|---|
| 116 | variable conn |
|---|
| 117 | variable busy |
|---|
| 118 | |
|---|
| 119 | ## |
|---|
| 120 | # ### ### ### ######### ######### ######### |
|---|
| 121 | } |
|---|
| 122 | |
|---|
| 123 | # ### ### ### ######### ######### ######### |
|---|
| 124 | ## Ready |
|---|
| 125 | |
|---|
| 126 | package provide transfer::receiver 0.1 |
|---|