1# bee.tcl -- 2# 3# BitTorrent Bee de- and encoder. 4# 5# Copyright (c) 2004 by Andreas Kupries <andreas_kupries@users.sourceforge.net> 6# See the file license.terms. 7 8package require Tcl 8.4 9 10namespace eval ::bee { 11 # Encoder commands 12 namespace export \ 13 encodeString encodeNumber \ 14 encodeListArgs encodeList \ 15 encodeDictArgs encodeDict 16 17 # Decoder commands. 18 namespace export \ 19 decode \ 20 decodeChannel \ 21 decodeCancel \ 22 decodePush 23 24 # Channel decoders, reference to state information, keyed by 25 # channel handle. 26 27 variable bee 28 array set bee {} 29 30 # Counter for generation of names for the state variables. 31 32 variable count 0 33 34 # State information for the channel decoders. 35 36 # stateN, with N an integer number counting from 0 on up. 37 # ...(chan) Handle of channel the decoder is for. 38 # ...(cmd) Command prefix, completion callback 39 # ...(exact) Boolean flag, set for exact processing. 40 # ...(read) Buffer for new characters to process. 41 # ...(type) Type of current value (integer, string, list, dict) 42 # ...(value) Buffer for assembling the current value. 43 # ...(pend) Stack of pending 'value' buffers, for nested 44 # containers. 45 # ...(state) Current state of the decoding state machine. 46 47 # States of the finite automaton ... 48 # intro - One char, type of value, or 'e' as stop of container. 49 # signum - sign or digit, for integer. 50 # idigit - digit, for integer, or 'e' as stop 51 # ldigit - digit, for length of string, or : 52 # data - string data, 'get' characters. 53 # Containers via 'pend'. 54 55 #Debugging help, nesting level 56 #variable X 0 57} 58 59 60# ::bee::encodeString -- 61# 62# Encode a string to bee-format. 63# 64# Arguments: 65# string The string to encode. 66# 67# Results: 68# The bee-encoded form of the string. 69 70proc ::bee::encodeString {string} { 71 return "[string length $string]:$string" 72} 73 74 75# ::bee::encodeNumber -- 76# 77# Encode an integer number to bee-format. 78# 79# Arguments: 80# num The integer number to encode. 81# 82# Results: 83# The bee-encoded form of the integer number. 84 85proc ::bee::encodeNumber {num} { 86 if {![string is integer -strict $num]} { 87 return -code error "Expected integer number, got \"$num\"" 88 } 89 90 # The reformatting deals with hex, octal and other tcl 91 # representation of the value. In other words we normalize the 92 # string representation of the input value. 93 94 set num [format %d $num] 95 return "i${num}e" 96} 97 98 99# ::bee::encodeList -- 100# 101# Encode a list of bee-coded values to bee-format. 102# 103# Arguments: 104# list The list to encode. 105# 106# Results: 107# The bee-encoded form of the list. 108 109proc ::bee::encodeList {list} { 110 return "l[join $list ""]e" 111} 112 113 114# ::bee::encodeListArgs -- 115# 116# Encode a variable list of bee-coded values to bee-format. 117# 118# Arguments: 119# args The values to encode. 120# 121# Results: 122# The bee-encoded form of the list of values. 123 124proc ::bee::encodeListArgs {args} { 125 return [encodeList $args] 126} 127 128 129# ::bee::encodeDict -- 130# 131# Encode a dictionary of keys and bee-coded values to bee-format. 132# 133# Arguments: 134# dict The dictionary to encode. 135# 136# Results: 137# The bee-encoded form of the dictionary. 138 139proc ::bee::encodeDict {dict} { 140 if {([llength $dict] % 2) == 1} { 141 return -code error "Expected even number of elements, got \"[llength $dict]\"" 142 } 143 set temp [list] 144 foreach {k v} $dict { 145 lappend temp [list $k $v] 146 } 147 set res "d" 148 foreach item [lsort -index 0 $temp] { 149 foreach {k v} $item break 150 append res [encodeString $k]$v 151 } 152 append res "e" 153 return $res 154} 155 156 157# ::bee::encodeDictArgs -- 158# 159# Encode a variable dictionary of keys and bee-coded values to bee-format. 160# 161# Arguments: 162# args The keys and values to encode. 163# 164# Results: 165# The bee-encoded form of the dictionary. 166 167proc ::bee::encodeDictArgs {args} { 168 return [encodeDict $args] 169} 170 171 172# ::bee::decode -- 173# 174# Decode a bee-encoded value and returns the embedded tcl 175# value. For containers this recurses into the contained value. 176# 177# Arguments: 178# value The string containing the bee-encoded value to decode. 179# evar Optional. If set the name of the variable to store the 180# index of the first character after the decoded value to. 181# start Optional. If set the index of the first character of the 182# value to decode. Defaults to 0, i.e. the beginning of the 183# string. 184# 185# Results: 186# The tcl value embedded in the encoded string. 187 188proc ::bee::decode {value {evar {}} {start 0}} { 189 #variable X 190 #puts -nonewline "[string repeat " " $X]decode @$start" ; flush stdout 191 192 if {$evar ne ""} {upvar 1 $evar end} else {set end _} 193 194 if {[string length $value] < ($start+2)} { 195 # This checked that the 'start' index is still in the string, 196 # and the end of the value most likely as well. Note that each 197 # encoded value consists of at least two characters (the 198 # bracketing characters for integer, list, and dict, and for 199 # string at least one digit length and the colon). 200 201 #puts \t[string length $value]\ <\ ($start+2) 202 return -code error "String not large enough for value" 203 } 204 205 set type [string index $value $start] 206 207 #puts -nonewline " $type=" ; flush stdout 208 209 if {$type eq "i"} { 210 # Extract integer 211 #puts -nonewline integer ; flush stdout 212 213 incr start ; # Skip over intro 'i'. 214 set end [string first e $value $start] 215 if {$end < 0} { 216 return -code error "End of integer number not found" 217 } 218 incr end -1 ; # Get last character before closing 'e'. 219 set num [string range $value $start $end] 220 if { 221 [regexp {^-0+$} $num] || 222 ![string is integer -strict $num] || 223 (([string length $num] > 1) && [string match 0* $num]) 224 } { 225 return -code error "Expected integer number, got \"$num\"" 226 } 227 incr end 2 ; # Step after closing 'e' to the beginning of 228 # ........ ; # the next bee-value behind the current one. 229 230 #puts " ($num) @$end" 231 return $num 232 233 } elseif {($type eq "l") || ($type eq "d")} { 234 #puts -nonewline $type\n ; flush stdout 235 236 # Extract list or dictionary, recursively each contained 237 # element. From the perspective of the decoder this is the 238 # same, the tcl representation of both is a list, and for a 239 # dictionary keys and values are also already in the correct 240 # order. 241 242 set result [list] 243 incr start ; # Step over intro 'e' to beginning of the first 244 # ........ ; # contained value, or behind the container (if 245 # ........ ; # empty). 246 247 set end $start 248 #incr X 249 while {[string index $value $start] ne "e"} { 250 lappend result [decode $value end $start] 251 set start $end 252 } 253 #incr X -1 254 incr end 255 256 #puts "[string repeat " " $X]($result) @$end" 257 258 if {$type eq "d" && ([llength $result] % 2 == 1)} { 259 return -code error "Dictionary has to be of even length" 260 } 261 return $result 262 263 } elseif {[string match {[0-9]} $type]} { 264 #puts -nonewline string ; flush stdout 265 266 # Extract string. First the length, bounded by a colon, then 267 # the appropriate number of characters. 268 269 set end [string first : $value $start] 270 if {$end < 0} { 271 return -code error "End of string length not found" 272 } 273 incr end -1 274 set length [string range $value $start $end] 275 incr end 2 ;# Skip to beginning of the string after the colon 276 277 if {![string is integer -strict $length]} { 278 return -code error "Expected integer number for string length, got \"$length\"" 279 } elseif {$length < 0} { 280 # This cannot happen. To happen "-" has to be first character, 281 # and this is caught as unknown bee-type. 282 return -code error "Illegal negative string length" 283 } elseif {($end + $length) > [string length $value]} { 284 return -code error "String not large enough for value" 285 } 286 287 #puts -nonewline \[$length\] ; flush stdout 288 if {$length > 0} { 289 set start $end 290 incr end $length 291 incr end -1 292 set result [string range $value $start $end] 293 incr end 294 } else { 295 set result "" 296 } 297 298 #puts " ($result) @$end" 299 return $result 300 301 } else { 302 return -code error "Unknown bee-type \"$type\"" 303 } 304} 305 306# ::bee::decodeIndices -- 307# 308# Similar to 'decode', but does not return the decoded tcl values, 309# but a structure containing the start- and end-indices for all 310# values in the structure. 311# 312# Arguments: 313# value The string containing the bee-encoded value to decode. 314# evar Optional. If set the name of the variable to store the 315# index of the first character after the decoded value to. 316# start Optional. If set the index of the first character of the 317# value to decode. Defaults to 0, i.e. the beginning of the 318# string. 319# 320# Results: 321# The structure of the value, with indices and types for all 322# contained elements. 323 324proc ::bee::decodeIndices {value {evar {}} {start 0}} { 325 #variable X 326 #puts -nonewline "[string repeat " " $X]decode @$start" ; flush stdout 327 328 if {$evar ne ""} {upvar 1 $evar end} else {set end _} 329 330 if {[string length $value] < ($start+2)} { 331 # This checked that the 'start' index is still in the string, 332 # and the end of the value most likely as well. Note that each 333 # encoded value consists of at least two characters (the 334 # bracketing characters for integer, list, and dict, and for 335 # string at least one digit length and the colon). 336 337 #puts \t[string length $value]\ <\ ($start+2) 338 return -code error "String not large enough for value" 339 } 340 341 set type [string index $value $start] 342 343 #puts -nonewline " $type=" ; flush stdout 344 345 if {$type eq "i"} { 346 # Extract integer 347 #puts -nonewline integer ; flush stdout 348 349 set begin $start 350 351 incr start ; # Skip over intro 'i'. 352 set end [string first e $value $start] 353 if {$end < 0} { 354 return -code error "End of integer number not found" 355 } 356 incr end -1 ; # Get last character before closing 'e'. 357 set num [string range $value $start $end] 358 if { 359 [regexp {^-0+$} $num] || 360 ![string is integer -strict $num] || 361 (([string length $num] > 1) && [string match 0* $num]) 362 } { 363 return -code error "Expected integer number, got \"$num\"" 364 } 365 incr end 366 set stop $end 367 incr end 1 ; # Step after closing 'e' to the beginning of 368 # ........ ; # the next bee-value behind the current one. 369 370 #puts " ($num) @$end" 371 return [list integer $begin $stop] 372 373 } elseif {$type eq "l"} { 374 #puts -nonewline $type\n ; flush stdout 375 376 # Extract list, recursively each contained element. 377 378 set result [list] 379 380 lappend result list $start @ 381 382 incr start ; # Step over intro 'e' to beginning of the first 383 # ........ ; # contained value, or behind the container (if 384 # ........ ; # empty). 385 386 set end $start 387 #incr X 388 389 set contained [list] 390 while {[string index $value $start] ne "e"} { 391 lappend contained [decodeIndices $value end $start] 392 set start $end 393 } 394 lappend result $contained 395 #incr X -1 396 set stop $end 397 incr end 398 399 #puts "[string repeat " " $X]($result) @$end" 400 401 return [lreplace $result 2 2 $stop] 402 403 } elseif {($type eq "l") || ($type eq "d")} { 404 #puts -nonewline $type\n ; flush stdout 405 406 # Extract dictionary, recursively each contained element. 407 408 set result [list] 409 410 lappend result dict $start @ 411 412 incr start ; # Step over intro 'e' to beginning of the first 413 # ........ ; # contained value, or behind the container (if 414 # ........ ; # empty). 415 416 set end $start 417 set atkey 1 418 #incr X 419 420 set contained [list] 421 set val [list] 422 while {[string index $value $start] ne "e"} { 423 if {$atkey} { 424 lappend contained [decode $value {} $start] 425 lappend val [decodeIndices $value end $start] 426 set atkey 0 427 } else { 428 lappend val [decodeIndices $value end $start] 429 lappend contained $val 430 set val [list] 431 set atkey 1 432 } 433 set start $end 434 } 435 lappend result $contained 436 #incr X -1 437 set stop $end 438 incr end 439 440 #puts "[string repeat " " $X]($result) @$end" 441 442 if {[llength $result] % 2 == 1} { 443 return -code error "Dictionary has to be of even length" 444 } 445 return [lreplace $result 2 2 $stop] 446 447 } elseif {[string match {[0-9]} $type]} { 448 #puts -nonewline string ; flush stdout 449 450 # Extract string. First the length, bounded by a colon, then 451 # the appropriate number of characters. 452 453 set end [string first : $value $start] 454 if {$end < 0} { 455 return -code error "End of string length not found" 456 } 457 incr end -1 458 set length [string range $value $start $end] 459 incr end 2 ;# Skip to beginning of the string after the colon 460 461 if {![string is integer -strict $length]} { 462 return -code error "Expected integer number for string length, got \"$length\"" 463 } elseif {$length < 0} { 464 # This cannot happen. To happen "-" has to be first character, 465 # and this is caught as unknown bee-type. 466 return -code error "Illegal negative string length" 467 } elseif {($end + $length) > [string length $value]} { 468 return -code error "String not large enough for value" 469 } 470 471 #puts -nonewline \[$length\] ; flush stdout 472 incr end -1 473 if {$length > 0} { 474 incr end $length 475 set stop $end 476 } else { 477 set stop $end 478 } 479 incr end 480 481 #puts " ($result) @$end" 482 return [list string $start $stop] 483 484 } else { 485 return -code error "Unknown bee-type \"$type\"" 486 } 487} 488 489 490# ::bee::decodeChannel -- 491# 492# Attach decoder for a bee-value to a channel. See the 493# documentation for details. 494# 495# Arguments: 496# chan Channel to attach to. 497# -command cmdprefix Completion callback. Required. 498# -exact Keep running after completion. 499# -prefix data Seed for decode buffer. 500# 501# Results: 502# A token to use when referring to the decoder. 503# For example when canceling it. 504 505proc ::bee::decodeChannel {chan args} { 506 variable bee 507 if {[info exists bee($chan)]} { 508 return -code error "bee-Decoder already active for channel" 509 } 510 511 # Create state and token. 512 513 variable count 514 variable [set st state$count] 515 array set $st {} 516 set bee($chan) $st 517 upvar 0 $st state 518 incr count 519 520 # Initialize the decoder state, process the options. When 521 # encountering errors here destroy the half-baked state before 522 # throwing the message. 523 524 set state(chan) $chan 525 array set state { 526 exact 0 527 type ? 528 read {} 529 value {} 530 pend {} 531 state intro 532 get 1 533 } 534 535 while {[llength $args]} { 536 set option [lindex $args 0] 537 set args [lrange $args 1 end] 538 if {$option eq "-command"} { 539 if {![llength $args]} { 540 unset bee($chan) 541 unset state 542 return -code error "Missing value for option -command." 543 } 544 set state(cmd) [lindex $args 0] 545 set args [lrange $args 1 end] 546 547 } elseif {$option eq "-prefix"} { 548 if {![llength $args]} { 549 unset bee($chan) 550 unset state 551 return -code error "Missing value for option -prefix." 552 } 553 set state(read) [lindex $args 0] 554 set args [lrange $args 1 end] 555 556 } elseif {$option eq "-exact"} { 557 set state(exact) 1 558 } else { 559 unset bee($chan) 560 unset state 561 return -code error "Illegal option \"$option\",\ 562 expected \"-command\", \"-prefix\", or \"-keep\"" 563 } 564 } 565 566 if {![info exists state(cmd)]} { 567 unset bee($chan) 568 unset state 569 return -code error "Missing required completion callback." 570 } 571 572 # Set up the processing of incoming data. 573 574 fileevent $chan readable [list ::bee::Process $chan $bee($chan)] 575 576 # Return the name of the state array as token. 577 return $bee($chan) 578} 579 580# ::bee::Parse -- 581# 582# Internal helper. Fileevent handler for a decoder. 583# Parses input and handles both error and eof conditions. 584# 585# Arguments: 586# token The decoder to run on its input. 587# 588# Results: 589# None. 590 591proc ::bee::Process {chan token} { 592 if {[catch {Parse $token} msg]} { 593 # Something failed. Destroy and report. 594 Command $token error $msg 595 return 596 } 597 598 if {[eof $chan]} { 599 # Having data waiting, either in the input queue, or in the 600 # output stack (of nested containers) is a failure. Report 601 # this instead of the eof. 602 603 variable $token 604 upvar 0 $token state 605 606 if { 607 [string length $state(read)] || 608 [llength $state(pend)] || 609 [string length $state(value)] || 610 ($state(state) ne "intro") 611 } { 612 Command $token error "Incomplete value at end of channel" 613 } else { 614 Command $token eof 615 } 616 } 617 return 618} 619 620# ::bee::Parse -- 621# 622# Internal helper. Reading from the channel and parsing the input. 623# Uses a hardwired state machine. 624# 625# Arguments: 626# token The decoder to run on its input. 627# 628# Results: 629# None. 630 631proc ::bee::Parse {token} { 632 variable $token 633 upvar 0 $token state 634 upvar 0 state(state) current 635 upvar 0 state(read) input 636 upvar 0 state(type) type 637 upvar 0 state(value) value 638 upvar 0 state(pend) pend 639 upvar 0 state(exact) exact 640 upvar 0 state(get) get 641 set chan $state(chan) 642 643 #puts Parse/$current 644 645 if {!$exact} { 646 # Add all waiting characters to the buffer so that we can process as 647 # much as is possible in one go. 648 append input [read $chan] 649 } else { 650 # Exact reading. Usually one character, but when in the data 651 # section for a string value we know for how many characters 652 # we are looking for. 653 654 append input [read $chan $get] 655 } 656 657 # We got nothing, do nothing. 658 if {![string length $input]} return 659 660 661 if {$current eq "data"} { 662 # String data, this can be done faster, as we read longer 663 # sequences of characters for this. 664 set l [string length $input] 665 if {$l < $get} { 666 # Not enough, wait for more. 667 append value $input 668 incr get -$l 669 return 670 } elseif {$l == $get} { 671 # Got all, exactly. Prepare state machine for next value. 672 673 if {[Complete $token $value$input]} return 674 675 set current intro 676 set get 1 677 set value "" 678 set input "" 679 680 return 681 } else { 682 # Got more than required (only for !exact). 683 684 incr get -1 685 if {[Complete $token $value[string range $input 0 $get]]} {return} 686 687 incr get 688 set input [string range $input $get end] 689 set get 1 690 set value "" 691 set current intro 692 # This now falls into the loop below. 693 } 694 } 695 696 set where 0 697 set n [string length $input] 698 699 #puts Parse/$n 700 701 while {$where < $n} { 702 # Hardwired state machine. Get current character. 703 set ch [string index $input $where] 704 705 #puts Parse/@$where/$current/$ch/ 706 if {$current eq "intro"} { 707 # First character of a value. 708 709 if {$ch eq "i"} { 710 # Begin reading integer. 711 set type integer 712 set current signum 713 } elseif {$ch eq "l"} { 714 # Begin a list. 715 set type list 716 lappend pend list {} 717 #set current intro 718 719 } elseif {$ch eq "d"} { 720 # Begin a dictionary. 721 set type dict 722 lappend pend dict {} 723 #set current intro 724 725 } elseif {$ch eq "e"} { 726 # Close a container. Throw an error if there is no 727 # container to close. 728 729 if {![llength $pend]} { 730 return -code error "End of container outside of container." 731 } 732 733 set v [lindex $pend end] 734 set t [lindex $pend end-1] 735 set pend [lrange $pend 0 end-2] 736 737 if {$t eq "dict" && ([llength $v] % 2 == 1)} { 738 return -code error "Dictionary has to be of even length" 739 } 740 741 if {[Complete $token $v]} {return} 742 set current intro 743 744 } elseif {[string match {[0-9]} $ch]} { 745 # Begin reading a string, length section first. 746 set type string 747 set current ldigit 748 set value $ch 749 750 } else { 751 # Unknown type. Throw error. 752 return -code error "Unknown bee-type \"$ch\"" 753 } 754 755 # To next character. 756 incr where 757 } elseif {$current eq "signum"} { 758 # Integer number, a minus sign, or a digit. 759 if {[string match {[-0-9]} $ch]} { 760 append value $ch 761 set current idigit 762 } else { 763 return -code error "Syntax error in integer,\ 764 expected sign or digit, got \"$ch\"" 765 } 766 incr where 767 768 } elseif {$current eq "idigit"} { 769 # Integer number, digit or closing 'e'. 770 771 if {[string match {[-0-9]} $ch]} { 772 append value $ch 773 } elseif {$ch eq "e"} { 774 # Integer closes. Validate and report. 775 #puts validate 776 if { 777 [regexp {^-0+$} $value] || 778 ![string is integer -strict $value] || 779 (([string length $value] > 1) && [string match 0* $value]) 780 } { 781 return -code error "Expected integer number, got \"$value\"" 782 } 783 784 if {[Complete $token $value]} {return} 785 set value "" 786 set current intro 787 } else { 788 return -code error "Syntax error in integer,\ 789 expected digit, or 'e', got \"$ch\"" 790 } 791 incr where 792 793 } elseif {$current eq "ldigit"} { 794 # String, length section, digit, or : 795 796 if {[string match {[-0-9]} $ch]} { 797 append value $ch 798 799 } elseif {$ch eq ":"} { 800 # Length section closes, validate, 801 # then perform data processing. 802 803 set num $value 804 if { 805 [regexp {^-0+$} $num] || 806 ![string is integer -strict $num] || 807 (([string length $num] > 1) && [string match 0* $num]) 808 } { 809 return -code error "Expected integer number as string length, got \"$num\"" 810 } 811 812 set value "" 813 814 # We may have already part of the data in 815 # memory. Process that piece before looking for more. 816 817 incr where 818 set have [expr {$n - $where}] 819 if {$num < $have} { 820 # More than enough in the buffer. 821 822 set end $where 823 incr end $num 824 incr end -1 825 826 if {[Complete $token [string range $input $where $end]]} {return} 827 828 set where $end ;# Further processing behind the string. 829 set current intro 830 831 } elseif {$num == $have} { 832 # Just enough. 833 834 if {[Complete $token [string range $input $where end]]} {return} 835 836 set where $n 837 set current intro 838 } else { 839 # Not enough. Initialize value with the data we 840 # have (after the colon) and stop processing for 841 # now. 842 843 set value [string range $input $where end] 844 set current data 845 set get $num 846 set input "" 847 return 848 } 849 } else { 850 return -code error "Syntax error in string length,\ 851 expected digit, or ':', got \"$ch\"" 852 } 853 incr where 854 } else { 855 # unknown state = internal error 856 return -code error "Unknown decoder state \"$current\", internal error" 857 } 858 } 859 860 set input "" 861 return 862} 863 864# ::bee::Command -- 865# 866# Internal helper. Runs the decoder command callback. 867# 868# Arguments: 869# token The decoder invoking its callback 870# how Which method to invoke (value, error, eof) 871# args Arguments for the method. 872# 873# Results: 874# A boolean flag. Set if further processing has to stop. 875 876proc ::bee::Command {token how args} { 877 variable $token 878 upvar 0 $token state 879 880 #puts Report/$token/$how/$args/ 881 882 set cmd $state(cmd) 883 set chan $state(chan) 884 885 # We catch the fileevents because they will fail when this is 886 # called from the 'Close'. The channel will already be gone in 887 # that case. 888 889 set stop 0 890 if {($how eq "error") || ($how eq "eof")} { 891 variable bee 892 893 set stop 1 894 fileevent $chan readable {} 895 unset bee($chan) 896 unset state 897 898 if {$how eq "eof"} { 899 #puts \tclosing/$chan 900 close $chan 901 } 902 } 903 904 lappend cmd $how $token 905 foreach a $args {lappend cmd $a} 906 uplevel #0 $cmd 907 908 if {![info exists state]} { 909 # The decoder token was killed by the callback, stop 910 # processing. 911 set stop 1 912 } 913 914 #puts /$stop/[file channels] 915 return $stop 916} 917 918# ::bee::Complete -- 919# 920# Internal helper. Reports a completed value. 921# 922# Arguments: 923# token The decoder reporting the value. 924# value The value to report. 925# 926# Results: 927# A boolean flag. Set if further processing has to stop. 928 929proc ::bee::Complete {token value} { 930 variable $token 931 upvar 0 $token state 932 upvar 0 state(pend) pend 933 934 if {[llength $pend]} { 935 # The value is part of a container. Add the value to its end 936 # and keep processing. 937 938 set pend [lreplace $pend end end \ 939 [linsert [lindex $pend end] end \ 940 $value]] 941 942 # Don't stop. 943 return 0 944 } 945 946 # The value is at the top, report it. The callback determines if 947 # we keep processing. 948 949 return [Command $token value $value] 950} 951 952# ::bee::decodeCancel -- 953# 954# Destroys the decoder referenced by the token. 955# 956# Arguments: 957# token The decoder to destroy. 958# 959# Results: 960# None. 961 962proc ::bee::decodeCancel {token} { 963 variable bee 964 variable $token 965 upvar 0 $token state 966 unset bee($state(chan)) 967 unset state 968 return 969} 970 971# ::bee::decodePush -- 972# 973# Push data into the decoder input buffer. 974# 975# Arguments: 976# token The decoder to extend. 977# string The characters to add. 978# 979# Results: 980# None. 981 982proc ::bee::decodePush {token string} { 983 variable $token 984 upvar 0 $token state 985 append state(read) $string 986 return 987} 988 989 990package provide bee 0.1 991