Artifact
b131423df32c51b1e38b93d8d68665c54f3f0779:
- File
modules/base32/base32_tcl.tcl
— part of check-in
[5fd2827621]
at
2006-05-27 20:44:36
on branch trunk
— Base32 implementation (Tcl, Critcl | std, hex), Tcl support
package. Documentation. Testsuites. Benchmarks.
(user:
andreas_kupries
size: 1701)
0000: 23 20 2d 2a 2d 20 74 63 6c 20 2d 2a 2d 0a 23 20 # -*- tcl -*-.#
0010: 54 68 69 73 20 63 6f 64 65 20 69 73 20 68 65 72 This code is her
0020: 65 62 79 20 70 75 74 20 69 6e 74 6f 20 74 68 65 eby put into the
0030: 20 70 75 62 6c 69 63 20 64 6f 6d 61 69 6e 2e 0a public domain..
0040: 23 20 23 23 23 20 23 23 23 20 23 23 23 20 23 23 # ### ### ### ##
0050: 23 23 23 23 23 23 23 20 23 23 23 23 23 23 23 23 ####### ########
0060: 23 20 23 23 23 23 23 23 23 23 23 0a 23 23 20 4f # #########.## O
0070: 76 65 72 76 69 65 77 0a 23 20 42 61 73 65 33 32 verview.# Base32
0080: 20 65 6e 63 6f 64 69 6e 67 20 61 6e 64 20 64 65 encoding and de
0090: 63 6f 64 69 6e 67 20 6f 66 20 73 6d 61 6c 6c 20 coding of small
00a0: 73 74 72 69 6e 67 73 2e 0a 0a 23 20 23 23 23 20 strings...# ###
00b0: 23 23 23 20 23 23 23 20 23 23 23 23 23 23 23 23 ### ### ########
00c0: 23 20 23 23 23 23 23 23 23 23 23 20 23 23 23 23 # ######### ####
00d0: 23 23 23 23 23 0a 23 23 20 4e 6f 74 65 73 0a 0a #####.## Notes..
00e0: 23 20 41 20 62 69 6e 61 72 79 20 73 74 72 69 6e # A binary strin
00f0: 67 20 69 73 20 73 70 6c 69 74 20 69 6e 74 6f 20 g is split into
0100: 67 72 6f 75 70 73 20 6f 66 20 35 20 62 69 74 73 groups of 5 bits
0110: 20 28 32 5e 35 20 3d 3d 20 33 32 29 2c 20 61 6e (2^5 == 32), an
0120: 64 20 65 61 63 68 0a 23 20 67 72 6f 75 70 20 69 d each.# group i
0130: 73 20 63 6f 6e 76 65 72 74 65 64 20 69 6e 74 6f s converted into
0140: 20 61 20 70 72 69 6e 74 61 62 6c 65 20 63 68 61 a printable cha
0150: 72 61 63 74 65 72 20 61 73 20 69 73 20 73 70 65 racter as is spe
0160: 63 69 66 69 65 64 20 69 6e 20 52 46 43 0a 23 20 cified in RFC.#
0170: 33 35 34 38 2e 0a 0a 23 20 23 23 23 20 23 23 23 3548...# ### ###
0180: 20 23 23 23 20 23 23 23 23 23 23 23 23 23 20 23 ### ######### #
0190: 23 23 23 23 23 23 23 23 20 23 23 23 23 23 23 23 ######## #######
01a0: 23 23 0a 23 23 20 52 65 71 75 69 73 69 74 65 73 ##.## Requisites
01b0: 0a 0a 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
01c0: 65 20 20 62 61 73 65 33 32 3a 3a 63 6f 72 65 0a e base32::core.
01d0: 6e 61 6d 65 73 70 61 63 65 20 65 76 61 6c 20 3a namespace eval :
01e0: 3a 62 61 73 65 33 32 20 7b 7d 0a 0a 23 20 23 23 :base32 {}..# ##
01f0: 23 20 23 23 23 20 23 23 23 20 23 23 23 23 23 23 # ### ### ######
0200: 23 23 23 20 23 23 23 23 23 23 23 23 23 20 23 23 ### ######### ##
0210: 23 23 23 23 23 23 23 0a 23 23 20 41 50 49 20 26 #######.## API &
0220: 20 49 6d 70 6c 65 6d 65 6e 74 61 74 69 6f 6e 0a Implementation.
0230: 0a 70 72 6f 63 20 3a 3a 62 61 73 65 33 32 3a 3a .proc ::base32::
0240: 74 63 6c 5f 65 6e 63 6f 64 65 20 7b 62 69 74 73 tcl_encode {bits
0250: 74 72 69 6e 67 7d 20 7b 0a 20 20 20 20 76 61 72 tring} {. var
0260: 69 61 62 6c 65 20 66 6f 72 77 61 72 64 0a 0a 20 iable forward..
0270: 20 20 20 62 69 6e 61 72 79 20 73 63 61 6e 20 24 binary scan $
0280: 62 69 74 73 74 72 69 6e 67 20 42 2a 20 62 69 74 bitstring B* bit
0290: 73 0a 20 20 20 20 73 65 74 20 6c 65 6e 20 5b 73 s. set len [s
02a0: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 62 69 tring length $bi
02b0: 74 73 5d 0a 20 20 20 20 73 65 74 20 72 65 6d 20 ts]. set rem
02c0: 5b 65 78 70 72 20 7b 24 6c 65 6e 20 25 20 35 7d [expr {$len % 5}
02d0: 5d 0a 20 20 20 20 69 66 20 7b 24 72 65 6d 7d 20 ]. if {$rem}
02e0: 7b 61 70 70 65 6e 64 20 62 69 74 73 20 3d 2f 24 {append bits =/$
02f0: 72 65 6d 7d 0a 20 20 20 20 23 70 75 74 73 20 22 rem}. #puts "
0300: 28 24 62 69 74 73 74 72 69 6e 67 29 20 3d 3e 20 ($bitstring) =>
0310: 3c 24 62 69 74 73 3e 22 0a 0a 20 20 20 20 72 65 <$bits>".. re
0320: 74 75 72 6e 20 5b 73 74 72 69 6e 67 20 6d 61 70 turn [string map
0330: 20 24 66 6f 72 77 61 72 64 20 24 62 69 74 73 5d $forward $bits]
0340: 0a 7d 0a 0a 70 72 6f 63 20 3a 3a 62 61 73 65 33 .}..proc ::base3
0350: 32 3a 3a 74 63 6c 5f 64 65 63 6f 64 65 20 7b 65 2::tcl_decode {e
0360: 73 74 72 69 6e 67 7d 20 7b 0a 20 20 20 20 76 61 string} {. va
0370: 72 69 61 62 6c 65 20 62 61 63 6b 77 61 72 64 0a riable backward.
0380: 20 20 20 20 76 61 72 69 61 62 6c 65 20 69 6e 76 variable inv
0390: 61 6c 69 64 0a 0a 20 20 20 20 69 66 20 7b 21 5b alid.. if {![
03a0: 63 6f 72 65 3a 3a 76 61 6c 69 64 20 24 65 73 74 core::valid $est
03b0: 72 69 6e 67 20 24 69 6e 76 61 6c 69 64 20 6d 73 ring $invalid ms
03c0: 67 5d 7d 20 7b 0a 09 72 65 74 75 72 6e 20 2d 63 g]} {..return -c
03d0: 6f 64 65 20 65 72 72 6f 72 20 24 6d 73 67 0a 20 ode error $msg.
03e0: 20 20 20 7d 0a 20 20 20 20 23 70 75 74 73 20 22 }. #puts "
03f0: 49 3c 24 65 73 74 72 69 6e 67 3e 22 0a 20 20 20 I<$estring>".
0400: 20 23 70 75 74 73 20 22 4d 3c 5b 73 74 72 69 6e #puts "M<[strin
0410: 67 20 6d 61 70 20 24 62 61 63 6b 77 61 72 64 20 g map $backward
0420: 24 65 73 74 72 69 6e 67 5d 3e 22 0a 0a 20 20 20 $estring]>"..
0430: 20 72 65 74 75 72 6e 20 5b 62 69 6e 61 72 79 20 return [binary
0440: 66 6f 72 6d 61 74 20 42 2a 20 5b 73 74 72 69 6e format B* [strin
0450: 67 20 6d 61 70 20 24 62 61 63 6b 77 61 72 64 20 g map $backward
0460: 5b 73 74 72 69 6e 67 20 74 6f 75 70 70 65 72 20 [string toupper
0470: 24 65 73 74 72 69 6e 67 5d 5d 5d 0a 7d 0a 0a 23 $estring]]].}..#
0480: 20 23 23 23 20 23 23 23 20 23 23 23 20 23 23 23 ### ### ### ###
0490: 23 23 23 23 23 23 20 23 23 23 23 23 23 23 23 23 ###### #########
04a0: 20 23 23 23 23 23 23 23 23 23 0a 23 23 20 44 61 #########.## Da
04b0: 74 61 20 73 74 72 75 63 74 75 72 65 73 0a 0a 6e ta structures..n
04c0: 61 6d 65 73 70 61 63 65 20 65 76 61 6c 20 3a 3a amespace eval ::
04d0: 62 61 73 65 33 32 20 7b 0a 20 20 20 20 23 20 49 base32 {. # I
04e0: 6e 69 74 69 61 6c 69 7a 65 20 74 68 65 20 6d 61 nitialize the ma
04f0: 70 73 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 ps. variable
0500: 66 6f 72 77 61 72 64 0a 20 20 20 20 76 61 72 69 forward. vari
0510: 61 62 6c 65 20 62 61 63 6b 77 61 72 64 0a 20 20 able backward.
0520: 20 20 76 61 72 69 61 62 6c 65 20 69 6e 76 61 6c variable inval
0530: 69 64 0a 0a 20 20 20 20 63 6f 72 65 3a 3a 64 65 id.. core::de
0540: 66 69 6e 65 20 7b 0a 09 30 20 41 20 20 20 20 39 fine {..0 A 9
0550: 20 4a 20 20 20 31 38 20 53 20 20 20 32 37 20 33 J 18 S 27 3
0560: 0a 09 31 20 42 20 20 20 31 30 20 4b 20 20 20 31 ..1 B 10 K 1
0570: 39 20 54 20 20 20 32 38 20 34 0a 09 32 20 43 20 9 T 28 4..2 C
0580: 20 20 31 31 20 4c 20 20 20 32 30 20 55 20 20 20 11 L 20 U
0590: 32 39 20 35 0a 09 33 20 44 20 20 20 31 32 20 4d 29 5..3 D 12 M
05a0: 20 20 20 32 31 20 56 20 20 20 33 30 20 36 0a 09 21 V 30 6..
05b0: 34 20 45 20 20 20 31 33 20 4e 20 20 20 32 32 20 4 E 13 N 22
05c0: 57 20 20 20 33 31 20 37 0a 09 35 20 46 20 20 20 W 31 7..5 F
05d0: 31 34 20 4f 20 20 20 32 33 20 58 0a 09 36 20 47 14 O 23 X..6 G
05e0: 20 20 20 31 35 20 50 20 20 20 32 34 20 59 0a 09 15 P 24 Y..
05f0: 37 20 48 20 20 20 31 36 20 51 20 20 20 32 35 20 7 H 16 Q 25
0600: 5a 0a 09 38 20 49 20 20 20 31 37 20 52 20 20 20 Z..8 I 17 R
0610: 32 36 20 32 0a 20 20 20 20 7d 20 66 6f 72 77 61 26 2. } forwa
0620: 72 64 20 62 61 63 6b 77 61 72 64 20 69 6e 76 61 rd backward inva
0630: 6c 69 64 20 3b 20 23 20 7b 7d 0a 20 20 20 20 23 lid ; # {}. #
0640: 20 70 75 74 73 20 2f 2f 2f 24 66 6f 72 77 61 72 puts ///$forwar
0650: 64 2f 2f 2f 0a 20 20 20 20 23 20 70 75 74 73 20 d///. # puts
0660: 2f 2f 2f 24 62 61 63 6b 77 61 72 64 2f 2f 2f 0a ///$backward///.
0670: 7d 0a 0a 23 20 23 23 23 20 23 23 23 20 23 23 23 }..# ### ### ###
0680: 20 23 23 23 23 23 23 23 23 23 20 23 23 23 23 23 ######### #####
0690: 23 23 23 23 20 23 23 23 23 23 23 23 23 23 0a 23 #### #########.#
06a0: 23 20 4f 6b 0a # Ok.
