Artifact 122176da293daccca87927a43fa6a0e4640dc94e:
- File
kitsh/buildsrc/kitsh-0.0/mk4tcl.tcl
— part of check-in
[096098536d]
at
2010-09-26 04:42:20
on branch trunk
— Updated to implement "vfs::mkcl" using Readkit
Updated local Readkit implementation to not attempt to replace Mk4tcl (user: rkeene, size: 34093) [annotate] [blame] [check-ins using]
0000: 23 21 20 2f 75 73 72 2f 62 69 6e 2f 65 6e 76 20 #! /usr/bin/env
0010: 74 63 6c 73 68 0a 23 20 52 65 61 64 4b 69 74 2c tclsh.# ReadKit,
0020: 20 61 20 76 69 65 77 65 72 2f 65 78 74 72 61 63 a viewer/extrac
0030: 74 6f 72 2f 63 6f 6e 76 65 72 74 65 72 20 66 6f tor/converter fo
0040: 72 20 73 74 61 72 6b 69 74 73 20 77 68 69 63 68 r starkits which
0050: 20 64 6f 65 73 20 6e 6f 74 0a 23 20 72 65 71 75 does not.# requ
0060: 69 72 65 20 54 63 6c 4b 69 74 20 6f 72 20 4d 65 ire TclKit or Me
0070: 74 61 4b 69 74 2e 20 20 54 68 69 73 20 66 69 6c taKit. This fil
0080: 65 20 77 61 73 20 67 65 6e 65 72 61 74 65 64 20 e was generated
0090: 62 79 20 22 72 6b 67 65 6e 2e 74 63 6c 22 2e 0a by "rkgen.tcl"..
00a0: 23 0a 23 20 4a 75 6e 65 20 32 30 30 32 2c 20 4a #.# June 2002, J
00b0: 65 61 6e 2d 43 6c 61 75 64 65 20 57 69 70 70 6c ean-Claude Wippl
00c0: 65 72 20 3c 6a 63 77 40 65 71 75 69 34 2e 63 6f er <jcw@equi4.co
00d0: 6d 3e 0a 0a 23 20 74 68 69 73 20 69 73 20 6e 65 m>..# this is ne
00e0: 65 64 65 64 20 73 6f 20 6f 66 74 65 6e 20 74 68 eded so often th
00f0: 61 74 20 49 20 6a 75 73 74 20 64 72 6f 70 20 63 at I just drop c
0100: 6f 70 69 65 73 20 6f 66 20 69 74 20 61 6c 6c 20 opies of it all
0110: 6f 76 65 72 20 74 68 65 20 70 6c 61 63 65 0a 69 over the place.i
0120: 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 f {![info exists
0130: 20 61 75 74 6f 5f 69 6e 64 65 78 28 6c 61 73 73 auto_index(lass
0140: 69 67 6e 29 5d 20 26 26 20 5b 69 6e 66 6f 20 63 ign)] && [info c
0150: 6f 6d 6d 61 6e 64 73 20 6c 61 73 73 69 67 6e 5d ommands lassign]
0160: 20 3d 3d 20 22 22 7d 20 7b 0a 20 20 70 72 6f 63 == ""} {. proc
0170: 20 6c 61 73 73 69 67 6e 20 7b 6c 20 61 72 67 73 lassign {l args
0180: 7d 20 7b 0a 20 20 20 20 66 6f 72 65 61 63 68 20 } {. foreach
0190: 76 20 24 6c 20 61 20 24 61 72 67 73 20 7b 20 75 v $l a $args { u
01a0: 70 6c 65 76 65 6c 20 31 20 5b 6c 69 73 74 20 73 plevel 1 [list s
01b0: 65 74 20 24 61 20 24 76 5d 20 7d 0a 20 20 7d 0a et $a $v] }. }.
01c0: 7d 0a 0a 63 61 74 63 68 20 7b 0a 09 6c 6f 61 64 }..catch {..load
01d0: 20 7b 7d 20 7a 6c 69 62 0a 7d 0a 63 61 74 63 68 {} zlib.}.catch
01e0: 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 {..package requ
01f0: 69 72 65 20 7a 6c 69 62 0a 7d 0a 0a 69 66 20 7b ire zlib.}..if {
0200: 5b 69 6e 66 6f 20 63 6f 6d 6d 20 6d 6d 61 70 5d [info comm mmap]
0210: 20 3d 3d 20 22 22 7d 20 7b 0a 20 20 20 20 23 20 == ""} {. #
0220: 6d 6d 61 70 20 61 6e 64 20 6d 76 65 63 20 70 72 mmap and mvec pr
0230: 69 6d 69 74 69 76 65 73 20 69 6e 20 70 75 72 65 imitives in pure
0240: 20 54 63 6c 20 28 61 20 43 20 76 65 72 73 69 6f Tcl (a C versio
0250: 6e 20 69 73 20 70 72 65 73 65 6e 74 20 69 6e 20 n is present in
0260: 63 72 69 74 6c 69 62 29 0a 0a 20 20 20 20 6e 61 critlib).. na
0270: 6d 65 73 70 61 63 65 20 65 78 70 6f 72 74 20 6d mespace export m
0280: 6d 61 70 20 6d 76 65 63 0a 0a 20 20 20 20 6e 61 map mvec.. na
0290: 6d 65 73 70 61 63 65 20 65 76 61 6c 20 76 20 7b mespace eval v {
02a0: 0a 09 61 72 72 61 79 20 73 65 74 20 6d 6d 61 70 ..array set mmap
02b0: 5f 64 61 74 61 20 7b 7d 0a 09 61 72 72 61 79 20 _data {}..array
02c0: 73 65 74 20 6d 76 65 63 5f 73 68 69 66 74 73 20 set mvec_shifts
02d0: 7b 0a 20 20 20 20 2d 20 2d 31 20 20 20 20 30 20 {. - -1 0
02e0: 2d 31 0a 20 20 20 20 31 20 20 30 20 20 20 20 32 -1. 1 0 2
02f0: 20 20 31 20 20 20 20 34 20 20 32 20 20 20 20 38 1 4 2 8
0300: 20 20 20 33 0a 20 20 20 20 31 36 20 34 20 20 20 3. 16 4
0310: 31 36 72 20 34 0a 20 20 20 20 33 32 20 35 20 20 16r 4. 32 5
0320: 20 33 32 72 20 35 20 20 20 33 32 66 20 35 20 20 32r 5 32f 5
0330: 20 33 32 66 72 20 35 0a 20 20 20 20 36 34 20 36 32fr 5. 64 6
0340: 20 20 20 36 34 72 20 36 20 20 20 36 34 66 20 36 64r 6 64f 6
0350: 20 20 20 36 34 66 72 20 36 20 7d 0a 20 20 20 20 64fr 6 }.
0360: 7d 0a 0a 20 20 20 20 70 72 6f 63 20 6d 6d 61 70 }.. proc mmap
0370: 20 7b 66 64 20 61 72 67 73 7d 20 7b 0a 09 75 70 {fd args} {..up
0380: 76 61 72 20 23 30 20 76 3a 3a 6d 6d 61 70 5f 64 var #0 v::mmap_d
0390: 61 74 61 28 24 66 64 29 20 64 61 74 61 0a 09 23 ata($fd) data..#
03a0: 20 73 70 65 63 69 61 6c 20 63 61 73 65 20 69 66 special case if
03b0: 20 66 64 20 69 73 20 74 68 65 20 6e 61 6d 65 20 fd is the name
03c0: 6f 66 20 61 20 76 61 72 69 61 62 6c 65 20 28 71 of a variable (q
03d0: 75 61 6c 69 66 69 65 64 20 6f 72 20 67 6c 6f 62 ualified or glob
03e0: 61 6c 29 0a 09 69 66 20 7b 5b 75 70 6c 65 76 65 al)..if {[upleve
03f0: 6c 20 23 30 20 5b 6c 69 73 74 20 69 6e 66 6f 20 l #0 [list info
0400: 65 78 69 73 74 73 20 24 66 64 5d 5d 7d 20 7b 0a exists $fd]]} {.
0410: 09 20 20 20 20 75 70 76 61 72 20 23 30 20 24 66 . upvar #0 $f
0420: 64 20 76 61 72 0a 09 20 20 20 20 73 65 74 20 64 d var.. set d
0430: 61 74 61 20 24 76 61 72 0a 09 7d 0a 09 23 20 63 ata $var..}..# c
0440: 61 63 68 65 20 61 20 66 75 6c 6c 20 63 6f 70 79 ache a full copy
0450: 20 6f 66 20 74 68 65 20 66 69 6c 65 20 74 6f 20 of the file to
0460: 73 69 6d 75 6c 61 74 65 20 6d 65 6d 6f 72 79 20 simulate memory
0470: 6d 61 70 70 69 6e 67 0a 09 69 66 20 7b 21 5b 69 mapping..if {![i
0480: 6e 66 6f 20 65 78 69 73 74 73 20 64 61 74 61 5d nfo exists data]
0490: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 70 6f 73 } {.. set pos
04a0: 20 5b 74 65 6c 6c 20 24 66 64 5d 0a 09 20 20 20 [tell $fd]..
04b0: 20 73 65 65 6b 20 24 66 64 20 30 20 65 6e 64 0a seek $fd 0 end.
04c0: 09 20 20 20 20 73 65 74 20 65 6e 64 20 5b 74 65 . set end [te
04d0: 6c 6c 20 24 66 64 5d 0a 09 20 20 20 20 73 65 65 ll $fd].. see
04e0: 6b 20 24 66 64 20 30 0a 09 20 20 20 20 73 65 74 k $fd 0.. set
04f0: 20 74 72 61 6e 73 20 5b 66 63 6f 6e 66 69 67 75 trans [fconfigu
0500: 72 65 20 24 66 64 20 2d 74 72 61 6e 73 6c 61 74 re $fd -translat
0510: 69 6f 6e 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 ion].. fconfi
0520: 67 75 72 65 20 24 66 64 20 2d 74 72 61 6e 73 6c gure $fd -transl
0530: 61 74 69 6f 6e 20 62 69 6e 61 72 79 0a 09 20 20 ation binary..
0540: 20 20 73 65 74 20 64 61 74 61 20 5b 72 65 61 64 set data [read
0550: 20 24 66 64 20 24 65 6e 64 5d 0a 09 20 20 20 20 $fd $end]..
0560: 66 63 6f 6e 66 69 67 75 72 65 20 24 66 64 20 2d fconfigure $fd -
0570: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 24 74 72 61 translation $tra
0580: 6e 73 0a 09 20 20 20 20 73 65 65 6b 20 24 66 64 ns.. seek $fd
0590: 20 24 70 6f 73 0a 09 7d 0a 09 73 65 74 20 74 6f $pos..}..set to
05a0: 74 61 6c 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 tal [string leng
05b0: 74 68 20 24 64 61 74 61 5d 0a 09 69 66 20 7b 5b th $data]..if {[
05c0: 6c 6c 65 6e 67 74 68 20 24 61 72 67 73 5d 20 3d llength $args] =
05d0: 3d 20 30 7d 20 7b 0a 09 20 20 20 20 72 65 74 75 = 0} {.. retu
05e0: 72 6e 20 24 74 6f 74 61 6c 0a 09 7d 0a 09 66 6f rn $total..}..fo
05f0: 72 65 61 63 68 20 7b 6f 66 66 20 6c 65 6e 7d 20 reach {off len}
0600: 24 61 72 67 73 20 62 72 65 61 6b 0a 09 69 66 20 $args break..if
0610: 7b 24 6c 65 6e 20 3c 20 30 7d 20 7b 0a 09 20 20 {$len < 0} {..
0620: 20 20 73 65 74 20 6c 65 6e 20 24 74 6f 74 61 6c set len $total
0630: 0a 09 7d 0a 09 69 66 20 7b 24 6c 65 6e 20 3c 20 ..}..if {$len <
0640: 30 20 7c 7c 20 24 6c 65 6e 20 3e 20 24 74 6f 74 0 || $len > $tot
0650: 61 6c 20 2d 20 24 6f 66 66 7d 20 7b 0a 09 20 20 al - $off} {..
0660: 20 20 73 65 74 20 6c 65 6e 20 5b 65 78 70 72 20 set len [expr
0670: 7b 24 74 6f 74 61 6c 20 2d 20 24 6f 66 66 7d 5d {$total - $off}]
0680: 0a 09 7d 0a 09 62 69 6e 61 72 79 20 73 63 61 6e ..}..binary scan
0690: 20 24 64 61 74 61 20 40 24 7b 6f 66 66 7d 61 24 $data @${off}a$
06a0: 6c 65 6e 20 73 0a 09 72 65 74 75 72 6e 20 24 73 len s..return $s
06b0: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 . }.. proc
06c0: 20 6d 76 65 63 20 7b 76 20 61 72 67 73 7d 20 7b mvec {v args} {
06d0: 0a 09 66 6f 72 65 61 63 68 20 7b 6d 6f 64 65 20 ..foreach {mode
06e0: 64 61 74 61 20 6f 66 66 20 6c 65 6e 7d 20 24 76 data off len} $v
06f0: 20 62 72 65 61 6b 0a 09 69 66 20 7b 5b 69 6e 66 break..if {[inf
0700: 6f 20 65 78 69 73 74 73 20 76 3a 3a 6d 76 65 63 o exists v::mvec
0710: 5f 73 68 69 66 74 73 28 24 6d 6f 64 65 29 5d 7d _shifts($mode)]}
0720: 20 7b 0a 09 20 20 20 20 23 20 75 73 65 20 5f 6d {.. # use _m
0730: 76 65 63 5f 67 65 74 20 74 6f 20 61 63 63 65 73 vec_get to acces
0740: 73 20 65 6c 65 6d 65 6e 74 73 0a 09 20 20 20 20 s elements..
0750: 73 65 74 20 73 68 69 66 74 20 24 76 3a 3a 6d 76 set shift $v::mv
0760: 65 63 5f 73 68 69 66 74 73 28 24 6d 6f 64 65 29 ec_shifts($mode)
0770: 0a 09 20 20 20 20 69 66 20 7b 5b 6c 6c 65 6e 67 .. if {[lleng
0780: 74 68 20 24 76 5d 20 3c 20 34 7d 20 7b 0a 09 09 th $v] < 4} {...
0790: 73 65 74 20 6c 65 6e 20 24 6f 66 66 0a 09 20 20 set len $off..
07a0: 20 20 7d 0a 09 20 20 20 20 73 65 74 20 67 65 74 }.. set get
07b0: 20 5b 6c 69 73 74 20 5f 6d 76 65 63 5f 67 65 74 [list _mvec_get
07c0: 20 24 73 68 69 66 74 20 24 76 20 2a 5d 0a 09 7d $shift $v *]..}
07d0: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 23 20 76 else {.. # v
07e0: 69 72 74 75 61 6c 20 6d 6f 64 65 2c 20 73 65 74 irtual mode, set
07f0: 20 74 6f 20 65 76 61 6c 75 61 74 65 20 73 63 72 to evaluate scr
0800: 69 70 74 0a 09 20 20 20 20 73 65 74 20 73 68 69 ipt.. set shi
0810: 66 74 20 22 22 0a 09 20 20 20 20 73 65 74 20 6c ft "".. set l
0820: 65 6e 20 5b 6c 69 6e 64 65 78 20 24 76 20 65 6e en [lindex $v en
0830: 64 5d 0a 09 20 20 20 20 73 65 74 20 67 65 74 20 d].. set get
0840: 24 76 0a 09 7d 0a 09 23 20 74 72 79 20 74 6f 20 $v..}..# try to
0850: 64 65 72 69 76 65 20 76 65 63 74 6f 72 20 6c 65 derive vector le
0860: 6e 67 74 68 20 66 72 6f 6d 20 64 61 74 61 20 6c ngth from data l
0870: 65 6e 67 74 68 20 69 66 20 6e 6f 74 20 73 70 65 ength if not spe
0880: 63 69 66 69 65 64 0a 09 69 66 20 7b 24 6c 65 6e cified..if {$len
0890: 20 3d 3d 20 22 22 20 7c 7c 20 24 6c 65 6e 20 3c == "" || $len <
08a0: 20 30 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 0} {.. set l
08b0: 65 6e 20 30 0a 09 20 20 20 20 69 66 20 7b 24 73 en 0.. if {$s
08c0: 68 69 66 74 20 3e 3d 20 30 7d 20 7b 0a 09 09 69 hift >= 0} {...i
08d0: 66 20 7b 5b 6c 6c 65 6e 67 74 68 20 24 76 5d 20 f {[llength $v]
08e0: 3c 20 34 7d 20 7b 0a 09 09 20 20 20 20 73 65 74 < 4} {... set
08f0: 20 6e 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 n [string lengt
0900: 68 20 24 64 61 74 61 5d 0a 09 09 7d 20 65 6c 73 h $data]...} els
0910: 65 20 7b 0a 09 09 20 20 20 20 73 65 74 20 6e 20 e {... set n
0920: 5b 6d 6d 61 70 20 24 64 61 74 61 5d 0a 09 09 7d [mmap $data]...}
0930: 0a 09 09 73 65 74 20 6c 65 6e 20 5b 65 78 70 72 ...set len [expr
0940: 20 7b 28 24 6e 20 3c 3c 20 33 29 20 3e 3e 20 24 {($n << 3) >> $
0950: 73 68 69 66 74 7d 5d 0a 09 20 20 20 20 7d 0a 09 shift}].. }..
0960: 7d 0a 09 73 65 74 20 6e 61 72 67 73 20 5b 6c 6c }..set nargs [ll
0970: 65 6e 67 74 68 20 24 61 72 67 73 5d 0a 09 23 20 ength $args]..#
0980: 77 69 74 68 20 6a 75 73 74 20 61 20 76 61 72 6e with just a varn
0990: 61 6d 65 20 61 73 20 61 72 67 2c 20 72 65 74 75 ame as arg, retu
09a0: 72 6e 20 69 6e 66 6f 20 61 62 6f 75 74 20 74 68 rn info about th
09b0: 69 73 20 76 65 63 74 6f 72 0a 09 69 66 20 7b 24 is vector..if {$
09c0: 6e 61 72 67 73 20 3d 3d 20 30 7d 20 7b 0a 09 20 nargs == 0} {..
09d0: 20 20 20 69 66 20 7b 24 73 68 69 66 74 20 3d 3d if {$shift ==
09e0: 20 22 22 7d 20 7b 0a 09 09 72 65 74 75 72 6e 20 ""} {...return
09f0: 5b 6c 69 73 74 20 24 6c 65 6e 20 7b 7d 20 24 76 [list $len {} $v
0a00: 5d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 72 65 ].. }.. re
0a10: 74 75 72 6e 20 5b 6c 69 73 74 20 24 6c 65 6e 20 turn [list $len
0a20: 24 6d 6f 64 65 20 24 73 68 69 66 74 5d 0a 09 7d $mode $shift]..}
0a30: 0a 09 66 6f 72 65 61 63 68 20 7b 70 6f 73 20 63 ..foreach {pos c
0a40: 6f 75 6e 74 20 70 72 65 64 20 63 6f 6e 64 7d 20 ount pred cond}
0a50: 24 61 72 67 73 20 62 72 65 61 6b 0a 09 23 20 77 $args break..# w
0a60: 69 74 68 20 61 6e 20 69 6e 64 65 78 20 61 73 20 ith an index as
0a70: 73 65 63 6f 6e 64 20 61 72 67 2c 20 64 6f 20 61 second arg, do a
0a80: 20 73 69 6e 67 6c 65 20 61 63 63 65 73 73 20 61 single access a
0a90: 6e 64 20 72 65 74 75 72 6e 20 65 6c 65 6d 65 6e nd return elemen
0aa0: 74 0a 09 69 66 20 7b 24 6e 61 72 67 73 20 3d 3d t..if {$nargs ==
0ab0: 20 31 7d 20 7b 0a 09 20 20 20 20 72 65 74 75 72 1} {.. retur
0ac0: 6e 20 5b 75 70 6c 65 76 65 6c 20 31 20 5b 6c 72 n [uplevel 1 [lr
0ad0: 65 70 6c 61 63 65 20 24 67 65 74 20 65 6e 64 20 eplace $get end
0ae0: 65 6e 64 20 24 70 6f 73 5d 5d 0a 09 7d 0a 09 69 end $pos]]..}..i
0af0: 66 20 7b 24 63 6f 75 6e 74 20 3c 20 30 7d 20 7b f {$count < 0} {
0b00: 0a 09 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 .. set count
0b10: 24 6c 65 6e 0a 09 7d 0a 09 69 66 20 7b 24 63 6f $len..}..if {$co
0b20: 75 6e 74 20 3e 20 24 6c 65 6e 20 2d 20 24 70 6f unt > $len - $po
0b30: 73 20 26 26 20 24 73 68 69 66 74 20 21 3d 20 2d s && $shift != -
0b40: 31 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 63 6f 1} {.. set co
0b50: 75 6e 74 20 5b 65 78 70 72 20 7b 24 6c 65 6e 20 unt [expr {$len
0b60: 2d 20 24 70 6f 73 7d 5d 0a 09 7d 0a 09 69 66 20 - $pos}]..}..if
0b70: 7b 24 6e 61 72 67 73 20 3d 3d 20 34 7d 20 7b 0a {$nargs == 4} {.
0b80: 09 20 20 20 20 75 70 76 61 72 20 24 70 72 65 64 . upvar $pred
0b90: 20 78 0a 09 7d 0a 09 73 65 74 20 72 20 7b 7d 0a x..}..set r {}.
0ba0: 09 69 6e 63 72 20 63 6f 75 6e 74 20 24 70 6f 73 .incr count $pos
0bb0: 0a 09 23 20 6c 6f 6f 70 20 74 68 72 6f 75 67 68 ..# loop through
0bc0: 20 73 70 65 63 69 66 69 65 64 20 72 61 6e 67 65 specified range
0bd0: 20 74 6f 20 62 75 69 6c 64 20 72 65 73 75 6c 74 to build result
0be0: 20 76 65 63 74 6f 72 0a 09 23 20 77 69 74 68 20 vector..# with
0bf0: 66 6f 75 72 20 61 72 67 73 2c 20 75 73 65 64 20 four args, used
0c00: 74 68 61 74 20 61 73 20 70 72 65 64 69 63 61 74 that as predicat
0c10: 65 20 66 75 6e 63 74 69 6f 6e 20 74 6f 20 66 69 e function to fi
0c20: 6c 74 65 72 0a 09 23 20 77 69 74 68 20 66 69 76 lter..# with fiv
0c30: 65 20 61 72 67 73 2c 20 75 73 65 20 66 6f 75 72 e args, use four
0c40: 74 68 20 61 73 20 6c 6f 6f 70 20 76 61 72 20 61 th as loop var a
0c50: 6e 64 20 61 70 70 6c 79 20 66 69 66 74 68 20 61 nd apply fifth a
0c60: 73 20 63 6f 6e 64 69 74 69 6f 6e 0a 09 66 6f 72 s condition..for
0c70: 20 7b 73 65 74 20 78 20 24 70 6f 73 7d 20 7b 24 {set x $pos} {$
0c80: 78 20 3c 20 24 63 6f 75 6e 74 7d 20 7b 69 6e 63 x < $count} {inc
0c90: 72 20 78 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 r x} {.. set
0ca0: 79 20 5b 75 70 6c 65 76 65 6c 20 31 20 5b 6c 72 y [uplevel 1 [lr
0cb0: 65 70 6c 61 63 65 20 24 67 65 74 20 65 6e 64 20 eplace $get end
0cc0: 65 6e 64 20 24 78 5d 5d 0a 09 20 20 20 20 73 77 end $x]].. sw
0cd0: 69 74 63 68 20 24 6e 61 72 67 73 20 7b 0a 09 09 itch $nargs {...
0ce0: 33 20 7b 0a 09 09 09 69 66 20 7b 21 5b 75 70 6c 3 {....if {![upl
0cf0: 65 76 65 6c 20 31 20 5b 6c 69 73 74 20 24 70 72 evel 1 [list $pr
0d00: 65 64 20 24 76 20 24 78 20 24 79 5d 5d 7d 20 63 ed $v $x $y]]} c
0d10: 6f 6e 74 69 6e 75 65 0a 09 09 20 20 20 20 7d 0a ontinue... }.
0d20: 09 09 34 20 7b 0a 09 09 09 69 66 20 7b 21 5b 75 ..4 {....if {![u
0d30: 70 6c 65 76 65 6c 20 31 20 5b 6c 69 73 74 20 65 plevel 1 [list e
0d40: 78 70 72 20 24 63 6f 6e 64 5d 5d 7d 20 63 6f 6e xpr $cond]]} con
0d50: 74 69 6e 75 65 0a 09 09 20 20 20 20 7d 0a 09 20 tinue... }..
0d60: 20 20 20 7d 0a 09 20 20 20 20 6c 61 70 70 65 6e }.. lappen
0d70: 64 20 72 20 24 79 0a 09 7d 0a 09 72 65 74 75 72 d r $y..}..retur
0d80: 6e 20 24 72 0a 20 20 20 20 7d 0a 0a 20 20 20 20 n $r. }..
0d90: 70 72 6f 63 20 5f 6d 76 65 63 5f 67 65 74 20 7b proc _mvec_get {
0da0: 73 68 69 66 74 20 64 65 73 63 20 69 6e 64 65 78 shift desc index
0db0: 7d 20 7b 0a 09 66 6f 72 65 61 63 68 20 7b 6d 6f } {..foreach {mo
0dc0: 64 65 20 64 61 74 61 20 6f 66 66 20 6c 65 6e 7d de data off len}
0dd0: 20 24 64 65 73 63 20 62 72 65 61 6b 0a 09 73 77 $desc break..sw
0de0: 69 74 63 68 20 2d 2d 20 24 6d 6f 64 65 20 7b 0a itch -- $mode {.
0df0: 09 20 20 20 20 2d 20 7b 0a 09 09 20 20 20 20 72 . - {... r
0e00: 65 74 75 72 6e 20 24 69 6e 64 65 78 0a 09 09 7d eturn $index...}
0e10: 0a 09 20 20 20 20 30 20 7b 0a 09 09 20 20 20 20 .. 0 {...
0e20: 72 65 74 75 72 6e 20 24 64 61 74 61 0a 09 09 7d return $data...}
0e30: 0a 09 7d 0a 09 69 66 20 7b 5b 6c 6c 65 6e 67 74 ..}..if {[llengt
0e40: 68 20 24 64 65 73 63 5d 20 3c 20 34 7d 20 7b 0a h $desc] < 4} {.
0e50: 09 20 20 20 20 73 65 74 20 6f 66 66 20 5b 65 78 . set off [ex
0e60: 70 72 20 7b 28 24 69 6e 64 65 78 20 3c 3c 20 24 pr {($index << $
0e70: 73 68 69 66 74 29 20 3e 3e 20 33 7d 5d 0a 09 7d shift) >> 3}]..}
0e80: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 23 20 64 else {.. # d
0e90: 6f 6e 27 74 20 6c 6f 61 64 20 6d 6f 72 65 20 74 on't load more t
0ea0: 68 61 6e 20 38 20 62 79 74 65 73 20 66 72 6f 6d han 8 bytes from
0eb0: 20 74 68 65 20 70 72 6f 70 65 72 20 6f 66 66 73 the proper offs
0ec0: 65 74 0a 09 20 20 20 20 69 6e 63 72 20 6f 66 66 et.. incr off
0ed0: 20 5b 65 78 70 72 20 7b 28 24 69 6e 64 65 78 20 [expr {($index
0ee0: 3c 3c 20 24 73 68 69 66 74 29 20 3e 3e 20 33 7d << $shift) >> 3}
0ef0: 5d 0a 09 20 20 20 20 73 65 74 20 64 61 74 61 20 ].. set data
0f00: 5b 6d 6d 61 70 20 24 64 61 74 61 20 24 6f 66 66 [mmap $data $off
0f10: 20 38 5d 0a 09 20 20 20 20 73 65 74 20 6f 66 66 8].. set off
0f20: 20 30 0a 09 7d 0a 09 73 77 69 74 63 68 20 2d 2d 0..}..switch --
0f30: 20 24 6d 6f 64 65 20 7b 0a 09 20 20 20 20 31 20 $mode {.. 1
0f40: 7b 0a 09 09 20 20 20 20 62 69 6e 61 72 79 20 73 {... binary s
0f50: 63 61 6e 20 24 64 61 74 61 20 40 24 7b 6f 66 66 can $data @${off
0f60: 7d 63 20 76 61 6c 75 65 0a 09 09 20 20 20 20 72 }c value... r
0f70: 65 74 75 72 6e 20 5b 65 78 70 72 20 7b 28 24 76 eturn [expr {($v
0f80: 61 6c 75 65 3e 3e 28 24 69 6e 64 65 78 26 37 29 alue>>($index&7)
0f90: 29 20 26 31 7d 5d 0a 09 09 7d 0a 09 20 20 20 20 ) &1}]...}..
0fa0: 32 20 7b 0a 09 09 20 20 20 20 62 69 6e 61 72 79 2 {... binary
0fb0: 20 73 63 61 6e 20 24 64 61 74 61 20 40 24 7b 6f scan $data @${o
0fc0: 66 66 7d 63 20 76 61 6c 75 65 0a 09 09 20 20 20 ff}c value...
0fd0: 20 72 65 74 75 72 6e 20 5b 65 78 70 72 20 7b 28 return [expr {(
0fe0: 24 76 61 6c 75 65 3e 3e 28 28 24 69 6e 64 65 78 $value>>(($index
0ff0: 26 33 29 20 3c 3c 31 29 29 20 26 33 7d 5d 0a 09 &3) <<1)) &3}]..
1000: 09 7d 0a 09 20 20 20 20 34 20 7b 0a 09 09 20 20 .}.. 4 {...
1010: 20 20 62 69 6e 61 72 79 20 73 63 61 6e 20 24 64 binary scan $d
1020: 61 74 61 20 40 24 7b 6f 66 66 7d 63 20 76 61 6c ata @${off}c val
1030: 75 65 0a 09 09 20 20 20 20 72 65 74 75 72 6e 20 ue... return
1040: 5b 65 78 70 72 20 7b 28 24 76 61 6c 75 65 3e 3e [expr {($value>>
1050: 28 28 24 69 6e 64 65 78 26 31 29 20 3c 3c 32 29 (($index&1) <<2)
1060: 29 20 26 31 35 7d 5d 0a 09 09 7d 0a 09 20 20 20 ) &15}]...}..
1070: 20 38 20 7b 0a 09 09 20 20 20 20 73 65 74 20 77 8 {... set w
1080: 20 31 0a 09 09 20 20 20 20 73 65 74 20 66 20 63 1... set f c
1090: 0a 09 09 7d 0a 09 20 20 20 20 31 36 20 7b 0a 09 ...}.. 16 {..
10a0: 09 20 20 20 20 73 65 74 20 77 20 32 0a 09 09 20 . set w 2...
10b0: 20 20 20 73 65 74 20 66 20 73 0a 09 09 7d 0a 09 set f s...}..
10c0: 20 20 20 20 31 36 72 20 7b 0a 09 09 20 20 20 20 16r {...
10d0: 73 65 74 20 77 20 32 0a 09 09 20 20 20 20 73 65 set w 2... se
10e0: 74 20 66 20 53 0a 09 09 7d 0a 09 20 20 20 20 33 t f S...}.. 3
10f0: 32 20 7b 0a 09 09 20 20 20 20 73 65 74 20 77 20 2 {... set w
1100: 34 0a 09 09 20 20 20 20 73 65 74 20 66 20 69 0a 4... set f i.
1110: 09 09 7d 0a 09 20 20 20 20 33 32 72 20 7b 0a 09 ..}.. 32r {..
1120: 09 20 20 20 20 73 65 74 20 77 20 34 0a 09 09 20 . set w 4...
1130: 20 20 20 73 65 74 20 66 20 49 0a 09 09 7d 0a 09 set f I...}..
1140: 20 20 20 20 33 32 66 72 20 2d 0a 09 20 20 20 20 32fr -..
1150: 33 32 66 20 7b 0a 09 09 20 20 20 20 73 65 74 20 32f {... set
1160: 77 20 34 0a 09 09 20 20 20 20 73 65 74 20 66 20 w 4... set f
1170: 66 0a 09 09 7d 0a 09 20 20 20 20 36 34 20 2d 0a f...}.. 64 -.
1180: 09 20 20 20 20 36 34 72 20 7b 0a 09 09 20 20 20 . 64r {...
1190: 20 73 65 74 20 77 20 38 0a 09 09 20 20 20 20 73 set w 8... s
11a0: 65 74 20 66 20 69 32 0a 09 09 7d 0a 09 20 20 20 et f i2...}..
11b0: 20 36 34 66 72 20 2d 0a 09 20 20 20 20 36 34 66 64fr -.. 64f
11c0: 20 7b 0a 09 09 20 20 20 20 73 65 74 20 77 20 38 {... set w 8
11d0: 0a 09 09 20 20 20 20 73 65 74 20 66 20 64 0a 09 ... set f d..
11e0: 09 7d 0a 09 7d 0a 0a 09 62 69 6e 61 72 79 20 73 .}..}...binary s
11f0: 63 61 6e 20 24 64 61 74 61 20 40 24 6f 66 66 24 can $data @$off$
1200: 66 20 76 61 6c 75 65 0a 09 72 65 74 75 72 6e 20 f value..return
1210: 24 76 61 6c 75 65 0a 20 20 20 20 7d 0a 0a 20 20 $value. }..
1220: 20 20 23 20 76 69 6d 3a 20 66 74 3d 74 63 6c 0a # vim: ft=tcl.
1230: 0a 7d 0a 0a 69 66 20 7b 5b 69 6e 66 6f 20 63 6f .}..if {[info co
1240: 6d 6d 20 64 62 6f 70 65 6e 5d 20 3d 3d 20 22 22 mm dbopen] == ""
1250: 7d 20 7b 0a 20 20 20 20 23 20 44 65 63 6f 64 65 } {. # Decode
1260: 72 20 66 6f 72 20 4d 65 74 61 4b 69 74 20 64 61 r for MetaKit da
1270: 74 61 66 69 6c 65 73 20 69 6e 20 54 63 6c 0a 0a tafiles in Tcl..
1280: 20 20 20 20 23 20 72 65 71 75 69 72 65 73 20 6d # requires m
1290: 6d 61 70 2f 6d 76 65 63 20 70 72 69 6d 69 74 69 map/mvec primiti
12a0: 76 65 73 3a 0a 20 20 20 20 23 73 6f 75 72 63 65 ves:. #source
12b0: 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 69 6e 66 [file join [inf
12c0: 6f 20 64 69 72 6e 61 6d 65 20 5b 69 6e 66 6f 20 o dirname [info
12d0: 73 63 72 69 70 74 5d 5d 20 6d 76 70 72 69 6d 2e script]] mvprim.
12e0: 74 63 6c 5d 0a 0a 20 20 20 20 6e 61 6d 65 73 70 tcl].. namesp
12f0: 61 63 65 20 65 78 70 6f 72 74 20 64 62 6f 70 65 ace export dbope
1300: 6e 20 64 62 63 6c 6f 73 65 20 64 62 74 72 65 65 n dbclose dbtree
1310: 20 61 63 63 65 73 73 20 76 6e 61 6d 65 73 20 76 access vnames v
1320: 6c 65 6e 0a 0a 20 20 20 20 6e 61 6d 65 73 70 61 len.. namespa
1330: 63 65 20 65 76 61 6c 20 76 20 7b 0a 09 76 61 72 ce eval v {..var
1340: 69 61 62 6c 65 20 77 69 64 74 68 73 20 7b 0a 20 iable widths {.
1350: 20 20 20 7b 38 20 31 36 20 20 31 20 33 32 20 20 {8 16 1 32
1360: 32 20 20 34 7d 0a 20 20 20 20 7b 34 20 20 38 20 2 4}. {4 8
1370: 20 31 20 31 36 20 20 32 20 20 30 7d 0a 20 20 20 1 16 2 0}.
1380: 20 7b 32 20 20 34 20 20 38 20 20 31 20 20 30 20 {2 4 8 1 0
1390: 31 36 7d 0a 20 20 20 20 7b 32 20 20 34 20 20 30 16}. {2 4 0
13a0: 20 20 38 20 20 31 20 20 30 7d 0a 20 20 20 20 7b 8 1 0}. {
13b0: 31 20 20 32 20 20 34 20 20 30 20 20 38 20 20 30 1 2 4 0 8 0
13c0: 7d 0a 20 20 20 20 7b 31 20 20 32 20 20 34 20 20 }. {1 2 4
13d0: 30 20 20 30 20 20 38 7d 0a 20 20 20 20 7b 31 20 0 0 8}. {1
13e0: 20 32 20 20 30 20 20 34 20 20 30 20 20 30 7d 20 2 0 4 0 0}
13f0: 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f }. }.. pro
1400: 63 20 66 65 74 63 68 20 7b 66 69 6c 65 7d 20 7b c fetch {file} {
1410: 0a 09 69 66 20 7b 24 66 69 6c 65 20 3d 3d 20 22 ..if {$file == "
1420: 22 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 "} {.. error
1430: 22 74 65 6d 70 20 73 74 6f 72 61 67 65 73 20 6e "temp storages n
1440: 6f 74 20 73 75 70 70 6f 72 74 65 64 22 0a 09 7d ot supported"..}
1450: 0a 09 73 65 74 20 76 3a 3a 64 61 74 61 20 5b 6f ..set v::data [o
1460: 70 65 6e 20 24 66 69 6c 65 5d 0a 09 73 65 74 20 pen $file]..set
1470: 76 3a 3a 73 65 71 6e 20 30 0a 20 20 20 20 7d 0a v::seqn 0. }.
1480: 0a 20 20 20 20 70 72 6f 63 20 62 79 74 65 5f 73 . proc byte_s
1490: 65 67 20 7b 6f 66 66 20 6c 65 6e 7d 20 7b 0a 09 eg {off len} {..
14a0: 69 6e 63 72 20 6f 66 66 20 24 76 3a 3a 7a 65 72 incr off $v::zer
14b0: 6f 0a 09 72 65 74 75 72 6e 20 5b 6d 6d 61 70 20 o..return [mmap
14c0: 24 76 3a 3a 64 61 74 61 20 24 6f 66 66 20 24 6c $v::data $off $l
14d0: 65 6e 5d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 en]. }.. p
14e0: 72 6f 63 20 69 6e 74 5f 73 65 67 20 7b 6f 66 66 roc int_seg {off
14f0: 20 63 6e 74 7d 20 7b 0a 09 73 65 74 20 76 65 63 cnt} {..set vec
1500: 20 5b 6c 69 73 74 20 33 32 72 20 5b 62 79 74 65 [list 32r [byte
1510: 5f 73 65 67 20 24 6f 66 66 20 5b 65 78 70 72 20 _seg $off [expr
1520: 7b 34 2a 24 63 6e 74 7d 5d 5d 5d 0a 09 72 65 74 {4*$cnt}]]]..ret
1530: 75 72 6e 20 5b 6d 76 65 63 20 24 76 65 63 20 30 urn [mvec $vec 0
1540: 20 24 63 6e 74 5d 0a 20 20 20 20 7d 0a 0a 20 20 $cnt]. }..
1550: 20 20 70 72 6f 63 20 67 65 74 5f 73 20 7b 6c 65 proc get_s {le
1560: 6e 7d 20 7b 0a 09 73 65 74 20 73 20 5b 62 79 74 n} {..set s [byt
1570: 65 5f 73 65 67 20 24 76 3a 3a 63 75 72 72 20 24 e_seg $v::curr $
1580: 6c 65 6e 5d 0a 09 69 6e 63 72 20 76 3a 3a 63 75 len]..incr v::cu
1590: 72 72 20 24 6c 65 6e 0a 09 72 65 74 75 72 6e 20 rr $len..return
15a0: 24 73 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 $s. }.. pr
15b0: 6f 63 20 67 65 74 5f 76 20 7b 7d 20 7b 0a 09 73 oc get_v {} {..s
15c0: 65 74 20 76 20 30 0a 09 77 68 69 6c 65 20 31 20 et v 0..while 1
15d0: 7b 0a 09 20 20 20 20 73 65 74 20 63 68 61 72 20 {.. set char
15e0: 5b 6d 76 65 63 20 24 76 3a 3a 62 79 74 65 20 24 [mvec $v::byte $
15f0: 76 3a 3a 63 75 72 72 5d 0a 09 20 20 20 20 69 6e v::curr].. in
1600: 63 72 20 76 3a 3a 63 75 72 72 0a 09 20 20 20 20 cr v::curr..
1610: 73 65 74 20 76 20 5b 65 78 70 72 20 7b 24 76 2a set v [expr {$v*
1620: 31 32 38 2b 28 24 63 68 61 72 26 30 78 66 66 29 128+($char&0xff)
1630: 7d 5d 0a 09 20 20 20 20 69 66 20 7b 24 63 68 61 }].. if {$cha
1640: 72 20 3c 20 30 7d 20 7b 0a 09 09 72 65 74 75 72 r < 0} {...retur
1650: 6e 20 5b 69 6e 63 72 20 76 20 2d 31 32 38 5d 0a n [incr v -128].
1660: 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a . }..}. }.
1670: 0a 20 20 20 20 70 72 6f 63 20 67 65 74 5f 70 20 . proc get_p
1680: 7b 72 6f 77 73 20 76 73 20 76 6f 7d 20 7b 0a 09 {rows vs vo} {..
1690: 75 70 76 61 72 20 24 76 73 20 73 69 7a 65 20 24 upvar $vs size $
16a0: 76 6f 20 6f 66 66 0a 09 73 65 74 20 6f 66 66 20 vo off..set off
16b0: 30 0a 09 69 66 20 7b 24 72 6f 77 73 20 3d 3d 20 0..if {$rows ==
16c0: 30 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 73 69 0} {.. set si
16d0: 7a 65 20 30 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 ze 0..} else {..
16e0: 20 20 20 20 73 65 74 20 73 69 7a 65 20 5b 67 65 set size [ge
16f0: 74 5f 76 5d 0a 09 20 20 20 20 69 66 20 7b 24 73 t_v].. if {$s
1700: 69 7a 65 20 3e 20 30 7d 20 7b 0a 09 09 73 65 74 ize > 0} {...set
1710: 20 6f 66 66 20 5b 67 65 74 5f 76 5d 0a 09 20 20 off [get_v]..
1720: 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 20 }..}. }..
1730: 20 20 70 72 6f 63 20 68 65 61 64 65 72 20 7b 7b proc header {{
1740: 65 6e 64 20 22 22 7d 7d 20 7b 0a 09 73 65 74 20 end ""}} {..set
1750: 76 3a 3a 7a 65 72 6f 20 30 0a 09 69 66 20 7b 24 v::zero 0..if {$
1760: 65 6e 64 20 3d 3d 20 22 22 7d 20 7b 0a 09 20 20 end == ""} {..
1770: 20 20 73 65 74 20 65 6e 64 20 5b 6d 6d 61 70 20 set end [mmap
1780: 24 76 3a 3a 64 61 74 61 5d 0a 09 7d 0a 09 73 65 $v::data]..}..se
1790: 74 20 76 3a 3a 62 79 74 65 20 5b 6c 69 73 74 20 t v::byte [list
17a0: 38 20 24 76 3a 3a 64 61 74 61 20 24 76 3a 3a 7a 8 $v::data $v::z
17b0: 65 72 6f 20 24 65 6e 64 5d 0a 09 6c 61 73 73 69 ero $end]..lassi
17c0: 67 6e 20 5b 69 6e 74 5f 73 65 67 20 5b 65 78 70 gn [int_seg [exp
17d0: 72 20 7b 24 65 6e 64 2d 31 36 7d 5d 20 34 5d 20 r {$end-16}] 4]
17e0: 74 31 20 74 32 20 74 33 20 74 34 0a 09 73 65 74 t1 t2 t3 t4..set
17f0: 20 76 3a 3a 7a 65 72 6f 20 5b 65 78 70 72 20 7b v::zero [expr {
1800: 24 65 6e 64 2d 24 74 32 2d 31 36 7d 5d 0a 09 69 $end-$t2-16}]..i
1810: 6e 63 72 20 65 6e 64 20 2d 24 76 3a 3a 7a 65 72 ncr end -$v::zer
1820: 6f 0a 09 73 65 74 20 76 3a 3a 62 79 74 65 20 5b o..set v::byte [
1830: 6c 69 73 74 20 38 20 24 76 3a 3a 64 61 74 61 20 list 8 $v::data
1840: 24 76 3a 3a 7a 65 72 6f 20 24 65 6e 64 5d 0a 09 $v::zero $end]..
1850: 6c 61 73 73 69 67 6e 20 5b 69 6e 74 5f 73 65 67 lassign [int_seg
1860: 20 30 20 32 5d 20 68 31 20 68 32 0a 09 6c 61 73 0 2] h1 h2..las
1870: 73 69 67 6e 20 5b 69 6e 74 5f 73 65 67 20 5b 65 sign [int_seg [e
1880: 78 70 72 20 7b 24 68 32 2d 38 7d 5d 20 32 5d 20 xpr {$h2-8}] 2]
1890: 65 31 20 65 32 0a 09 73 65 74 20 76 3a 3a 69 6e e1 e2..set v::in
18a0: 66 6f 28 6d 6b 65 6e 64 29 20 24 68 32 0a 09 73 fo(mkend) $h2..s
18b0: 65 74 20 76 3a 3a 69 6e 66 6f 28 6d 6b 74 6f 63 et v::info(mktoc
18c0: 29 20 24 65 32 0a 09 73 65 74 20 76 3a 3a 69 6e ) $e2..set v::in
18d0: 66 6f 28 6d 6b 6c 65 6e 29 20 5b 65 78 70 72 20 fo(mklen) [expr
18e0: 7b 24 65 31 20 26 20 30 78 66 66 66 66 66 66 7d {$e1 & 0xffffff}
18f0: 5d 0a 09 73 65 74 20 76 3a 3a 63 75 72 72 20 24 ]..set v::curr $
1900: 65 32 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 e2. }.. pr
1910: 6f 63 20 6c 61 79 6f 75 74 20 7b 66 6d 74 7d 20 oc layout {fmt}
1920: 7b 0a 09 72 65 67 73 75 62 20 2d 61 6c 6c 20 7b {..regsub -all {
1930: 20 7d 20 24 66 6d 74 20 22 22 20 66 6d 74 0a 09 } $fmt "" fmt..
1940: 72 65 67 73 75 62 20 2d 61 6c 6c 20 7b 28 5c 77 regsub -all {(\w
1950: 2b 29 5c 5b 7d 20 24 66 6d 74 20 22 7b 5c 5c 31 +)\[} $fmt "{\\1
1960: 20 7b 22 20 66 6d 74 0a 09 72 65 67 73 75 62 20 {" fmt..regsub
1970: 2d 61 6c 6c 20 7b 5c 5d 7d 20 24 66 6d 74 20 22 -all {\]} $fmt "
1980: 7d 7d 22 20 66 6d 74 0a 09 72 65 67 73 75 62 20 }}" fmt..regsub
1990: 2d 61 6c 6c 20 7b 2c 7d 20 24 66 6d 74 20 22 20 -all {,} $fmt "
19a0: 22 20 66 6d 74 0a 09 72 65 74 75 72 6e 20 24 66 " fmt..return $f
19b0: 6d 74 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 mt. }.. pr
19c0: 6f 63 20 64 65 73 63 70 61 72 73 65 20 7b 64 65 oc descparse {de
19d0: 73 63 7d 20 7b 0a 09 73 65 74 20 6e 61 6d 65 73 sc} {..set names
19e0: 20 7b 7d 0a 09 73 65 74 20 74 79 70 65 73 20 7b {}..set types {
19f0: 7d 0a 09 66 6f 72 65 61 63 68 20 78 20 24 64 65 }..foreach x $de
1a00: 73 63 20 7b 0a 09 20 20 20 20 69 66 20 7b 5b 6c sc {.. if {[l
1a10: 6c 65 6e 67 74 68 20 24 78 5d 20 3d 3d 20 31 7d length $x] == 1}
1a20: 20 7b 0a 09 09 6c 61 73 73 69 67 6e 20 5b 73 70 {...lassign [sp
1a30: 6c 69 74 20 24 78 20 3a 5d 20 6e 61 6d 65 20 74 lit $x :] name t
1a40: 79 70 65 0a 09 09 69 66 20 7b 24 74 79 70 65 20 ype...if {$type
1a50: 3d 3d 20 22 22 7d 20 7b 0a 09 09 20 20 20 20 73 == ""} {... s
1a60: 65 74 20 74 79 70 65 20 53 0a 09 09 7d 0a 09 20 et type S...}..
1a70: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 6c 61 } else {...la
1a80: 73 73 69 67 6e 20 24 78 20 6e 61 6d 65 20 74 79 ssign $x name ty
1a90: 70 65 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 6c pe.. }.. l
1aa0: 61 70 70 65 6e 64 20 6e 61 6d 65 73 20 24 6e 61 append names $na
1ab0: 6d 65 0a 09 20 20 20 20 6c 61 70 70 65 6e 64 20 me.. lappend
1ac0: 74 79 70 65 73 20 24 74 79 70 65 0a 09 7d 0a 09 types $type..}..
1ad0: 72 65 74 75 72 6e 20 5b 6c 69 73 74 20 24 6e 61 return [list $na
1ae0: 6d 65 73 20 24 74 79 70 65 73 5d 0a 20 20 20 20 mes $types].
1af0: 7d 0a 0a 20 20 20 20 70 72 6f 63 20 6e 75 6d 76 }.. proc numv
1b00: 65 63 20 7b 72 6f 77 73 20 74 79 70 65 7d 20 7b ec {rows type} {
1b10: 0a 09 67 65 74 5f 70 20 24 72 6f 77 73 20 73 69 ..get_p $rows si
1b20: 7a 65 20 6f 66 66 0a 09 69 66 20 7b 24 73 69 7a ze off..if {$siz
1b30: 65 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 72 e == 0} {.. r
1b40: 65 74 75 72 6e 20 7b 30 20 30 7d 0a 09 7d 0a 09 eturn {0 0}..}..
1b50: 73 65 74 20 77 20 5b 65 78 70 72 20 7b 69 6e 74 set w [expr {int
1b60: 28 28 24 73 69 7a 65 3c 3c 33 29 20 2f 24 72 6f (($size<<3) /$ro
1b70: 77 73 29 7d 5d 0a 09 69 66 20 7b 24 72 6f 77 73 ws)}]..if {$rows
1b80: 20 3c 3d 20 37 20 26 26 20 30 20 3c 20 24 73 69 <= 7 && 0 < $si
1b90: 7a 65 20 26 26 20 24 73 69 7a 65 20 3c 3d 20 36 ze && $size <= 6
1ba0: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 77 20 5b } {.. set w [
1bb0: 6c 69 6e 64 65 78 20 5b 6c 69 6e 64 65 78 20 24 lindex [lindex $
1bc0: 76 3a 3a 77 69 64 74 68 73 20 5b 65 78 70 72 20 v::widths [expr
1bd0: 7b 24 72 6f 77 73 2d 31 7d 5d 5d 20 5b 65 78 70 {$rows-1}]] [exp
1be0: 72 20 7b 24 73 69 7a 65 2d 31 7d 5d 5d 0a 09 7d r {$size-1}]]..}
1bf0: 0a 09 69 66 20 7b 24 77 20 3d 3d 20 30 7d 20 7b ..if {$w == 0} {
1c00: 0a 09 20 20 20 20 65 72 72 6f 72 20 22 6e 75 6d .. error "num
1c10: 76 65 63 3f 22 0a 09 7d 0a 09 73 77 69 74 63 68 vec?"..}..switch
1c20: 20 24 74 79 70 65 5c 0a 09 20 20 20 20 20 20 46 $type\.. F
1c30: 20 7b 0a 09 09 20 20 20 20 73 65 74 20 77 20 33 {... set w 3
1c40: 32 66 0a 09 09 7d 5c 0a 09 20 20 20 20 20 20 44 2f...}\.. D
1c50: 20 7b 0a 09 09 20 20 20 20 73 65 74 20 77 20 36 {... set w 6
1c60: 34 66 0a 09 09 7d 0a 09 69 6e 63 72 20 6f 66 66 4f...}..incr off
1c70: 20 24 76 3a 3a 7a 65 72 6f 0a 09 72 65 74 75 72 $v::zero..retur
1c80: 6e 20 5b 6c 69 73 74 20 24 77 20 24 76 3a 3a 64 n [list $w $v::d
1c90: 61 74 61 20 24 6f 66 66 20 24 72 6f 77 73 5d 0a ata $off $rows].
1ca0: 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 }.. proc
1cb0: 6c 61 7a 79 5f 73 74 72 20 7b 73 65 6c 66 20 72 lazy_str {self r
1cc0: 6f 77 73 20 74 79 70 65 20 70 6f 73 20 73 69 7a ows type pos siz
1cd0: 65 73 20 6d 73 69 7a 65 20 6d 6f 66 66 20 69 6e es msize moff in
1ce0: 64 65 78 7d 20 7b 0a 09 73 65 74 20 73 6f 66 66 dex} {..set soff
1cf0: 20 7b 7d 0a 09 66 6f 72 20 7b 73 65 74 20 69 20 {}..for {set i
1d00: 30 7d 20 7b 24 69 20 3c 20 24 72 6f 77 73 7d 20 0} {$i < $rows}
1d10: 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 20 20 20 20 {incr i} {..
1d20: 73 65 74 20 6e 20 5b 6d 76 65 63 20 24 73 69 7a set n [mvec $siz
1d30: 65 73 20 24 69 5d 0a 09 20 20 20 20 6c 61 70 70 es $i].. lapp
1d40: 65 6e 64 20 73 6f 66 66 20 24 70 6f 73 0a 09 20 end soff $pos..
1d50: 20 20 20 69 6e 63 72 20 70 6f 73 20 24 6e 0a 09 incr pos $n..
1d60: 7d 0a 09 69 66 20 7b 24 6d 73 69 7a 65 20 3e 20 }..if {$msize >
1d70: 30 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 73 6c 0} {.. set sl
1d80: 65 6e 20 5b 6d 76 65 63 20 24 73 69 7a 65 73 20 en [mvec $sizes
1d90: 30 20 24 72 6f 77 73 5d 0a 09 20 20 20 20 73 65 0 $rows].. se
1da0: 74 20 76 3a 3a 63 75 72 72 20 24 6d 6f 66 66 0a t v::curr $moff.
1db0: 09 20 20 20 20 73 65 74 20 6c 69 6d 69 74 20 5b . set limit [
1dc0: 65 78 70 72 20 7b 24 6d 6f 66 66 2b 24 6d 73 69 expr {$moff+$msi
1dd0: 7a 65 7d 5d 0a 09 20 20 20 20 66 6f 72 20 7b 73 ze}].. for {s
1de0: 65 74 20 72 6f 77 20 30 7d 20 7b 24 76 3a 3a 63 et row 0} {$v::c
1df0: 75 72 72 20 3c 20 24 6c 69 6d 69 74 7d 20 7b 69 urr < $limit} {i
1e00: 6e 63 72 20 72 6f 77 7d 20 7b 0a 09 09 69 6e 63 ncr row} {...inc
1e10: 72 20 72 6f 77 20 5b 67 65 74 5f 76 5d 0a 09 09 r row [get_v]...
1e20: 67 65 74 5f 70 20 31 20 6d 73 20 6d 6f 0a 09 09 get_p 1 ms mo...
1e30: 73 65 74 20 73 6f 66 66 20 5b 6c 72 65 70 6c 61 set soff [lrepla
1e40: 63 65 20 24 73 6f 66 66 20 24 72 6f 77 20 24 72 ce $soff $row $r
1e50: 6f 77 20 24 6d 6f 5d 0a 09 09 73 65 74 20 73 6c ow $mo]...set sl
1e60: 65 6e 20 5b 6c 72 65 70 6c 61 63 65 20 24 73 6c en [lreplace $sl
1e70: 65 6e 20 24 72 6f 77 20 24 72 6f 77 20 24 6d 73 en $row $row $ms
1e80: 5d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 73 65 ].. }.. se
1e90: 74 20 73 69 7a 65 73 20 5b 6c 69 73 74 20 6c 69 t sizes [list li
1ea0: 6e 64 65 78 20 24 73 6c 65 6e 20 24 72 6f 77 73 ndex $slen $rows
1eb0: 5d 0a 09 7d 0a 09 69 66 20 7b 24 74 79 70 65 20 ]..}..if {$type
1ec0: 3d 3d 20 22 53 22 7d 20 7b 0a 09 20 20 20 20 73 == "S"} {.. s
1ed0: 65 74 20 61 64 6a 20 2d 31 0a 09 7d 20 65 6c 73 et adj -1..} els
1ee0: 65 20 7b 0a 09 20 20 20 20 73 65 74 20 61 64 6a e {.. set adj
1ef0: 20 30 0a 09 7d 0a 09 73 65 74 20 76 3a 3a 6e 6f 0..}..set v::no
1f00: 64 65 28 24 73 65 6c 66 29 20 5b 6c 69 73 74 20 de($self) [list
1f10: 67 65 74 5f 73 74 72 20 24 73 6f 66 66 20 24 73 get_str $soff $s
1f20: 69 7a 65 73 20 24 61 64 6a 20 24 72 6f 77 73 5d izes $adj $rows]
1f30: 0a 09 72 65 74 75 72 6e 20 5b 6d 76 65 63 20 24 ..return [mvec $
1f40: 76 3a 3a 6e 6f 64 65 28 24 73 65 6c 66 29 20 24 v::node($self) $
1f50: 69 6e 64 65 78 5d 0a 20 20 20 20 7d 0a 0a 20 20 index]. }..
1f60: 20 20 70 72 6f 63 20 67 65 74 5f 73 74 72 20 7b proc get_str {
1f70: 73 6f 66 66 20 73 69 7a 65 73 20 61 64 6a 20 69 soff sizes adj i
1f80: 6e 64 65 78 7d 20 7b 0a 09 73 65 74 20 6e 20 5b ndex} {..set n [
1f90: 6d 76 65 63 20 24 73 69 7a 65 73 20 24 69 6e 64 mvec $sizes $ind
1fa0: 65 78 5d 0a 09 72 65 74 75 72 6e 20 5b 62 79 74 ex]..return [byt
1fb0: 65 5f 73 65 67 20 5b 6c 69 6e 64 65 78 20 24 73 e_seg [lindex $s
1fc0: 6f 66 66 20 24 69 6e 64 65 78 5d 20 5b 69 6e 63 off $index] [inc
1fd0: 72 20 6e 20 24 61 64 6a 5d 5d 0a 20 20 20 20 7d r n $adj]]. }
1fe0: 0a 0a 20 20 20 20 70 72 6f 63 20 6c 61 7a 79 5f .. proc lazy_
1ff0: 73 75 62 20 7b 73 65 6c 66 20 64 65 73 63 20 73 sub {self desc s
2000: 69 7a 65 20 6f 66 66 20 72 6f 77 73 20 69 6e 64 ize off rows ind
2010: 65 78 7d 20 7b 0a 09 73 65 74 20 76 3a 3a 63 75 ex} {..set v::cu
2020: 72 72 20 24 6f 66 66 0a 09 6c 61 73 73 69 67 6e rr $off..lassign
2030: 20 5b 64 65 73 63 70 61 72 73 65 20 24 64 65 73 [descparse $des
2040: 63 5d 20 6e 61 6d 65 73 20 74 79 70 65 73 0a 09 c] names types..
2050: 73 65 74 20 73 75 62 73 20 7b 7d 0a 09 66 6f 72 set subs {}..for
2060: 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c {set i 0} {$i <
2070: 20 24 72 6f 77 73 7d 20 7b 69 6e 63 72 20 69 7d $rows} {incr i}
2080: 20 7b 0a 09 20 20 20 20 69 66 20 7b 5b 67 65 74 {.. if {[get
2090: 5f 76 5d 20 21 3d 20 30 7d 20 7b 0a 09 09 65 72 _v] != 0} {...er
20a0: 72 6f 72 20 22 6c 61 7a 79 5f 73 75 62 3f 22 0a ror "lazy_sub?".
20b0: 09 20 20 20 20 7d 0a 09 20 20 20 20 6c 61 70 70 . }.. lapp
20c0: 65 6e 64 20 73 75 62 73 20 5b 70 72 65 70 61 72 end subs [prepar
20d0: 65 20 24 74 79 70 65 73 5d 0a 09 7d 0a 09 73 65 e $types]..}..se
20e0: 74 20 76 3a 3a 6e 6f 64 65 28 24 73 65 6c 66 29 t v::node($self)
20f0: 20 5b 6c 69 73 74 20 67 65 74 5f 73 75 62 20 24 [list get_sub $
2100: 6e 61 6d 65 73 20 24 73 75 62 73 20 24 72 6f 77 names $subs $row
2110: 73 5d 0a 09 72 65 74 75 72 6e 20 5b 6d 76 65 63 s]..return [mvec
2120: 20 24 76 3a 3a 6e 6f 64 65 28 24 73 65 6c 66 29 $v::node($self)
2130: 20 24 69 6e 64 65 78 5d 0a 20 20 20 20 7d 0a 0a $index]. }..
2140: 23 70 72 6f 63 20 62 61 63 6b 74 72 61 63 65 20 #proc backtrace
2150: 7b 7b 6c 65 76 65 6c 5f 61 64 6a 20 30 7d 7d 20 {{level_adj 0}}
2160: 7b 0a 23 20 20 20 20 20 20 20 20 20 20 20 20 20 {.#
2170: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 72 set r
2180: 65 74 20 5b 6c 69 73 74 5d 20 20 20 20 20 20 20 et [list]
2190: 20 20 20 0a 23 0a 23 20 20 20 20 20 20 20 20 20 .#.#
21a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
21b0: 65 74 20 6c 65 76 65 6c 20 5b 65 78 70 72 20 30 et level [expr 0
21c0: 20 2d 20 24 6c 65 76 65 6c 5f 61 64 6a 5d 0a 23 - $level_adj].#
21d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21e0: 20 20 20 20 20 20 20 20 66 6f 72 20 7b 73 65 74 for {set
21f0: 20 69 20 5b 65 78 70 72 20 5b 69 6e 66 6f 20 6c i [expr [info l
2200: 65 76 65 6c 5d 20 2d 20 24 6c 65 76 65 6c 5f 61 evel] - $level_a
2210: 64 6a 5d 7d 20 7b 24 69 20 3e 20 31 7d 20 7b 69 dj]} {$i > 1} {i
2220: 6e 63 72 20 69 20 2d 31 7d 20 7b 0a 23 20 20 20 ncr i -1} {.#
2230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2240: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 6e 63 inc
2250: 72 20 6c 65 76 65 6c 20 2d 31 0a 23 20 20 20 20 r level -1.#
2260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2270: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
2280: 72 65 74 20 5b 6c 69 6e 73 65 72 74 20 24 72 65 ret [linsert $re
2290: 74 20 30 20 5b 6c 69 6e 64 65 78 20 5b 69 6e 66 t 0 [lindex [inf
22a0: 6f 20 6c 65 76 65 6c 20 24 6c 65 76 65 6c 5d 20 o level $level]
22b0: 30 5d 5d 0a 23 20 20 20 20 20 20 20 20 20 20 20 0]].#
22c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 23 }.#
22d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22e0: 20 20 20 20 20 20 20 20 73 65 74 20 72 65 74 20 set ret
22f0: 5b 6c 69 6e 73 65 72 74 20 24 72 65 74 20 30 20 [linsert $ret 0
2300: 47 4c 4f 42 41 4c 5d 0a 23 20 20 20 20 20 20 20 GLOBAL].#
2310: 20 0a 23 20 20 20 20 20 20 20 20 20 20 20 20 20 .#
2320: 20 20 20 20 20 20 20 20 20 20 20 72 65 74 75 72 retur
2330: 6e 20 24 72 65 74 0a 23 7d 0a 0a 20 20 20 20 70 n $ret.#}.. p
2340: 72 6f 63 20 67 65 74 5f 73 75 62 20 7b 6e 61 6d roc get_sub {nam
2350: 65 73 20 73 75 62 73 20 69 6e 64 65 78 7d 20 7b es subs index} {
2360: 0a 23 70 75 74 73 20 73 74 64 65 72 72 20 22 44 .#puts stderr "D
2370: 45 42 55 47 3a 20 67 65 74 5f 73 75 62 3a 20 5b EBUG: get_sub: [
2380: 6c 69 73 74 20 24 6e 61 6d 65 73 20 24 73 75 62 list $names $sub
2390: 73 20 24 69 6e 64 65 78 5d 22 0a 23 70 75 74 73 s $index]".#puts
23a0: 20 22 62 61 63 6b 74 72 61 63 65 3a 20 5b 62 61 "backtrace: [ba
23b0: 63 6b 74 72 61 63 65 5d 22 0a 09 6c 61 73 73 69 cktrace]"..lassi
23c0: 67 6e 20 5b 6c 69 6e 64 65 78 20 24 73 75 62 73 gn [lindex $subs
23d0: 20 24 69 6e 64 65 78 5d 20 72 6f 77 73 20 68 61 $index] rows ha
23e0: 6e 64 6c 65 72 73 0a 09 72 65 74 75 72 6e 20 5b ndlers..return [
23f0: 6c 69 73 74 20 67 65 74 5f 76 69 65 77 20 24 6e list get_view $n
2400: 61 6d 65 73 20 24 72 6f 77 73 20 24 68 61 6e 64 ames $rows $hand
2410: 6c 65 72 73 20 24 72 6f 77 73 5d 0a 20 20 20 20 lers $rows].
2420: 7d 0a 0a 20 20 20 20 70 72 6f 63 20 70 72 65 70 }.. proc prep
2430: 61 72 65 20 7b 74 79 70 65 73 7d 20 7b 0a 09 73 are {types} {..s
2440: 65 74 20 72 20 5b 67 65 74 5f 76 5d 0a 09 73 65 et r [get_v]..se
2450: 74 20 68 61 6e 64 6c 65 72 73 20 7b 7d 0a 09 66 t handlers {}..f
2460: 6f 72 65 61 63 68 20 78 20 24 74 79 70 65 73 20 oreach x $types
2470: 7b 0a 09 20 20 20 20 73 65 74 20 6e 20 5b 69 6e {.. set n [in
2480: 63 72 20 76 3a 3a 73 65 71 6e 5d 0a 09 20 20 20 cr v::seqn]..
2490: 20 6c 61 70 70 65 6e 64 20 68 61 6e 64 6c 65 72 lappend handler
24a0: 73 20 24 6e 0a 09 20 20 20 20 73 77 69 74 63 68 s $n.. switch
24b0: 20 24 78 20 7b 0a 09 09 49 20 2d 0a 09 09 4c 20 $x {...I -...L
24c0: 2d 0a 09 09 46 20 2d 0a 09 09 44 20 7b 0a 09 09 -...F -...D {...
24d0: 09 73 65 74 20 76 3a 3a 6e 6f 64 65 28 24 6e 29 .set v::node($n)
24e0: 20 5b 6e 75 6d 76 65 63 20 24 72 20 24 78 5d 0a [numvec $r $x].
24f0: 09 09 20 20 20 20 7d 0a 09 09 42 20 2d 0a 09 09 .. }...B -...
2500: 53 20 7b 0a 09 09 09 67 65 74 5f 70 20 24 72 20 S {....get_p $r
2510: 73 69 7a 65 20 6f 66 66 0a 09 09 09 73 65 74 20 size off....set
2520: 73 69 7a 65 73 20 7b 30 20 30 7d 0a 09 09 09 69 sizes {0 0}....i
2530: 66 20 7b 24 73 69 7a 65 20 3e 20 30 7d 20 7b 0a f {$size > 0} {.
2540: 09 09 09 20 20 20 20 73 65 74 20 73 69 7a 65 73 ... set sizes
2550: 20 5b 6e 75 6d 76 65 63 20 24 72 20 49 5d 0a 09 [numvec $r I]..
2560: 09 09 7d 0a 09 09 09 67 65 74 5f 70 20 24 72 20 ..}....get_p $r
2570: 6d 73 69 7a 65 20 6d 6f 66 66 0a 09 09 09 73 65 msize moff....se
2580: 74 20 76 3a 3a 6e 6f 64 65 28 24 6e 29 20 5b 6c t v::node($n) [l
2590: 69 73 74 20 6c 61 7a 79 5f 73 74 72 20 24 6e 20 ist lazy_str $n
25a0: 24 72 20 24 78 20 24 6f 66 66 20 24 73 69 7a 65 $r $x $off $size
25b0: 73 5c 0a 09 09 09 20 20 24 6d 73 69 7a 65 20 24 s\.... $msize $
25c0: 6d 6f 66 66 20 24 72 5d 0a 09 09 20 20 20 20 7d moff $r]... }
25d0: 0a 09 09 64 65 66 61 75 6c 74 20 7b 0a 09 09 09 ...default {....
25e0: 67 65 74 5f 70 20 24 72 20 73 69 7a 65 20 6f 66 get_p $r size of
25f0: 66 0a 09 09 09 73 65 74 20 76 3a 3a 6e 6f 64 65 f....set v::node
2600: 28 24 6e 29 20 5b 6c 69 73 74 20 6c 61 7a 79 5f ($n) [list lazy_
2610: 73 75 62 20 24 6e 20 24 78 20 24 73 69 7a 65 20 sub $n $x $size
2620: 24 6f 66 66 20 24 72 20 24 72 5d 0a 09 09 20 20 $off $r $r]...
2630: 20 20 7d 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 72 }.. }..}..r
2640: 65 74 75 72 6e 20 5b 6c 69 73 74 20 24 72 20 24 eturn [list $r $
2650: 68 61 6e 64 6c 65 72 73 5d 0a 20 20 20 20 7d 0a handlers]. }.
2660: 0a 20 20 20 20 70 72 6f 63 20 67 65 74 5f 76 69 . proc get_vi
2670: 65 77 20 7b 6e 61 6d 65 73 20 72 6f 77 73 20 68 ew {names rows h
2680: 61 6e 64 6c 65 72 73 20 69 6e 64 65 78 7d 20 7b andlers index} {
2690: 0a 09 72 65 74 75 72 6e 20 5b 6c 69 73 74 20 67 ..return [list g
26a0: 65 74 5f 70 72 6f 70 20 24 6e 61 6d 65 73 20 24 et_prop $names $
26b0: 72 6f 77 73 20 24 68 61 6e 64 6c 65 72 73 20 24 rows $handlers $
26c0: 69 6e 64 65 78 20 5b 6c 6c 65 6e 67 74 68 20 24 index [llength $
26d0: 6e 61 6d 65 73 5d 5d 0a 20 20 20 20 7d 0a 0a 20 names]]. }..
26e0: 20 20 20 70 72 6f 63 20 67 65 74 5f 70 72 6f 70 proc get_prop
26f0: 20 7b 6e 61 6d 65 73 20 72 6f 77 73 20 68 61 6e {names rows han
2700: 64 6c 65 72 73 20 69 6e 64 65 78 20 69 64 65 6e dlers index iden
2710: 74 7d 20 7b 0a 09 73 65 74 20 63 6f 6c 20 5b 6c t} {..set col [l
2720: 73 65 61 72 63 68 20 2d 65 78 61 63 74 20 24 6e search -exact $n
2730: 61 6d 65 73 20 24 69 64 65 6e 74 5d 0a 09 69 66 ames $ident]..if
2740: 20 7b 24 63 6f 6c 20 3c 20 30 7d 20 7b 0a 09 20 {$col < 0} {..
2750: 20 20 20 65 72 72 6f 72 20 22 75 6e 6b 6e 6f 77 error "unknow
2760: 6e 20 70 72 6f 70 65 72 74 79 3a 20 24 69 64 65 n property: $ide
2770: 6e 74 22 0a 09 7d 0a 09 73 65 74 20 68 20 5b 6c nt"..}..set h [l
2780: 69 6e 64 65 78 20 24 68 61 6e 64 6c 65 72 73 20 index $handlers
2790: 24 63 6f 6c 5d 0a 09 73 65 74 20 72 65 74 20 5b $col]..set ret [
27a0: 6d 76 65 63 20 24 76 3a 3a 6e 6f 64 65 28 24 68 mvec $v::node($h
27b0: 29 20 24 69 6e 64 65 78 5d 0a 0a 09 72 65 74 75 ) $index]...retu
27c0: 72 6e 20 24 72 65 74 0a 20 20 20 20 7d 0a 0a 20 rn $ret. }..
27d0: 20 20 20 70 72 6f 63 20 64 62 6f 70 65 6e 20 7b proc dbopen {
27e0: 64 62 20 66 69 6c 65 7d 20 7b 0a 09 23 20 6f 70 db file} {..# op
27f0: 65 6e 20 64 61 74 61 66 69 6c 65 2c 20 73 74 6f en datafile, sto
2800: 72 65 73 20 64 61 74 61 66 69 6c 65 20 64 65 73 res datafile des
2810: 63 72 69 70 74 6f 72 73 20 61 6e 64 20 73 74 61 criptors and sta
2820: 72 74 73 20 62 75 69 6c 64 69 6e 67 20 74 72 65 rts building tre
2830: 65 0a 09 69 66 20 7b 24 64 62 20 3d 3d 20 22 22 e..if {$db == ""
2840: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 72 20 7b } {.. set r {
2850: 7d 0a 09 20 20 20 20 66 6f 72 65 61 63 68 20 7b }.. foreach {
2860: 6b 20 76 7d 20 5b 61 72 72 61 79 20 67 65 74 20 k v} [array get
2870: 76 3a 3a 64 62 73 5d 20 7b 0a 09 09 6c 61 70 70 v::dbs] {...lapp
2880: 65 6e 64 20 72 20 24 6b 20 5b 6c 69 6e 64 65 78 end r $k [lindex
2890: 20 24 76 20 30 5d 0a 09 20 20 20 20 7d 0a 09 20 $v 0].. }..
28a0: 20 20 20 72 65 74 75 72 6e 20 24 72 0a 09 7d 0a return $r..}.
28b0: 09 66 65 74 63 68 20 24 66 69 6c 65 0a 09 68 65 .fetch $file..he
28c0: 61 64 65 72 0a 09 69 66 20 7b 5b 67 65 74 5f 76 ader..if {[get_v
28d0: 5d 20 21 3d 20 30 7d 20 7b 0a 09 20 20 20 20 65 ] != 0} {.. e
28e0: 72 72 6f 72 20 22 64 62 6f 70 65 6e 3f 22 0a 09 rror "dbopen?"..
28f0: 7d 0a 09 73 65 74 20 64 65 73 63 20 5b 6c 61 79 }..set desc [lay
2900: 6f 75 74 20 5b 67 65 74 5f 73 20 5b 67 65 74 5f out [get_s [get_
2910: 76 5d 5d 5d 0a 09 6c 61 73 73 69 67 6e 20 5b 64 v]]]..lassign [d
2920: 65 73 63 70 61 72 73 65 20 24 64 65 73 63 5d 20 escparse $desc]
2930: 6e 61 6d 65 73 20 74 79 70 65 73 0a 09 73 65 74 names types..set
2940: 20 72 6f 6f 74 20 5b 67 65 74 5f 73 75 62 20 24 root [get_sub $
2950: 6e 61 6d 65 73 20 5b 6c 69 73 74 20 5b 70 72 65 names [list [pre
2960: 70 61 72 65 20 24 74 79 70 65 73 5d 5d 20 30 5d pare $types]] 0]
2970: 0a 09 73 65 74 20 76 3a 3a 64 62 73 28 24 64 62 ..set v::dbs($db
2980: 29 20 5b 6c 69 73 74 20 24 66 69 6c 65 20 24 76 ) [list $file $v
2990: 3a 3a 64 61 74 61 20 24 64 65 73 63 20 5b 6d 76 ::data $desc [mv
29a0: 65 63 20 24 72 6f 6f 74 20 30 5d 5d 0a 09 72 65 ec $root 0]]..re
29b0: 74 75 72 6e 20 24 64 62 0a 20 20 20 20 7d 0a 0a turn $db. }..
29c0: 20 20 20 20 70 72 6f 63 20 64 62 63 6c 6f 73 65 proc dbclose
29d0: 20 7b 64 62 7d 20 7b 0a 09 23 20 63 6c 6f 73 65 {db} {..# close
29e0: 20 64 61 74 61 66 69 6c 65 2c 20 67 65 74 20 72 datafile, get r
29f0: 69 64 20 6f 66 20 73 74 6f 72 65 64 20 69 6e 66 id of stored inf
2a00: 6f 0a 09 75 6e 73 65 74 20 76 3a 3a 64 62 73 28 o..unset v::dbs(
2a10: 24 64 62 29 0a 09 73 65 74 20 76 3a 3a 64 61 74 $db)..set v::dat
2a20: 61 20 22 22 20 3b 23 20 69 74 20 6d 61 79 20 62 a "" ;# it may b
2a30: 65 20 62 69 67 20 0a 20 20 20 20 7d 0a 0a 20 20 e big . }..
2a40: 20 20 70 72 6f 63 20 64 62 74 72 65 65 20 7b 64 proc dbtree {d
2a50: 62 7d 20 7b 0a 09 23 20 64 61 74 61 66 69 6c 65 b} {..# datafile
2a60: 20 73 65 6c 65 63 74 69 6f 6e 2c 20 66 69 72 73 selection, firs
2a70: 74 20 73 74 65 70 20 69 6e 20 61 63 63 65 73 73 t step in access
2a80: 20 6e 61 76 69 67 61 74 69 6f 6e 20 6c 6f 6f 70 navigation loop
2a90: 0a 09 72 65 74 75 72 6e 20 5b 6c 69 6e 64 65 78 ..return [lindex
2aa0: 20 24 76 3a 3a 64 62 73 28 24 64 62 29 20 33 5d $v::dbs($db) 3]
2ab0: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 . }.. proc
2ac0: 20 61 63 63 65 73 73 20 7b 73 70 65 63 7d 20 7b access {spec} {
2ad0: 0a 09 23 20 74 68 69 73 20 69 73 20 74 68 65 20 ..# this is the
2ae0: 6d 61 69 6e 20 61 63 63 65 73 73 20 6e 61 76 69 main access navi
2af0: 67 61 74 69 6f 6e 20 6c 6f 6f 70 0a 09 73 65 74 gation loop..set
2b00: 20 73 20 5b 73 70 6c 69 74 20 24 73 70 65 63 20 s [split $spec
2b10: 22 2e 21 22 5d 0a 09 73 65 74 20 78 20 5b 6c 69 ".!"]..set x [li
2b20: 73 74 20 64 62 74 72 65 65 20 5b 61 72 72 61 79 st dbtree [array
2b30: 20 73 69 7a 65 20 76 3a 3a 64 62 73 5d 5d 0a 09 size v::dbs]]..
2b40: 66 6f 72 65 61 63 68 20 79 20 24 73 20 7b 0a 09 foreach y $s {..
2b50: 20 20 20 20 73 65 74 20 78 20 5b 6d 76 65 63 20 set x [mvec
2b60: 24 78 20 24 79 5d 0a 09 7d 0a 09 72 65 74 75 72 $x $y]..}..retur
2b70: 6e 20 24 78 0a 20 20 20 20 7d 0a 0a 20 20 20 20 n $x. }..
2b80: 70 72 6f 63 20 76 6e 61 6d 65 73 20 7b 76 69 65 proc vnames {vie
2b90: 77 7d 20 7b 0a 09 23 20 72 65 74 75 72 6e 20 61 w} {..# return a
2ba0: 20 6c 69 73 74 20 6f 66 20 70 72 6f 70 65 72 74 list of propert
2bb0: 79 20 6e 61 6d 65 73 0a 09 69 66 20 7b 5b 6c 69 y names..if {[li
2bc0: 6e 64 65 78 20 24 76 69 65 77 20 30 5d 20 21 3d ndex $view 0] !=
2bd0: 20 22 67 65 74 5f 76 69 65 77 22 7d 20 7b 0a 09 "get_view"} {..
2be0: 20 20 20 20 65 72 72 6f 72 20 22 76 6e 61 6d 65 error "vname
2bf0: 73 3f 22 0a 09 7d 0a 09 72 65 74 75 72 6e 20 5b s?"..}..return [
2c00: 6c 69 6e 64 65 78 20 24 76 69 65 77 20 31 5d 0a lindex $view 1].
2c10: 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 }.. proc
2c20: 76 6c 65 6e 20 7b 76 69 65 77 7d 20 7b 0a 09 23 vlen {view} {..#
2c30: 20 72 65 74 75 72 6e 20 74 68 65 20 6e 75 6d 62 return the numb
2c40: 65 72 20 6f 66 20 72 6f 77 73 20 69 6e 20 74 68 er of rows in th
2c50: 69 73 20 76 69 65 77 0a 09 69 66 20 7b 5b 6c 69 is view..if {[li
2c60: 6e 64 65 78 20 24 76 69 65 77 20 30 5d 20 21 3d ndex $view 0] !=
2c70: 20 22 67 65 74 5f 76 69 65 77 22 7d 20 7b 0a 09 "get_view"} {..
2c80: 20 20 20 20 65 72 72 6f 72 20 22 76 6c 65 6e 3f error "vlen?
2c90: 22 0a 09 7d 0a 09 72 65 74 75 72 6e 20 5b 6c 69 "..}..return [li
2ca0: 6e 64 65 78 20 24 76 69 65 77 20 32 5d 0a 20 20 ndex $view 2].
2cb0: 20 20 7d 0a 0a 20 20 20 20 23 20 76 69 6d 3a 20 }.. # vim:
2cc0: 66 74 3d 74 63 6c 0a 0a 7d 0a 0a 69 66 20 7b 5b ft=tcl..}..if {[
2cd0: 69 6e 66 6f 20 63 6f 6d 6d 20 6d 6b 5f 66 69 6c info comm mk_fil
2ce0: 65 5d 20 3d 3d 20 22 22 7d 20 7b 0a 20 20 20 20 e] == ""} {.
2cf0: 23 20 43 6f 6d 70 61 74 69 62 69 6c 69 74 79 20 # Compatibility
2d00: 6c 61 79 65 72 20 66 6f 72 20 4d 65 74 61 4b 69 layer for MetaKi
2d10: 74 0a 0a 20 20 20 20 23 20 72 65 71 75 69 72 65 t.. # require
2d20: 73 20 64 62 6f 70 65 6e 2f 64 62 63 6c 6f 73 65 s dbopen/dbclose
2d30: 2f 64 62 74 72 65 65 2f 61 63 63 65 73 73 2f 76 /dbtree/access/v
2d40: 6e 61 6d 65 73 2f 76 6c 65 6e 2f 6d 76 65 63 20 names/vlen/mvec
2d50: 70 72 69 6d 69 74 69 76 65 73 0a 20 20 20 20 23 primitives. #
2d60: 73 6f 75 72 63 65 20 5b 66 69 6c 65 20 6a 6f 69 source [file joi
2d70: 6e 20 5b 69 6e 66 6f 20 64 69 72 6e 61 6d 65 20 n [info dirname
2d80: 5b 69 6e 66 6f 20 73 63 72 69 70 74 5d 5d 20 64 [info script]] d
2d90: 65 63 6f 64 65 2e 74 63 6c 5d 0a 0a 20 20 20 20 ecode.tcl]..
2da0: 6e 61 6d 65 73 70 61 63 65 20 65 78 70 6f 72 74 namespace export
2db0: 20 6d 6b 5f 2a 0a 0a 20 20 20 20 70 72 6f 63 20 mk_*.. proc
2dc0: 6d 6b 5f 66 69 6c 65 20 7b 63 6d 64 20 61 72 67 mk_file {cmd arg
2dd0: 73 7d 20 7b 0a 23 73 65 74 20 69 6e 64 65 6e 74 s} {.#set indent
2de0: 20 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 [string repeat
2df0: 22 20 20 20 20 22 20 5b 69 6e 66 6f 20 6c 65 76 " " [info lev
2e00: 65 6c 5d 5d 0a 23 70 75 74 73 20 73 74 64 65 72 el]].#puts stder
2e10: 72 20 22 24 7b 69 6e 64 65 6e 74 7d 44 45 42 55 r "${indent}DEBU
2e20: 47 3a 20 72 65 61 64 6b 69 74 3a 3a 66 69 6c 65 G: readkit::file
2e30: 20 24 63 6d 64 20 24 61 72 67 73 22 0a 09 6c 61 $cmd $args"..la
2e40: 73 73 69 67 6e 20 24 61 72 67 73 20 64 62 20 66 ssign $args db f
2e50: 69 6c 65 0a 09 73 77 69 74 63 68 20 24 63 6d 64 ile..switch $cmd
2e60: 20 7b 0a 09 20 20 20 20 6f 70 65 6e 20 7b 0a 09 {.. open {..
2e70: 09 20 20 20 20 72 65 74 75 72 6e 20 5b 64 62 6f . return [dbo
2e80: 70 65 6e 20 24 64 62 20 24 66 69 6c 65 5d 0a 09 pen $db $file]..
2e90: 09 7d 0a 09 20 20 20 20 63 6c 6f 73 65 20 7b 0a .}.. close {.
2ea0: 09 09 20 20 20 20 64 62 63 6c 6f 73 65 20 24 64 .. dbclose $d
2eb0: 62 0a 09 09 7d 0a 09 20 20 20 20 76 69 65 77 73 b...}.. views
2ec0: 20 7b 0a 09 09 20 20 20 20 72 65 74 75 72 6e 20 {... return
2ed0: 5b 76 6e 61 6d 65 73 20 5b 64 62 74 72 65 65 20 [vnames [dbtree
2ee0: 24 64 62 5d 5d 0a 09 09 7d 0a 09 20 20 20 20 63 $db]]...}.. c
2ef0: 6f 6d 6d 69 74 20 7b 0a 0a 09 09 7d 0a 09 20 20 ommit {....}..
2f00: 20 20 64 65 66 61 75 6c 74 20 7b 0a 09 09 20 20 default {...
2f10: 20 20 65 72 72 6f 72 20 22 6d 6b 5f 66 69 6c 65 error "mk_file
2f20: 20 24 63 6d 64 3f 22 0a 09 09 7d 0a 09 7d 0a 20 $cmd?"...}..}.
2f30: 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 6d }.. proc m
2f40: 6b 5f 76 69 65 77 20 7b 63 6d 64 20 70 61 74 68 k_view {cmd path
2f50: 20 61 72 67 73 7d 20 7b 0a 23 73 65 74 20 69 6e args} {.#set in
2f60: 64 65 6e 74 20 5b 73 74 72 69 6e 67 20 72 65 70 dent [string rep
2f70: 65 61 74 20 22 20 20 20 20 22 20 5b 69 6e 66 6f eat " " [info
2f80: 20 6c 65 76 65 6c 5d 5d 0a 23 70 75 74 73 20 73 level]].#puts s
2f90: 74 64 65 72 72 20 22 24 7b 69 6e 64 65 6e 74 7d tderr "${indent}
2fa0: 44 45 42 55 47 3a 20 72 65 61 64 6b 69 74 3a 3a DEBUG: readkit::
2fb0: 76 69 65 77 20 24 63 6d 64 20 24 70 61 74 68 20 view $cmd $path
2fc0: 24 61 72 67 73 22 0a 09 6c 61 73 73 69 67 6e 20 $args"..lassign
2fd0: 24 61 72 67 73 20 61 31 0a 09 73 77 69 74 63 68 $args a1..switch
2fe0: 20 24 63 6d 64 20 7b 0a 09 20 20 20 20 69 6e 66 $cmd {.. inf
2ff0: 6f 20 7b 0a 09 09 20 20 20 20 72 65 74 75 72 6e o {... return
3000: 20 5b 76 6e 61 6d 65 73 20 5b 61 63 63 65 73 73 [vnames [access
3010: 20 24 70 61 74 68 5d 5d 0a 09 09 7d 0a 09 20 20 $path]]...}..
3020: 20 20 6c 61 79 6f 75 74 20 7b 0a 09 09 20 20 20 layout {...
3030: 20 73 65 74 20 6c 61 79 6f 75 74 20 22 4e 4f 54 set layout "NOT
3040: 59 45 54 22 0a 09 09 20 20 20 20 69 66 20 7b 5b YET"... if {[
3050: 6c 6c 65 6e 67 74 68 20 24 61 72 67 73 5d 20 3e llength $args] >
3060: 20 30 20 26 26 20 24 6c 61 79 6f 75 74 20 21 3d 0 && $layout !=
3070: 20 24 61 31 7d 20 7b 0a 09 09 09 23 65 72 72 6f $a1} {....#erro
3080: 72 20 22 76 69 65 77 20 72 65 73 74 72 75 63 74 r "view restruct
3090: 75 72 69 6e 67 20 6e 6f 74 20 73 75 70 70 6f 72 uring not suppor
30a0: 74 65 64 22 0a 09 09 20 20 20 20 7d 0a 09 09 20 ted"... }...
30b0: 20 20 20 72 65 74 75 72 6e 20 24 6c 61 79 6f 75 return $layou
30c0: 74 0a 09 09 7d 0a 09 20 20 20 20 73 69 7a 65 20 t...}.. size
30d0: 7b 0a 09 09 20 20 20 20 73 65 74 20 6c 65 6e 20 {... set len
30e0: 5b 76 6c 65 6e 20 5b 61 63 63 65 73 73 20 24 70 [vlen [access $p
30f0: 61 74 68 5d 5d 0a 09 09 20 20 20 20 69 66 20 7b ath]]... if {
3100: 5b 6c 6c 65 6e 67 74 68 20 24 61 72 67 73 5d 20 [llength $args]
3110: 3e 20 30 20 26 26 20 24 6c 65 6e 20 21 3d 20 24 > 0 && $len != $
3120: 61 31 7d 20 7b 0a 09 09 09 65 72 72 6f 72 20 22 a1} {....error "
3130: 76 69 65 77 20 72 65 73 69 7a 69 6e 67 20 6e 6f view resizing no
3140: 74 20 73 75 70 70 6f 72 74 65 64 22 0a 09 09 20 t supported"...
3150: 20 20 20 7d 0a 09 09 20 20 20 20 72 65 74 75 72 }... retur
3160: 6e 20 5b 76 6c 65 6e 20 5b 61 63 63 65 73 73 20 n [vlen [access
3170: 24 70 61 74 68 5d 5d 0a 09 09 7d 0a 09 20 20 20 $path]]...}..
3180: 20 64 65 66 61 75 6c 74 20 7b 0a 09 09 20 20 20 default {...
3190: 20 65 72 72 6f 72 20 22 6d 6b 5f 76 69 65 77 20 error "mk_view
31a0: 24 63 6d 64 3f 22 0a 09 09 7d 0a 09 7d 0a 20 20 $cmd?"...}..}.
31b0: 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 6d 6b }.. proc mk
31c0: 5f 63 75 72 73 6f 72 20 7b 63 6d 64 20 63 75 72 _cursor {cmd cur
31d0: 73 6f 72 20 61 72 67 73 7d 20 7b 0a 23 73 65 74 sor args} {.#set
31e0: 20 69 6e 64 65 6e 74 20 5b 73 74 72 69 6e 67 20 indent [string
31f0: 72 65 70 65 61 74 20 22 20 20 20 20 22 20 5b 69 repeat " " [i
3200: 6e 66 6f 20 6c 65 76 65 6c 5d 5d 0a 23 70 75 74 nfo level]].#put
3210: 73 20 73 74 64 65 72 72 20 22 24 7b 69 6e 64 65 s stderr "${inde
3220: 6e 74 7d 44 45 42 55 47 3a 20 72 65 61 64 6b 69 nt}DEBUG: readki
3230: 74 3a 3a 63 75 72 73 6f 72 20 24 63 6d 64 20 24 t::cursor $cmd $
3240: 63 75 72 73 6f 72 20 24 61 72 67 73 22 0a 09 75 cursor $args"..u
3250: 70 76 61 72 20 24 63 75 72 73 6f 72 20 76 0a 09 pvar $cursor v..
3260: 73 77 69 74 63 68 20 24 63 6d 64 20 7b 0a 09 20 switch $cmd {..
3270: 20 20 20 63 72 65 61 74 65 20 7b 0a 09 09 20 20 create {...
3280: 20 20 4e 4f 54 59 45 54 0a 09 09 7d 0a 09 20 20 NOTYET...}..
3290: 20 20 69 6e 63 72 20 7b 0a 09 09 20 20 20 20 4e incr {... N
32a0: 4f 54 59 45 54 0a 09 09 7d 0a 09 20 20 20 20 70 OTYET...}.. p
32b0: 6f 73 20 2d 0a 09 20 20 20 20 70 6f 73 69 74 69 os -.. positi
32c0: 6f 6e 20 7b 0a 09 09 20 20 20 20 69 66 20 7b 24 on {... if {$
32d0: 61 72 67 73 20 21 3d 20 22 22 7d 20 7b 0a 09 09 args != ""} {...
32e0: 09 72 65 67 73 75 62 20 7b 21 2d 3f 5c 64 2b 24 .regsub {!-?\d+$
32f0: 7d 20 24 76 20 7b 7d 20 76 0a 09 09 09 61 70 70 } $v {} v....app
3300: 65 6e 64 20 76 20 21 24 61 72 67 73 0a 09 09 09 end v !$args....
3310: 72 65 74 75 72 6e 20 24 61 72 67 73 0a 09 09 20 return $args...
3320: 20 20 20 7d 0a 09 09 20 20 20 20 69 66 20 7b 21 }... if {!
3330: 5b 72 65 67 65 78 70 20 7b 5c 64 2b 24 7d 20 24 [regexp {\d+$} $
3340: 76 20 6e 5d 7d 20 7b 0a 09 09 09 73 65 74 20 6e v n]} {....set n
3350: 20 2d 31 0a 09 09 20 20 20 20 7d 0a 09 09 20 20 -1... }...
3360: 20 20 72 65 74 75 72 6e 20 24 6e 0a 09 09 7d 0a return $n...}.
3370: 09 20 20 20 20 64 65 66 61 75 6c 74 20 7b 0a 09 . default {..
3380: 09 20 20 20 20 65 72 72 6f 72 20 22 6d 6b 5f 63 . error "mk_c
3390: 75 72 73 6f 72 20 24 63 6d 64 3f 22 0a 09 09 7d ursor $cmd?"...}
33a0: 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 ..}. }.. p
33b0: 72 6f 63 20 6d 6b 5f 67 65 74 20 7b 70 61 74 68 roc mk_get {path
33c0: 20 61 72 67 73 7d 20 7b 0a 23 73 65 74 20 69 6e args} {.#set in
33d0: 64 65 6e 74 20 5b 73 74 72 69 6e 67 20 72 65 70 dent [string rep
33e0: 65 61 74 20 22 20 20 20 20 22 20 5b 69 6e 66 6f eat " " [info
33f0: 20 6c 65 76 65 6c 5d 5d 0a 23 70 75 74 73 20 73 level]].#puts s
3400: 74 64 65 72 72 20 22 24 7b 69 6e 64 65 6e 74 7d tderr "${indent}
3410: 44 45 42 55 47 3a 20 72 65 61 64 6b 69 74 3a 3a DEBUG: readkit::
3420: 67 65 74 20 24 70 61 74 68 20 24 61 72 67 73 22 get $path $args"
3430: 0a 09 73 65 74 20 72 6f 77 72 65 66 20 5b 61 63 ..set rowref [ac
3440: 63 65 73 73 20 24 70 61 74 68 5d 0a 09 73 65 74 cess $path]..set
3450: 20 73 69 7a 65 64 20 30 0a 09 69 66 20 7b 5b 6c sized 0..if {[l
3460: 69 6e 64 65 78 20 24 61 72 67 73 20 30 5d 20 3d index $args 0] =
3470: 3d 20 22 2d 73 69 7a 65 22 7d 20 7b 0a 09 20 20 = "-size"} {..
3480: 20 20 73 65 74 20 73 69 7a 65 64 20 31 0a 09 20 set sized 1..
3490: 20 20 20 73 65 74 20 61 72 67 73 20 5b 6c 72 61 set args [lra
34a0: 6e 67 65 20 24 61 72 67 73 20 31 20 65 6e 64 5d nge $args 1 end]
34b0: 0a 09 7d 0a 09 73 65 74 20 69 64 73 20 30 0a 09 ..}..set ids 0..
34c0: 69 66 20 7b 5b 6c 6c 65 6e 67 74 68 20 24 61 72 if {[llength $ar
34d0: 67 73 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 gs] == 0} {..
34e0: 20 73 65 74 20 61 72 67 73 20 5b 76 6e 61 6d 65 set args [vname
34f0: 73 20 24 72 6f 77 72 65 66 5d 0a 09 20 20 20 20 s $rowref]..
3500: 73 65 74 20 69 64 73 20 31 0a 09 7d 0a 09 73 65 set ids 1..}..se
3510: 74 20 72 20 7b 7d 0a 09 66 6f 72 65 61 63 68 20 t r {}..foreach
3520: 78 20 24 61 72 67 73 20 7b 0a 09 20 20 20 20 69 x $args {.. i
3530: 66 20 7b 24 69 64 73 7d 20 7b 0a 09 09 6c 61 70 f {$ids} {...lap
3540: 70 65 6e 64 20 72 20 24 78 0a 09 20 20 20 20 7d pend r $x.. }
3550: 0a 09 20 20 20 20 73 65 74 20 76 20 5b 6d 76 65 .. set v [mve
3560: 63 20 24 72 6f 77 72 65 66 20 24 78 5d 0a 69 66 c $rowref $x].if
3570: 20 7b 5b 73 74 72 69 6e 67 20 72 61 6e 67 65 20 {[string range
3580: 24 76 20 30 20 38 5d 20 3d 3d 20 22 67 65 74 5f $v 0 8] == "get_
3590: 76 69 65 77 20 22 7d 20 7b 0a 23 20 58 58 58 3a view "} {.# XXX:
35a0: 20 3f 21 3f 21 3f 3a 20 54 4f 44 4f 3a 20 46 49 ?!?!?: TODO: FI
35b0: 58 0a 73 65 74 20 76 20 31 0a 7d 0a 09 20 20 20 X.set v 1.}..
35c0: 20 63 61 74 63 68 20 7b 0a 09 09 73 65 74 20 76 catch {...set v
35d0: 20 5b 7a 6c 69 62 20 64 65 63 6f 6d 70 72 65 73 [zlib decompres
35e0: 73 20 24 76 5d 0a 09 20 20 20 20 7d 0a 09 20 20 s $v].. }..
35f0: 20 20 69 66 20 7b 24 73 69 7a 65 64 7d 20 7b 0a if {$sized} {.
3600: 09 09 6c 61 70 70 65 6e 64 20 72 20 5b 73 74 72 ..lappend r [str
3610: 69 6e 67 20 6c 65 6e 67 74 68 20 24 76 5d 0a 09 ing length $v]..
3620: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 6c } else {...l
3630: 61 70 70 65 6e 64 20 72 20 24 76 0a 09 20 20 20 append r $v..
3640: 20 7d 0a 09 7d 0a 09 69 66 20 7b 5b 6c 6c 65 6e }..}..if {[llen
3650: 67 74 68 20 24 61 72 67 73 5d 20 3d 3d 20 31 7d gth $args] == 1}
3660: 20 7b 0a 09 20 20 20 20 73 65 74 20 72 20 5b 6c {.. set r [l
3670: 69 6e 64 65 78 20 24 72 20 30 5d 0a 09 7d 0a 0a index $r 0]..}..
3680: 09 72 65 74 75 72 6e 20 24 72 0a 20 20 20 20 7d .return $r. }
3690: 0a 0a 20 20 20 20 70 72 6f 63 20 6d 6b 5f 6c 6f .. proc mk_lo
36a0: 6f 70 20 7b 63 75 72 73 6f 72 20 70 61 74 68 20 op {cursor path
36b0: 61 72 67 73 7d 20 7b 0a 23 73 65 74 20 69 6e 64 args} {.#set ind
36c0: 65 6e 74 20 5b 73 74 72 69 6e 67 20 72 65 70 65 ent [string repe
36d0: 61 74 20 22 20 20 20 20 22 20 5b 69 6e 66 6f 20 at " " [info
36e0: 6c 65 76 65 6c 5d 5d 0a 23 70 75 74 73 20 73 74 level]].#puts st
36f0: 64 65 72 72 20 22 24 7b 69 6e 64 65 6e 74 7d 44 derr "${indent}D
3700: 45 42 55 47 3a 20 72 65 61 64 6b 69 74 3a 3a 6c EBUG: readkit::l
3710: 6f 6f 70 20 24 63 75 72 73 6f 72 20 24 70 61 74 oop $cursor $pat
3720: 68 20 2e 2e 2e 22 0a 09 75 70 76 61 72 20 24 63 h ..."..upvar $c
3730: 75 72 73 6f 72 20 76 0a 09 69 66 20 7b 5b 6c 6c ursor v..if {[ll
3740: 65 6e 67 74 68 20 24 61 72 67 73 5d 20 3d 3d 20 ength $args] ==
3750: 30 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 61 72 0} {.. set ar
3760: 67 73 20 5b 6c 69 73 74 20 24 70 61 74 68 5d 0a gs [list $path].
3770: 09 20 20 20 20 73 65 74 20 70 61 74 68 20 24 76 . set path $v
3780: 0a 09 20 20 20 20 72 65 67 73 75 62 20 7b 21 2d .. regsub {!-
3790: 3f 5c 64 2b 24 7d 20 24 70 61 74 68 20 7b 7d 20 ?\d+$} $path {}
37a0: 70 61 74 68 0a 09 7d 0a 09 6c 61 73 73 69 67 6e path..}..lassign
37b0: 20 24 61 72 67 73 20 61 31 20 61 32 20 61 33 20 $args a1 a2 a3
37c0: 61 34 0a 09 73 65 74 20 72 6f 77 72 65 66 20 5b a4..set rowref [
37d0: 61 63 63 65 73 73 20 24 70 61 74 68 5d 0a 09 73 access $path]..s
37e0: 65 74 20 66 69 72 73 74 20 30 0a 09 73 65 74 20 et first 0..set
37f0: 6c 69 6d 69 74 20 5b 76 6c 65 6e 20 24 72 6f 77 limit [vlen $row
3800: 72 65 66 5d 0a 09 73 65 74 20 73 74 65 70 20 31 ref]..set step 1
3810: 0a 09 73 77 69 74 63 68 20 5b 6c 6c 65 6e 67 74 ..switch [llengt
3820: 68 20 24 61 72 67 73 5d 20 7b 0a 09 20 20 20 20 h $args] {..
3830: 31 20 7b 0a 09 09 20 20 20 20 73 65 74 20 62 6f 1 {... set bo
3840: 64 79 20 24 61 31 0a 09 09 7d 0a 09 20 20 20 20 dy $a1...}..
3850: 32 20 7b 0a 09 09 20 20 20 20 73 65 74 20 66 69 2 {... set fi
3860: 72 73 74 20 24 61 31 0a 09 09 20 20 20 20 73 65 rst $a1... se
3870: 74 20 62 6f 64 79 20 24 61 32 0a 09 09 7d 0a 09 t body $a2...}..
3880: 20 20 20 20 33 20 7b 0a 09 09 20 20 20 20 73 65 3 {... se
3890: 74 20 66 69 72 73 74 20 24 61 31 0a 09 09 20 20 t first $a1...
38a0: 20 20 73 65 74 20 6c 69 6d 69 74 20 24 61 32 0a set limit $a2.
38b0: 09 09 20 20 20 20 73 65 74 20 62 6f 64 79 20 24 .. set body $
38c0: 61 33 0a 09 09 7d 0a 09 20 20 20 20 34 20 7b 0a a3...}.. 4 {.
38d0: 09 09 20 20 20 20 73 65 74 20 66 69 72 73 74 20 .. set first
38e0: 24 61 31 0a 09 09 20 20 20 20 73 65 74 20 6c 69 $a1... set li
38f0: 6d 69 74 20 24 61 32 0a 09 09 20 20 20 20 73 65 mit $a2... se
3900: 74 20 73 74 65 70 20 24 61 33 0a 09 09 20 20 20 t step $a3...
3910: 20 73 65 74 20 62 6f 64 79 20 24 61 34 0a 09 09 set body $a4...
3920: 7d 0a 09 20 20 20 20 64 65 66 61 75 6c 74 20 7b }.. default {
3930: 0a 09 09 20 20 20 20 65 72 72 6f 72 20 22 6d 6b ... error "mk
3940: 5f 6c 6f 6f 70 20 61 72 67 20 63 6f 75 6e 74 3f _loop arg count?
3950: 22 0a 09 09 7d 0a 09 7d 0a 09 73 65 74 20 63 6f "...}..}..set co
3960: 64 65 20 30 0a 09 66 6f 72 20 7b 73 65 74 20 69 de 0..for {set i
3970: 20 24 66 69 72 73 74 7d 20 7b 24 69 20 3c 20 24 $first} {$i < $
3980: 6c 69 6d 69 74 7d 20 7b 69 6e 63 72 20 69 20 24 limit} {incr i $
3990: 73 74 65 70 7d 20 7b 0a 09 20 20 20 20 73 65 74 step} {.. set
39a0: 20 76 20 24 70 61 74 68 21 24 69 0a 09 20 20 20 v $path!$i..
39b0: 20 73 65 74 20 63 6f 64 65 20 5b 63 61 74 63 68 set code [catch
39c0: 20 5b 6c 69 73 74 20 75 70 6c 65 76 65 6c 20 31 [list uplevel 1
39d0: 20 24 62 6f 64 79 5d 20 65 72 72 5d 0a 09 20 20 $body] err]..
39e0: 20 20 73 77 69 74 63 68 20 24 63 6f 64 65 20 7b switch $code {
39f0: 0a 09 09 31 20 2d 0a 09 09 32 20 7b 0a 09 09 09 ...1 -...2 {....
3a00: 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 24 63 6f return -code $co
3a10: 64 65 20 24 65 72 72 0a 09 09 20 20 20 20 7d 0a de $err... }.
3a20: 09 09 33 20 7b 0a 09 09 09 62 72 65 61 6b 0a 09 ..3 {....break..
3a30: 09 20 20 20 20 7d 0a 09 20 20 20 20 7d 0a 09 7d . }.. }..}
3a40: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 . }.. proc
3a50: 20 6d 6b 5f 73 65 6c 65 63 74 20 7b 70 61 74 68 mk_select {path
3a60: 20 61 72 67 73 7d 20 7b 0a 23 73 65 74 20 69 6e args} {.#set in
3a70: 64 65 6e 74 20 5b 73 74 72 69 6e 67 20 72 65 70 dent [string rep
3a80: 65 61 74 20 22 20 20 20 20 22 20 5b 69 6e 66 6f eat " " [info
3a90: 20 6c 65 76 65 6c 5d 5d 0a 23 70 75 74 73 20 73 level]].#puts s
3aa0: 74 64 65 72 72 20 22 24 7b 69 6e 64 65 6e 74 7d tderr "${indent}
3ab0: 44 45 42 55 47 3a 20 72 65 61 64 6b 69 74 3a 3a DEBUG: readkit::
3ac0: 73 65 6c 65 63 74 20 24 70 61 74 68 20 24 61 72 select $path $ar
3ad0: 67 73 22 0a 09 23 20 6f 6e 6c 79 20 68 61 6e 64 gs"..# only hand
3ae0: 6c 65 20 74 68 65 20 73 69 6d 70 6c 65 73 74 20 le the simplest
3af0: 63 61 73 65 3a 20 65 78 61 63 74 20 6d 61 74 63 case: exact matc
3b00: 68 65 73 0a 09 69 66 20 7b 5b 6c 69 6e 64 65 78 hes..if {[lindex
3b10: 20 24 61 72 67 73 20 30 5d 20 3d 3d 20 22 2d 63 $args 0] == "-c
3b20: 6f 75 6e 74 22 7d 20 7b 0a 09 09 73 65 74 20 6d ount"} {...set m
3b30: 61 78 69 74 65 6d 73 20 5b 6c 69 6e 64 65 78 20 axitems [lindex
3b40: 24 61 72 67 73 20 31 5d 0a 09 09 73 65 74 20 61 $args 1]...set a
3b50: 72 67 73 20 5b 6c 72 61 6e 67 65 20 24 61 72 67 rgs [lrange $arg
3b60: 73 20 32 20 65 6e 64 5d 0a 09 7d 0a 0a 09 73 65 s 2 end]..}...se
3b70: 74 20 63 75 72 72 6d 61 74 63 68 6d 6f 64 65 20 t currmatchmode
3b80: 22 63 61 73 65 69 6e 73 65 6e 73 69 74 69 76 65 "caseinsensitive
3b90: 22 0a 0a 09 73 65 74 20 6b 65 79 73 20 7b 7d 0a "...set keys {}.
3ba0: 09 73 65 74 20 76 61 6c 75 65 20 7b 7d 0a 09 73 .set value {}..s
3bb0: 65 74 20 6d 61 74 63 68 6d 6f 64 65 73 20 7b 7d et matchmodes {}
3bc0: 0a 09 66 6f 72 20 7b 73 65 74 20 69 64 78 20 30 ..for {set idx 0
3bd0: 7d 20 7b 24 69 64 78 20 3c 20 5b 6c 6c 65 6e 67 } {$idx < [lleng
3be0: 74 68 20 24 61 72 67 73 5d 7d 20 7b 69 6e 63 72 th $args]} {incr
3bf0: 20 69 64 78 20 32 7d 20 7b 0a 09 09 73 77 69 74 idx 2} {...swit
3c00: 63 68 20 2d 67 6c 6f 62 20 2d 2d 20 5b 6c 69 6e ch -glob -- [lin
3c10: 64 65 78 20 24 61 72 67 73 20 24 69 64 78 5d 20 dex $args $idx]
3c20: 7b 0a 09 09 09 22 2d 67 6c 6f 62 22 20 7b 0a 09 {...."-glob" {..
3c30: 09 09 09 73 65 74 20 63 75 72 72 6d 61 74 63 68 ...set currmatch
3c40: 6d 6f 64 65 20 22 67 6c 6f 62 22 0a 09 09 09 09 mode "glob".....
3c50: 69 6e 63 72 20 69 64 78 20 2d 31 0a 09 09 09 09 incr idx -1.....
3c60: 63 6f 6e 74 69 6e 75 65 0a 09 09 09 7d 0a 09 09 continue....}...
3c70: 09 22 2d 2a 22 20 7b 0a 09 09 09 09 65 72 72 6f ."-*" {.....erro
3c80: 72 20 22 55 6e 68 61 6e 64 6c 65 64 20 6f 70 74 r "Unhandled opt
3c90: 69 6f 6e 3a 20 5b 6c 69 6e 64 65 78 20 24 61 72 ion: [lindex $ar
3ca0: 67 73 20 24 69 64 78 5d 22 0a 09 09 09 7d 0a 09 gs $idx]"....}..
3cb0: 09 7d 0a 0a 09 09 73 65 74 20 6b 20 5b 6c 69 6e .}....set k [lin
3cc0: 64 65 78 20 24 61 72 67 73 20 24 69 64 78 5d 0a dex $args $idx].
3cd0: 09 09 73 65 74 20 76 20 5b 6c 69 6e 64 65 78 20 ..set v [lindex
3ce0: 24 61 72 67 73 20 5b 65 78 70 72 20 7b 24 69 64 $args [expr {$id
3cf0: 78 2b 31 7d 5d 5d 0a 0a 09 09 6c 61 70 70 65 6e x+1}]]....lappen
3d00: 64 20 6b 65 79 73 20 24 6b 0a 09 09 6c 61 70 70 d keys $k...lapp
3d10: 65 6e 64 20 76 61 6c 75 65 73 20 24 76 0a 09 09 end values $v...
3d20: 6c 61 70 70 65 6e 64 20 6d 61 74 63 68 6d 6f 64 lappend matchmod
3d30: 65 73 20 24 63 75 72 72 6d 61 74 63 68 6d 6f 64 es $currmatchmod
3d40: 65 0a 09 7d 0a 09 73 65 74 20 72 20 7b 7d 0a 09 e..}..set r {}..
3d50: 6d 6b 5f 6c 6f 6f 70 20 63 20 24 70 61 74 68 20 mk_loop c $path
3d60: 7b 0a 09 09 73 65 74 20 78 20 5b 65 76 61 6c 20 {...set x [eval
3d70: 6d 6b 5f 67 65 74 20 24 63 20 24 6b 65 79 73 5d mk_get $c $keys]
3d80: 0a 09 09 73 65 74 20 6d 61 74 63 68 43 6e 74 20 ...set matchCnt
3d90: 30 0a 09 09 66 6f 72 20 7b 73 65 74 20 69 64 78 0...for {set idx
3da0: 20 30 7d 20 7b 24 69 64 78 20 3c 20 5b 6c 6c 65 0} {$idx < [lle
3db0: 6e 67 74 68 20 24 78 5d 7d 20 7b 69 6e 63 72 20 ngth $x]} {incr
3dc0: 69 64 78 7d 20 7b 0a 09 09 09 73 65 74 20 76 61 idx} {....set va
3dd0: 6c 20 5b 6c 69 6e 64 65 78 20 24 76 61 6c 75 65 l [lindex $value
3de0: 73 20 24 69 64 78 5d 0a 09 09 09 73 65 74 20 63 s $idx]....set c
3df0: 68 6b 76 61 6c 20 5b 6c 69 6e 64 65 78 20 24 78 hkval [lindex $x
3e00: 20 24 69 64 78 5d 0a 09 09 09 73 65 74 20 6d 61 $idx]....set ma
3e10: 74 63 68 6d 6f 64 65 20 5b 6c 69 6e 64 65 78 20 tchmode [lindex
3e20: 24 6d 61 74 63 68 6d 6f 64 65 73 20 24 69 64 78 $matchmodes $idx
3e30: 5d 0a 0a 09 09 09 73 77 69 74 63 68 20 2d 2d 20 ].....switch --
3e40: 24 6d 61 74 63 68 6d 6f 64 65 20 7b 0a 09 09 09 $matchmode {....
3e50: 09 22 63 61 73 65 69 6e 73 65 6e 73 69 74 69 76 ."caseinsensitiv
3e60: 65 22 20 7b 0a 09 09 09 09 09 69 66 20 7b 24 76 e" {......if {$v
3e70: 61 6c 20 3d 3d 20 24 63 68 6b 76 61 6c 7d 20 7b al == $chkval} {
3e80: 0a 09 09 09 09 09 09 69 6e 63 72 20 6d 61 74 63 .......incr matc
3e90: 68 43 6e 74 0a 09 09 09 09 09 7d 0a 09 09 09 09 hCnt......}.....
3ea0: 7d 0a 09 09 09 09 22 67 6c 6f 62 22 20 7b 0a 09 }....."glob" {..
3eb0: 09 09 09 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 ....if {[string
3ec0: 6d 61 74 63 68 20 24 76 61 6c 20 24 63 68 6b 76 match $val $chkv
3ed0: 61 6c 5d 7d 20 7b 0a 09 09 09 09 09 09 69 6e 63 al]} {.......inc
3ee0: 72 20 6d 61 74 63 68 43 6e 74 0a 09 09 09 09 09 r matchCnt......
3ef0: 7d 0a 09 09 09 09 7d 0a 09 09 09 7d 0a 0a 09 09 }.....}....}....
3f00: 7d 0a 09 09 69 66 20 7b 24 6d 61 74 63 68 43 6e }...if {$matchCn
3f10: 74 20 3d 3d 20 5b 6c 6c 65 6e 67 74 68 20 24 6b t == [llength $k
3f20: 65 79 73 5d 7d 20 7b 0a 09 09 09 6c 61 70 70 65 eys]} {....lappe
3f30: 6e 64 20 72 20 5b 6d 6b 5f 63 75 72 73 6f 72 20 nd r [mk_cursor
3f40: 70 6f 73 69 74 69 6f 6e 20 63 5d 0a 09 09 7d 0a position c]...}.
3f50: 09 7d 0a 0a 09 69 66 20 7b 5b 69 6e 66 6f 20 65 .}...if {[info e
3f60: 78 69 73 74 73 20 6d 61 78 69 74 65 6d 73 5d 7d xists maxitems]}
3f70: 20 7b 0a 09 09 73 65 74 20 72 20 5b 6c 72 61 6e {...set r [lran
3f80: 67 65 20 24 72 20 30 20 5b 65 78 70 72 20 24 6d ge $r 0 [expr $m
3f90: 61 78 69 74 65 6d 73 20 2d 20 31 5d 5d 0a 09 7d axitems - 1]]..}
3fa0: 0a 0a 09 72 65 74 75 72 6e 20 24 72 0a 20 20 20 ...return $r.
3fb0: 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 6d 6b 5f }.. proc mk_
3fc0: 5f 72 65 63 68 61 6e 20 7b 70 61 74 68 20 70 72 _rechan {path pr
3fd0: 6f 70 20 63 6d 64 20 63 68 61 6e 20 61 72 67 73 op cmd chan args
3fe0: 7d 20 7b 0a 23 73 65 74 20 69 6e 64 65 6e 74 20 } {.#set indent
3ff0: 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 22 [string repeat "
4000: 20 20 20 20 22 20 5b 69 6e 66 6f 20 6c 65 76 65 " [info leve
4010: 6c 5d 5d 0a 23 70 75 74 73 20 73 74 64 65 72 72 l]].#puts stderr
4020: 20 22 24 7b 69 6e 64 65 6e 74 7d 44 45 42 55 47 "${indent}DEBUG
4030: 3a 20 72 65 61 64 6b 69 74 3a 3a 5f 72 65 63 68 : readkit::_rech
4040: 61 6e 20 24 70 61 74 68 20 24 70 72 6f 70 20 24 an $path $prop $
4050: 63 6d 64 20 24 63 68 61 6e 20 24 61 72 67 73 22 cmd $chan $args"
4060: 0a 0a 20 20 20 20 20 20 20 20 73 65 74 20 6b 65 .. set ke
4070: 79 20 5b 6c 69 73 74 20 24 70 61 74 68 20 24 70 y [list $path $p
4080: 72 6f 70 5d 0a 20 20 20 20 20 20 20 20 69 66 20 rop]. if
4090: 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 3a {![info exists :
40a0: 3a 6d 6b 5f 5f 63 61 63 68 65 28 24 6b 65 79 29 :mk__cache($key)
40b0: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 73 ]} {. s
40c0: 65 74 20 3a 3a 6d 6b 5f 5f 63 61 63 68 65 28 24 et ::mk__cache($
40d0: 6b 65 79 29 20 5b 72 65 61 64 6b 69 74 3a 3a 67 key) [readkit::g
40e0: 65 74 20 24 70 61 74 68 20 24 70 72 6f 70 5d 0a et $path $prop].
40f0: 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 20 20 }.
4100: 20 20 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 if {![info exi
4110: 73 74 73 20 3a 3a 6d 6b 5f 5f 6f 66 66 73 65 74 sts ::mk__offset
4120: 28 24 6b 65 79 29 5d 7d 20 7b 0a 20 20 20 20 20 ($key)]} {.
4130: 20 20 20 20 20 73 65 74 20 3a 3a 6d 6b 5f 5f 6f set ::mk__o
4140: 66 66 73 65 74 28 24 6b 65 79 29 20 30 0a 20 20 ffset($key) 0.
4150: 20 20 20 20 20 20 7d 0a 20 20 20 20 20 20 20 20 }.
4160: 73 65 74 20 64 61 74 61 20 24 3a 3a 6d 6b 5f 5f set data $::mk__
4170: 63 61 63 68 65 28 24 6b 65 79 29 0a 20 20 20 20 cache($key).
4180: 20 20 20 20 73 65 74 20 6f 66 66 73 65 74 20 24 set offset $
4190: 3a 3a 6d 6b 5f 5f 6f 66 66 73 65 74 28 24 6b 65 ::mk__offset($ke
41a0: 79 29 0a 0a 20 20 20 20 20 20 20 20 73 77 69 74 y).. swit
41b0: 63 68 20 2d 2d 20 24 63 6d 64 20 7b 0a 20 20 20 ch -- $cmd {.
41c0: 20 20 20 20 20 20 20 20 20 22 72 65 61 64 22 20 "read"
41d0: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
41e0: 20 20 73 65 74 20 63 6f 75 6e 74 20 5b 6c 69 6e set count [lin
41f0: 64 65 78 20 24 61 72 67 73 20 30 5d 0a 20 20 20 dex $args 0].
4200: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 set
4210: 20 72 65 74 76 61 6c 20 5b 73 74 72 69 6e 67 20 retval [string
4220: 72 61 6e 67 65 20 24 64 61 74 61 20 24 6f 66 66 range $data $off
4230: 73 65 74 20 5b 65 78 70 72 20 7b 24 6f 66 66 73 set [expr {$offs
4240: 65 74 20 2b 20 24 63 6f 75 6e 74 20 2d 20 31 7d et + $count - 1}
4250: 5d 5d 0a 0a 20 20 20 20 20 20 20 20 20 20 20 20 ]]..
4260: 20 20 20 20 73 65 74 20 72 65 61 64 62 79 74 65 set readbyte
4270: 73 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 s [string length
4280: 20 24 72 65 74 76 61 6c 5d 0a 0a 20 20 20 20 20 $retval]..
4290: 20 20 20 20 20 20 20 20 20 20 20 69 6e 63 72 20 incr
42a0: 6f 66 66 73 65 74 20 24 72 65 61 64 62 79 74 65 offset $readbyte
42b0: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a s. }.
42c0: 20 20 20 20 20 20 20 20 20 20 20 20 22 63 6c 6f "clo
42d0: 73 65 22 20 7b 0a 20 20 20 20 20 20 20 20 20 20 se" {.
42e0: 20 20 20 20 20 20 75 6e 73 65 74 20 2d 6e 6f 63 unset -noc
42f0: 6f 6d 70 6c 61 69 6e 20 3a 3a 6d 6b 5f 5f 63 61 omplain ::mk__ca
4300: 63 68 65 28 24 6b 65 79 29 0a 20 20 20 20 20 20 che($key).
4310: 20 20 20 20 20 20 20 20 20 20 75 6e 73 65 74 20 unset
4320: 2d 6e 6f 63 6f 6d 70 6c 61 69 6e 20 3a 3a 6d 6b -nocomplain ::mk
4330: 5f 5f 6f 66 66 73 65 74 28 24 6b 65 79 29 0a 20 __offset($key).
4340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 r
4350: 65 74 75 72 6e 0a 20 20 20 20 20 20 20 20 20 20 eturn.
4360: 20 20 7d 0a 20 20 20 20 20 20 20 20 20 20 20 20 }.
4370: 64 65 66 61 75 6c 74 20 7b 0a 23 70 75 74 73 20 default {.#puts
4380: 73 74 64 65 72 72 20 22 24 7b 69 6e 64 65 6e 74 stderr "${indent
4390: 7d 44 45 42 55 47 3a 20 72 65 61 64 6b 69 74 3a }DEBUG: readkit:
43a0: 3a 5f 72 65 63 68 61 6e 3a 20 43 61 6c 6c 65 64 :_rechan: Called
43b0: 20 66 6f 72 20 63 6d 64 20 24 63 6d 64 22 0a 20 for cmd $cmd".
43c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 r
43d0: 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 6f eturn -code erro
43e0: 72 20 22 4e 6f 74 20 69 6d 70 6c 65 6d 65 6e 74 r "Not implement
43f0: 65 64 3a 20 63 6d 64 20 3d 20 24 63 6d 64 22 0a ed: cmd = $cmd".
4400: 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 20 20 }.
4410: 20 20 20 20 20 20 7d 0a 0a 20 20 20 20 20 20 20 }..
4420: 20 73 65 74 20 3a 3a 6d 6b 5f 5f 6f 66 66 73 65 set ::mk__offse
4430: 74 28 24 6b 65 79 29 20 24 6f 66 66 73 65 74 0a t($key) $offset.
4440: 0a 09 72 65 74 75 72 6e 20 24 72 65 74 76 61 6c ..return $retval
4450: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 . }.. proc
4460: 20 6d 6b 5f 63 68 61 6e 6e 65 6c 20 7b 70 61 74 mk_channel {pat
4470: 68 20 70 72 6f 70 20 7b 6d 6f 64 65 20 22 72 22 h prop {mode "r"
4480: 7d 7d 20 7b 0a 23 73 65 74 20 69 6e 64 65 6e 74 }} {.#set indent
4490: 20 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 [string repeat
44a0: 22 20 20 20 20 22 20 5b 69 6e 66 6f 20 6c 65 76 " " [info lev
44b0: 65 6c 5d 5d 0a 23 70 75 74 73 20 73 74 64 65 72 el]].#puts stder
44c0: 72 20 22 24 7b 69 6e 64 65 6e 74 7d 44 45 42 55 r "${indent}DEBU
44d0: 47 3a 20 72 65 61 64 6b 69 74 3a 3a 63 68 61 6e G: readkit::chan
44e0: 6e 65 6c 20 24 70 61 74 68 20 24 70 72 6f 70 20 nel $path $prop
44f0: 24 6d 6f 64 65 22 0a 09 73 65 74 20 66 64 20 5b $mode"..set fd [
4500: 72 65 63 68 61 6e 20 5b 6c 69 73 74 20 6d 6b 5f rechan [list mk_
4510: 5f 72 65 63 68 61 6e 20 24 70 61 74 68 20 24 70 _rechan $path $p
4520: 72 6f 70 5d 20 32 5d 0a 0a 09 72 65 74 75 72 6e rop] 2]...return
4530: 20 24 66 64 0a 20 20 20 20 7d 0a 20 20 20 20 23 $fd. }. #
4540: 20 76 69 6d 3a 20 66 74 3d 74 63 6c 0a 0a 7d 0a vim: ft=tcl..}.
4550: 0a 23 20 73 65 74 20 75 70 20 74 68 65 20 4d 65 .# set up the Me
4560: 74 61 4b 69 74 20 63 6f 6d 70 61 74 69 62 69 6c taKit compatibil
4570: 69 74 79 20 64 65 66 69 6e 69 74 69 6f 6e 73 0a ity definitions.
4580: 66 6f 72 65 61 63 68 20 78 20 7b 66 69 6c 65 20 foreach x {file
4590: 76 69 65 77 20 63 75 72 73 6f 72 20 67 65 74 20 view cursor get
45a0: 6c 6f 6f 70 20 73 65 6c 65 63 74 20 63 68 61 6e loop select chan
45b0: 6e 65 6c 7d 20 7b 0a 20 20 20 20 69 6e 74 65 72 nel} {. inter
45c0: 70 20 61 6c 69 61 73 20 7b 7d 20 3a 3a 72 65 61 p alias {} ::rea
45d0: 64 6b 69 74 3a 3a 24 78 20 7b 7d 20 3a 3a 6d 6b dkit::$x {} ::mk
45e0: 5f 24 78 0a 7d 0a 0a 0a 0a 23 20 6d 6b 34 76 66 _$x.}....# mk4vf
45f0: 73 2e 74 63 6c 20 2d 2d 20 4d 6b 34 74 63 6c 20 s.tcl -- Mk4tcl
4600: 56 69 72 74 75 61 6c 20 46 69 6c 65 20 53 79 73 Virtual File Sys
4610: 74 65 6d 20 64 72 69 76 65 72 0a 23 20 43 6f 70 tem driver.# Cop
4620: 79 72 69 67 68 74 20 28 43 29 20 31 39 39 37 2d yright (C) 1997-
4630: 32 30 30 33 20 53 65 6e 73 75 73 20 43 6f 6e 73 2003 Sensus Cons
4640: 75 6c 74 69 6e 67 20 4c 74 64 2e 20 41 6c 6c 20 ulting Ltd. All
4650: 52 69 67 68 74 73 20 52 65 73 65 72 76 65 64 2e Rights Reserved.
4660: 0a 23 20 4d 61 74 74 20 4e 65 77 6d 61 6e 20 3c .# Matt Newman <
4670: 6d 61 74 74 40 73 65 6e 73 75 73 2e 6f 72 67 3e matt@sensus.org>
4680: 20 61 6e 64 20 4a 65 61 6e 2d 43 6c 61 75 64 65 and Jean-Claude
4690: 20 57 69 70 70 6c 65 72 20 3c 6a 63 77 40 65 71 Wippler <jcw@eq
46a0: 75 69 34 2e 63 6f 6d 3e 0a 23 0a 23 20 24 49 64 ui4.com>.#.# $Id
46b0: 3a 20 6d 6b 34 76 66 73 2e 74 63 6c 2c 76 20 31 : mk4vfs.tcl,v 1
46c0: 2e 34 31 20 32 30 30 38 2f 30 34 2f 31 35 20 32 .41 2008/04/15 2
46d0: 31 3a 31 31 3a 35 33 20 61 6e 64 72 65 61 73 5f 1:11:53 andreas_
46e0: 6b 75 70 72 69 65 73 20 45 78 70 20 24 0a 23 0a kupries Exp $.#.
46f0: 23 20 30 35 61 70 72 30 32 20 6a 63 77 09 31 2e # 05apr02 jcw.1.
4700: 33 09 66 69 78 65 64 20 61 70 70 65 6e 64 20 6d 3.fixed append m
4710: 6f 64 65 20 26 20 63 6c 6f 73 65 2c 0a 23 09 09 ode & close,.#..
4720: 09 70 72 69 76 61 74 69 7a 65 64 20 6d 65 6d 63 .privatized memc
4730: 68 61 6e 5f 68 61 6e 64 6c 65 72 0a 23 09 09 09 han_handler.#...
4740: 61 64 64 65 64 20 7a 69 70 2c 20 63 72 63 20 62 added zip, crc b
4750: 61 63 6b 20 69 6e 0a 23 20 32 38 61 70 72 30 32 ack in.# 28apr02
4760: 20 6a 63 77 09 31 2e 34 09 72 65 6f 72 67 65 64 jcw.1.4.reorged
4770: 20 6d 65 6d 63 68 61 6e 20 61 6e 64 20 70 6b 67 memchan and pkg
4780: 20 64 65 70 65 6e 64 65 6e 63 69 65 73 0a 23 20 dependencies.#
4790: 32 32 6a 75 6e 30 32 20 6a 63 77 09 31 2e 35 09 22jun02 jcw.1.5.
47a0: 66 69 78 65 64 20 72 65 63 75 72 73 69 76 65 20 fixed recursive
47b0: 64 69 72 20 64 65 6c 65 74 69 6f 6e 0a 23 20 31 dir deletion.# 1
47c0: 36 6f 63 74 30 32 20 6a 63 77 09 31 2e 36 09 66 6oct02 jcw.1.6.f
47d0: 69 78 65 64 20 70 65 72 69 6f 64 69 63 20 63 6f ixed periodic co
47e0: 6d 6d 69 74 20 6f 6e 63 65 20 61 20 63 68 61 6e mmit once a chan
47f0: 67 65 20 69 73 20 6d 61 64 65 0a 23 20 32 30 6a ge is made.# 20j
4800: 61 6e 30 33 20 6a 63 77 09 31 2e 37 09 73 74 72 an03 jcw.1.7.str
4810: 65 61 6d 65 64 20 7a 6c 69 62 20 64 65 63 6f 6d eamed zlib decom
4820: 70 72 65 73 73 20 6d 6f 64 65 2c 20 72 65 64 75 press mode, redu
4830: 63 65 73 20 6d 65 6d 6f 72 79 20 75 73 61 67 65 ces memory usage
4840: 0a 23 20 30 31 66 65 62 30 33 20 6a 63 77 09 31 .# 01feb03 jcw.1
4850: 2e 38 09 66 69 78 20 6d 6f 75 6e 74 69 6e 67 20 .8.fix mounting
4860: 61 20 73 79 6d 6c 69 6e 6b 2c 20 63 6c 65 61 6e a symlink, clean
4870: 75 70 20 6d 6f 75 6e 74 2f 75 6e 6d 6f 75 6e 74 up mount/unmount
4880: 20 70 72 6f 63 73 0a 23 20 30 34 66 65 62 30 33 procs.# 04feb03
4890: 20 6a 63 77 09 31 2e 38 09 77 68 6f 6f 70 73 2c jcw.1.8.whoops,
48a0: 20 72 65 73 74 6f 72 65 64 20 76 66 73 3a 3a 6d restored vfs::m
48b0: 6b 63 6c 3a 3a 55 6e 6d 6f 75 6e 74 20 6c 6f 67 kcl::Unmount log
48c0: 69 63 0a 23 20 31 37 6d 61 72 30 33 20 6a 63 77 ic.# 17mar03 jcw
48d0: 09 31 2e 39 09 73 74 61 72 74 20 77 69 74 68 20 .1.9.start with
48e0: 6d 6f 64 65 20 74 72 61 6e 73 6c 75 63 65 6e 74 mode translucent
48f0: 20 6f 72 20 72 65 61 64 77 72 69 74 65 0a 23 20 or readwrite.#
4900: 31 38 6f 63 74 30 35 20 6a 63 77 09 31 2e 31 30 18oct05 jcw.1.10
4910: 09 61 64 64 20 66 61 6c 6c 62 61 63 6b 20 74 6f .add fallback to
4920: 20 4d 4b 20 43 6f 6d 70 61 74 69 62 6c 65 20 4c MK Compatible L
4930: 69 74 65 20 64 72 69 76 65 72 20 28 76 66 73 3a ite driver (vfs:
4940: 3a 6d 6b 63 6c 29 0a 0a 23 20 52 65 6d 6f 76 65 :mkcl)..# Remove
4950: 64 20 70 72 6f 76 69 73 69 6f 6e 20 6f 66 20 74 d provision of t
4960: 68 65 20 62 61 63 6b 77 61 72 64 20 63 6f 6d 70 he backward comp
4970: 61 74 69 62 6c 65 20 6e 61 6d 65 2e 20 4d 6f 76 atible name. Mov
4980: 65 64 20 74 6f 20 73 65 70 61 72 61 74 65 0a 23 ed to separate.#
4990: 20 66 69 6c 65 2f 70 61 63 6b 61 67 65 2e 0a 63 file/package..c
49a0: 61 74 63 68 20 7b 0a 09 6c 6f 61 64 20 7b 7d 20 atch {..load {}
49b0: 76 66 73 0a 7d 0a 70 61 63 6b 61 67 65 20 72 65 vfs.}.package re
49c0: 71 75 69 72 65 20 76 66 73 0a 0a 23 20 74 68 69 quire vfs..# thi
49d0: 6e 67 73 20 74 68 61 74 20 63 61 6e 20 6e 6f 20 ngs that can no
49e0: 6c 6f 6e 67 65 72 20 72 65 61 6c 6c 79 20 62 65 longer really be
49f0: 20 6c 65 66 74 20 6f 75 74 20 28 62 75 74 20 74 left out (but t
4a00: 68 69 73 20 69 73 20 74 68 65 20 77 72 6f 6e 67 his is the wrong
4a10: 20 73 70 6f 74 21 29 0a 23 20 62 65 20 61 73 20 spot!).# be as
4a20: 6e 6f 6e 2d 69 6e 76 61 73 69 76 65 20 61 73 20 non-invasive as
4a30: 70 6f 73 73 69 62 6c 65 2c 20 75 73 69 6e 67 20 possible, using
4a40: 74 68 65 73 65 20 64 65 66 69 6e 69 74 69 6f 6e these definition
4a50: 73 20 61 73 20 6c 61 73 74 20 72 65 73 6f 72 74 s as last resort
4a60: 0a 0a 6e 61 6d 65 73 70 61 63 65 20 65 76 61 6c ..namespace eval
4a70: 20 76 66 73 3a 3a 6d 6b 63 6c 20 7b 0a 20 20 20 vfs::mkcl {.
4a80: 20 70 72 6f 63 20 4d 6f 75 6e 74 20 7b 6d 6b 66 proc Mount {mkf
4a90: 69 6c 65 20 6c 6f 63 61 6c 20 61 72 67 73 7d 20 ile local args}
4aa0: 7b 0a 09 69 66 20 7b 24 6d 6b 66 69 6c 65 20 21 {..if {$mkfile !
4ab0: 3d 20 22 22 7d 20 7b 0a 09 20 20 23 20 64 65 72 = ""} {.. # der
4ac0: 65 66 65 72 65 6e 63 65 20 61 20 73 79 6d 6c 69 eference a symli
4ad0: 6e 6b 2c 20 6f 74 68 65 72 77 69 73 65 20 6d 6f nk, otherwise mo
4ae0: 75 6e 74 69 6e 67 20 6f 6e 20 69 74 20 66 61 69 unting on it fai
4af0: 6c 73 20 28 77 68 79 3f 29 0a 09 20 20 63 61 74 ls (why?).. cat
4b00: 63 68 20 7b 0a 09 20 20 20 20 73 65 74 20 6d 6b ch {.. set mk
4b10: 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 file [file join
4b20: 5b 66 69 6c 65 20 64 69 72 6e 61 6d 65 20 24 6d [file dirname $m
4b30: 6b 66 69 6c 65 5d 20 5c 0a 09 20 20 20 20 09 09 kfile] \.. ..
4b40: 09 20 20 5b 66 69 6c 65 20 72 65 61 64 6c 69 6e . [file readlin
4b50: 6b 20 24 6d 6b 66 69 6c 65 5d 5d 0a 09 20 20 7d k $mkfile]].. }
4b60: 0a 09 20 20 73 65 74 20 6d 6b 66 69 6c 65 20 5b .. set mkfile [
4b70: 66 69 6c 65 20 6e 6f 72 6d 61 6c 69 7a 65 20 24 file normalize $
4b80: 6d 6b 66 69 6c 65 5d 0a 09 7d 0a 09 73 65 74 20 mkfile]..}..set
4b90: 64 62 20 5b 65 76 61 6c 20 5b 6c 69 73 74 20 3a db [eval [list :
4ba0: 3a 6d 6b 63 6c 5f 76 66 73 3a 3a 5f 6d 6f 75 6e :mkcl_vfs::_moun
4bb0: 74 20 24 6d 6b 66 69 6c 65 5d 20 24 61 72 67 73 t $mkfile] $args
4bc0: 5d 0a 09 3a 3a 76 66 73 3a 3a 66 69 6c 65 73 79 ]..::vfs::filesy
4bd0: 73 74 65 6d 20 6d 6f 75 6e 74 20 24 6c 6f 63 61 stem mount $loca
4be0: 6c 20 5b 6c 69 73 74 20 3a 3a 76 66 73 3a 3a 6d l [list ::vfs::m
4bf0: 6b 63 6c 3a 3a 68 61 6e 64 6c 65 72 20 24 64 62 kcl::handler $db
4c00: 5d 0a 09 3a 3a 76 66 73 3a 3a 52 65 67 69 73 74 ]..::vfs::Regist
4c10: 65 72 4d 6f 75 6e 74 20 24 6c 6f 63 61 6c 20 5b erMount $local [
4c20: 6c 69 73 74 20 3a 3a 76 66 73 3a 3a 6d 6b 63 6c list ::vfs::mkcl
4c30: 3a 3a 55 6e 6d 6f 75 6e 74 20 24 64 62 5d 0a 09 ::Unmount $db]..
4c40: 72 65 74 75 72 6e 20 24 64 62 0a 20 20 20 20 7d return $db. }
4c50: 0a 0a 20 20 20 20 70 72 6f 63 20 55 6e 6d 6f 75 .. proc Unmou
4c60: 6e 74 20 7b 64 62 20 6c 6f 63 61 6c 7d 20 7b 0a nt {db local} {.
4c70: 09 76 66 73 3a 3a 66 69 6c 65 73 79 73 74 65 6d .vfs::filesystem
4c80: 20 75 6e 6d 6f 75 6e 74 20 24 6c 6f 63 61 6c 0a unmount $local.
4c90: 09 3a 3a 6d 6b 63 6c 5f 76 66 73 3a 3a 5f 75 6d .::mkcl_vfs::_um
4ca0: 6f 75 6e 74 20 24 64 62 0a 20 20 20 20 7d 0a 0a ount $db. }..
4cb0: 20 20 20 20 70 72 6f 63 20 61 74 74 72 69 62 75 proc attribu
4cc0: 74 65 73 20 7b 64 62 7d 20 7b 20 72 65 74 75 72 tes {db} { retur
4cd0: 6e 20 5b 6c 69 73 74 20 22 73 74 61 74 65 22 20 n [list "state"
4ce0: 22 63 6f 6d 6d 69 74 22 5d 20 7d 0a 20 20 20 20 "commit"] }.
4cf0: 0a 20 20 20 20 23 20 43 61 6e 20 75 73 65 20 74 . # Can use t
4d00: 68 69 73 20 74 6f 20 63 6f 6e 74 72 6f 6c 20 63 his to control c
4d10: 6f 6d 6d 69 74 2f 6e 6f 63 6f 6d 6d 69 74 20 6f ommit/nocommit o
4d20: 72 20 77 68 61 74 65 76 65 72 2e 0a 20 20 20 20 r whatever..
4d30: 23 20 49 27 6d 20 6e 6f 74 20 73 75 72 65 20 79 # I'm not sure y
4d40: 65 74 20 6f 66 20 77 68 61 74 20 66 75 6e 63 74 et of what funct
4d50: 69 6f 6e 61 6c 69 74 79 20 6a 63 77 20 6e 65 65 ionality jcw nee
4d60: 64 73 2e 0a 20 20 20 20 70 72 6f 63 20 63 6f 6d ds.. proc com
4d70: 6d 69 74 20 7b 64 62 20 61 72 67 73 7d 20 7b 0a mit {db args} {.
4d80: 09 73 77 69 74 63 68 20 2d 2d 20 5b 6c 6c 65 6e .switch -- [llen
4d90: 67 74 68 20 24 61 72 67 73 5d 20 7b 0a 09 20 20 gth $args] {..
4da0: 20 20 30 20 7b 0a 09 09 69 66 20 7b 24 3a 3a 6d 0 {...if {$::m
4db0: 6b 63 6c 5f 76 66 73 3a 3a 76 3a 3a 6d 6f 64 65 kcl_vfs::v::mode
4dc0: 28 24 64 62 29 20 3d 3d 20 22 72 65 61 64 6f 6e ($db) == "readon
4dd0: 6c 79 22 7d 20 7b 0a 09 09 20 20 20 20 72 65 74 ly"} {... ret
4de0: 75 72 6e 20 30 0a 09 09 7d 20 65 6c 73 65 20 7b urn 0...} else {
4df0: 0a 09 09 20 20 20 20 23 20 54 6f 20 44 6f 3a 20 ... # To Do:
4e00: 72 65 61 64 20 74 68 65 20 63 6f 6d 6d 69 74 20 read the commit
4e10: 73 74 61 74 65 0a 09 09 20 20 20 20 72 65 74 75 state... retu
4e20: 72 6e 20 31 0a 09 09 7d 0a 09 20 20 20 20 7d 0a rn 1...}.. }.
4e30: 09 20 20 20 20 31 20 7b 0a 09 09 73 65 74 20 76 . 1 {...set v
4e40: 61 6c 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 73 al [lindex $args
4e50: 20 30 5d 0a 09 09 69 66 20 7b 24 76 61 6c 20 21 0]...if {$val !
4e60: 3d 20 30 20 26 26 20 24 76 61 6c 20 21 3d 20 31 = 0 && $val != 1
4e70: 7d 20 7b 0a 09 09 20 20 20 20 72 65 74 75 72 6e } {... return
4e80: 20 2d 63 6f 64 65 20 65 72 72 6f 72 20 5c 0a 09 -code error \..
4e90: 09 20 20 20 20 20 20 22 69 6e 76 61 6c 69 64 20 . "invalid
4ea0: 63 6f 6d 6d 69 74 20 76 61 6c 75 65 20 24 76 61 commit value $va
4eb0: 6c 2c 20 6d 75 73 74 20 62 65 20 30 2c 31 22 0a l, must be 0,1".
4ec0: 09 09 7d 0a 09 09 23 20 54 6f 20 44 6f 3a 20 73 ..}...# To Do: s
4ed0: 65 74 20 74 68 65 20 63 6f 6d 6d 69 74 20 73 74 et the commit st
4ee0: 61 74 65 2e 0a 09 20 20 20 20 7d 0a 09 20 20 20 ate... }..
4ef0: 20 64 65 66 61 75 6c 74 20 7b 0a 09 09 72 65 74 default {...ret
4f00: 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 6f 72 20 urn -code error
4f10: 22 57 72 6f 6e 67 20 6e 75 6d 20 61 72 67 73 22 "Wrong num args"
4f20: 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d .. }..}. }
4f30: 0a 20 20 20 20 0a 20 20 20 20 70 72 6f 63 20 73 . . proc s
4f40: 74 61 74 65 20 7b 64 62 20 61 72 67 73 7d 20 7b tate {db args} {
4f50: 0a 09 73 77 69 74 63 68 20 2d 2d 20 5b 6c 6c 65 ..switch -- [lle
4f60: 6e 67 74 68 20 24 61 72 67 73 5d 20 7b 0a 09 20 ngth $args] {..
4f70: 20 20 20 30 20 7b 0a 09 09 72 65 74 75 72 6e 20 0 {...return
4f80: 24 3a 3a 6d 6b 63 6c 5f 76 66 73 3a 3a 76 3a 3a $::mkcl_vfs::v::
4f90: 6d 6f 64 65 28 24 64 62 29 0a 09 20 20 20 20 7d mode($db).. }
4fa0: 0a 09 20 20 20 20 31 20 7b 0a 09 09 73 65 74 20 .. 1 {...set
4fb0: 76 61 6c 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 val [lindex $arg
4fc0: 73 20 30 5d 0a 09 09 69 66 20 7b 5b 6c 73 65 61 s 0]...if {[lsea
4fd0: 72 63 68 20 2d 65 78 61 63 74 20 5b 3a 3a 76 66 rch -exact [::vf
4fe0: 73 3a 3a 73 74 61 74 65 73 5d 20 24 76 61 6c 5d s::states] $val]
4ff0: 20 3d 3d 20 2d 31 7d 20 7b 0a 09 09 20 20 20 20 == -1} {...
5000: 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 return -code err
5010: 6f 72 20 5c 0a 09 09 20 20 20 20 20 20 22 69 6e or \... "in
5020: 76 61 6c 69 64 20 73 74 61 74 65 20 24 76 61 6c valid state $val
5030: 2c 20 6d 75 73 74 20 62 65 20 6f 6e 65 20 6f 66 , must be one of
5040: 3a 20 5b 76 66 73 3a 3a 73 74 61 74 65 73 5d 22 : [vfs::states]"
5050: 0a 09 09 7d 0a 09 09 73 65 74 20 3a 3a 6d 6b 63 ...}...set ::mkc
5060: 6c 5f 76 66 73 3a 3a 76 3a 3a 6d 6f 64 65 28 24 l_vfs::v::mode($
5070: 64 62 29 20 24 76 61 6c 0a 09 09 3a 3a 6d 6b 63 db) $val...::mkc
5080: 6c 5f 76 66 73 3a 3a 73 65 74 75 70 43 6f 6d 6d l_vfs::setupComm
5090: 69 74 73 20 24 64 62 0a 09 20 20 20 20 7d 0a 09 its $db.. }..
50a0: 20 20 20 20 64 65 66 61 75 6c 74 20 7b 0a 09 09 default {...
50b0: 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 return -code err
50c0: 6f 72 20 22 57 72 6f 6e 67 20 6e 75 6d 20 61 72 or "Wrong num ar
50d0: 67 73 22 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 gs".. }..}.
50e0: 20 20 7d 0a 20 20 20 20 0a 20 20 20 20 70 72 6f }. . pro
50f0: 63 20 68 61 6e 64 6c 65 72 20 7b 64 62 20 63 6d c handler {db cm
5100: 64 20 72 6f 6f 74 20 72 65 6c 61 74 69 76 65 20 d root relative
5110: 61 63 74 75 61 6c 70 61 74 68 20 61 72 67 73 7d actualpath args}
5120: 20 7b 0a 09 23 70 75 74 73 20 73 74 64 65 72 72 {..#puts stderr
5130: 20 22 68 61 6e 64 6c 65 72 3a 20 24 64 62 20 2d "handler: $db -
5140: 20 24 63 6d 64 20 2d 20 24 72 6f 6f 74 20 2d 20 $cmd - $root -
5150: 24 72 65 6c 61 74 69 76 65 20 2d 20 24 61 63 74 $relative - $act
5160: 75 61 6c 70 61 74 68 20 2d 20 24 61 72 67 73 22 ualpath - $args"
5170: 0a 09 69 66 20 7b 24 63 6d 64 20 3d 3d 20 22 6d ..if {$cmd == "m
5180: 61 74 63 68 69 6e 64 69 72 65 63 74 6f 72 79 22 atchindirectory"
5190: 7d 20 7b 0a 09 20 20 20 20 65 76 61 6c 20 5b 6c } {.. eval [l
51a0: 69 73 74 20 24 63 6d 64 20 24 64 62 20 24 72 65 ist $cmd $db $re
51b0: 6c 61 74 69 76 65 20 24 61 63 74 75 61 6c 70 61 lative $actualpa
51c0: 74 68 5d 20 24 61 72 67 73 0a 09 7d 20 65 6c 73 th] $args..} els
51d0: 65 69 66 20 7b 24 63 6d 64 20 3d 3d 20 22 66 69 eif {$cmd == "fi
51e0: 6c 65 61 74 74 72 69 62 75 74 65 73 22 7d 20 7b leattributes"} {
51f0: 0a 09 20 20 20 20 65 76 61 6c 20 5b 6c 69 73 74 .. eval [list
5200: 20 24 63 6d 64 20 24 64 62 20 24 72 6f 6f 74 20 $cmd $db $root
5210: 24 72 65 6c 61 74 69 76 65 5d 20 24 61 72 67 73 $relative] $args
5220: 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 ..} else {..
5230: 65 76 61 6c 20 5b 6c 69 73 74 20 24 63 6d 64 20 eval [list $cmd
5240: 24 64 62 20 24 72 65 6c 61 74 69 76 65 5d 20 24 $db $relative] $
5250: 61 72 67 73 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 args..}. }..
5260: 20 20 20 70 72 6f 63 20 75 74 69 6d 65 20 7b 64 proc utime {d
5270: 62 20 70 61 74 68 20 61 63 74 69 6d 65 20 6d 6f b path actime mo
5280: 64 74 69 6d 65 7d 20 7b 0a 09 3a 3a 6d 6b 63 6c dtime} {..::mkcl
5290: 5f 76 66 73 3a 3a 73 74 61 74 20 24 64 62 20 24 _vfs::stat $db $
52a0: 70 61 74 68 20 73 62 0a 09 0a 09 69 66 20 7b 20 path sb....if {
52b0: 24 73 62 28 74 79 70 65 29 20 3d 3d 20 22 66 69 $sb(type) == "fi
52c0: 6c 65 22 20 7d 20 7b 0a 09 20 20 20 20 72 65 61 le" } {.. rea
52d0: 64 6b 69 74 3a 3a 73 65 74 20 24 73 62 28 69 6e dkit::set $sb(in
52e0: 6f 29 20 64 61 74 65 20 24 6d 6f 64 74 69 6d 65 o) date $modtime
52f0: 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 ..}. }.. p
5300: 72 6f 63 20 6d 61 74 63 68 69 6e 64 69 72 65 63 roc matchindirec
5310: 74 6f 72 79 20 7b 64 62 20 70 61 74 68 20 61 63 tory {db path ac
5320: 74 75 61 6c 70 61 74 68 20 70 61 74 74 65 72 6e tualpath pattern
5330: 20 74 79 70 65 7d 20 7b 0a 09 73 65 74 20 6e 65 type} {..set ne
5340: 77 72 65 73 20 5b 6c 69 73 74 5d 0a 09 69 66 20 wres [list]..if
5350: 7b 21 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 {![string length
5360: 20 24 70 61 74 74 65 72 6e 5d 7d 20 7b 0a 09 20 $pattern]} {..
5370: 20 20 20 23 20 63 68 65 63 6b 20 73 69 6e 67 6c # check singl
5380: 65 20 66 69 6c 65 0a 09 20 20 20 20 69 66 20 7b e file.. if {
5390: 5b 63 61 74 63 68 20 7b 61 63 63 65 73 73 20 24 [catch {access $
53a0: 64 62 20 24 70 61 74 68 20 30 7d 5d 7d 20 7b 0a db $path 0}]} {.
53b0: 09 09 72 65 74 75 72 6e 20 7b 7d 0a 09 20 20 20 ..return {}..
53c0: 20 7d 0a 09 20 20 20 20 73 65 74 20 72 65 73 20 }.. set res
53d0: 5b 6c 69 73 74 20 24 61 63 74 75 61 6c 70 61 74 [list $actualpat
53e0: 68 5d 0a 09 20 20 20 20 73 65 74 20 61 63 74 75 h].. set actu
53f0: 61 6c 70 61 74 68 20 22 22 0a 09 7d 20 65 6c 73 alpath ""..} els
5400: 65 20 7b 0a 09 20 20 20 20 73 65 74 20 72 65 73 e {.. set res
5410: 20 5b 3a 3a 6d 6b 63 6c 5f 76 66 73 3a 3a 67 65 [::mkcl_vfs::ge
5420: 74 64 69 72 20 24 64 62 20 24 70 61 74 68 20 24 tdir $db $path $
5430: 70 61 74 74 65 72 6e 5d 0a 09 7d 0a 09 66 6f 72 pattern]..}..for
5440: 65 61 63 68 20 70 20 5b 3a 3a 76 66 73 3a 3a 6d each p [::vfs::m
5450: 61 74 63 68 43 6f 72 72 65 63 74 54 79 70 65 73 atchCorrectTypes
5460: 20 24 74 79 70 65 20 24 72 65 73 20 24 61 63 74 $type $res $act
5470: 75 61 6c 70 61 74 68 5d 20 7b 0a 09 20 20 20 20 ualpath] {..
5480: 6c 61 70 70 65 6e 64 20 6e 65 77 72 65 73 20 5b lappend newres [
5490: 66 69 6c 65 20 6a 6f 69 6e 20 24 61 63 74 75 61 file join $actua
54a0: 6c 70 61 74 68 20 24 70 5d 0a 09 7d 0a 09 72 65 lpath $p]..}..re
54b0: 74 75 72 6e 20 24 6e 65 77 72 65 73 0a 20 20 20 turn $newres.
54c0: 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 73 74 61 }.. proc sta
54d0: 74 20 7b 64 62 20 6e 61 6d 65 7d 20 7b 0a 09 3a t {db name} {..:
54e0: 3a 6d 6b 63 6c 5f 76 66 73 3a 3a 73 74 61 74 20 :mkcl_vfs::stat
54f0: 24 64 62 20 24 6e 61 6d 65 20 73 62 0a 0a 09 73 $db $name sb...s
5500: 65 74 20 73 62 28 69 6e 6f 29 20 30 0a 09 61 72 et sb(ino) 0..ar
5510: 72 61 79 20 67 65 74 20 73 62 0a 20 20 20 20 7d ray get sb. }
5520: 0a 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 73 .. proc acces
5530: 73 20 7b 64 62 20 6e 61 6d 65 20 6d 6f 64 65 7d s {db name mode}
5540: 20 7b 0a 09 69 66 20 7b 24 6d 6f 64 65 20 26 20 {..if {$mode &
5550: 32 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 24 3a 2} {.. if {$:
5560: 3a 6d 6b 63 6c 5f 76 66 73 3a 3a 76 3a 3a 6d 6f :mkcl_vfs::v::mo
5570: 64 65 28 24 64 62 29 20 3d 3d 20 22 72 65 61 64 de($db) == "read
5580: 6f 6e 6c 79 22 7d 20 7b 0a 09 09 76 66 73 3a 3a only"} {...vfs::
5590: 66 69 6c 65 73 79 73 74 65 6d 20 70 6f 73 69 78 filesystem posix
55a0: 65 72 72 6f 72 20 24 3a 3a 76 66 73 3a 3a 70 6f error $::vfs::po
55b0: 73 69 78 28 45 52 4f 46 53 29 0a 09 20 20 20 20 six(EROFS)..
55c0: 7d 0a 09 7d 0a 09 23 20 57 65 20 63 61 6e 20 70 }..}..# We can p
55d0: 72 6f 62 61 62 6c 79 20 64 6f 20 74 68 69 73 20 robably do this
55e0: 6d 6f 72 65 20 65 66 66 69 63 69 65 6e 74 6c 79 more efficiently
55f0: 2c 20 63 61 6e 27 74 20 77 65 3f 0a 09 3a 3a 6d , can't we?..::m
5600: 6b 63 6c 5f 76 66 73 3a 3a 73 74 61 74 20 24 64 kcl_vfs::stat $d
5610: 62 20 24 6e 61 6d 65 20 73 62 0a 20 20 20 20 7d b $name sb. }
5620: 0a 0a 20 20 20 20 70 72 6f 63 20 6f 70 65 6e 20 .. proc open
5630: 7b 64 62 20 66 69 6c 65 20 6d 6f 64 65 20 70 65 {db file mode pe
5640: 72 6d 69 73 73 69 6f 6e 73 7d 20 7b 0a 09 23 20 rmissions} {..#
5650: 72 65 74 75 72 6e 20 61 20 6c 69 73 74 20 6f 66 return a list of
5660: 20 74 77 6f 20 65 6c 65 6d 65 6e 74 73 3a 0a 09 two elements:..
5670: 23 20 31 2e 20 66 69 72 73 74 20 65 6c 65 6d 65 # 1. first eleme
5680: 6e 74 20 69 73 20 74 68 65 20 54 63 6c 20 63 68 nt is the Tcl ch
5690: 61 6e 6e 65 6c 20 6e 61 6d 65 20 77 68 69 63 68 annel name which
56a0: 20 68 61 73 20 62 65 65 6e 20 6f 70 65 6e 65 64 has been opened
56b0: 0a 09 23 20 32 2e 20 73 65 63 6f 6e 64 20 65 6c ..# 2. second el
56c0: 65 6d 65 6e 74 20 28 6f 70 74 69 6f 6e 61 6c 29 ement (optional)
56d0: 20 69 73 20 61 20 63 6f 6d 6d 61 6e 64 20 74 6f is a command to
56e0: 20 65 76 61 6c 75 61 74 65 20 77 68 65 6e 0a 09 evaluate when..
56f0: 23 20 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 69 # the channel i
5700: 73 20 63 6c 6f 73 65 64 2e 0a 09 73 77 69 74 63 s closed...switc
5710: 68 20 2d 67 6c 6f 62 20 2d 2d 20 24 6d 6f 64 65 h -glob -- $mode
5720: 20 7b 0a 09 20 20 20 20 7b 7d 20 20 2d 0a 09 20 {.. {} -..
5730: 20 20 20 72 20 7b 0a 09 09 3a 3a 6d 6b 63 6c 5f r {...::mkcl_
5740: 76 66 73 3a 3a 73 74 61 74 20 24 64 62 20 24 66 vfs::stat $db $f
5750: 69 6c 65 20 73 62 0a 0a 09 09 69 66 20 7b 20 24 ile sb....if { $
5760: 73 62 28 63 73 69 7a 65 29 20 21 3d 20 24 73 62 sb(csize) != $sb
5770: 28 73 69 7a 65 29 20 7d 20 7b 0a 09 09 20 20 20 (size) } {...
5780: 20 69 66 20 7b 24 3a 3a 6d 6b 63 6c 5f 76 66 73 if {$::mkcl_vfs
5790: 3a 3a 7a 73 74 72 65 61 6d 65 64 7d 20 7b 0a 09 ::zstreamed} {..
57a0: 09 20 20 20 20 20 20 73 65 74 20 66 64 20 5b 72 . set fd [r
57b0: 65 61 64 6b 69 74 3a 3a 63 68 61 6e 6e 65 6c 20 eadkit::channel
57c0: 24 73 62 28 69 6e 6f 29 20 63 6f 6e 74 65 6e 74 $sb(ino) content
57d0: 73 20 72 5d 0a 09 09 20 20 20 20 20 20 66 63 6f s r]... fco
57e0: 6e 66 69 67 75 72 65 20 24 66 64 20 2d 74 72 61 nfigure $fd -tra
57f0: 6e 73 6c 61 74 69 6f 6e 20 62 69 6e 61 72 79 0a nslation binary.
5800: 09 09 20 20 20 20 20 20 73 65 74 20 66 64 20 5b .. set fd [
5810: 76 66 73 3a 3a 7a 73 74 72 65 61 6d 20 64 65 63 vfs::zstream dec
5820: 6f 6d 70 72 65 73 73 20 24 66 64 20 24 73 62 28 ompress $fd $sb(
5830: 63 73 69 7a 65 29 20 24 73 62 28 73 69 7a 65 29 csize) $sb(size)
5840: 5d 0a 09 09 20 20 20 20 7d 20 65 6c 73 65 20 7b ]... } else {
5850: 0a 09 09 20 20 20 20 20 20 73 65 74 20 66 64 20 ... set fd
5860: 5b 76 66 73 3a 3a 6d 65 6d 63 68 61 6e 5d 0a 09 [vfs::memchan]..
5870: 09 20 20 20 20 20 20 66 63 6f 6e 66 69 67 75 72 . fconfigur
5880: 65 20 24 66 64 20 2d 74 72 61 6e 73 6c 61 74 69 e $fd -translati
5890: 6f 6e 20 62 69 6e 61 72 79 0a 09 09 20 20 20 20 on binary...
58a0: 20 20 73 65 74 20 73 20 5b 72 65 61 64 6b 69 74 set s [readkit
58b0: 3a 3a 67 65 74 20 24 73 62 28 69 6e 6f 29 20 63 ::get $sb(ino) c
58c0: 6f 6e 74 65 6e 74 73 5d 0a 09 09 20 20 20 20 20 ontents]...
58d0: 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 puts -nonewline
58e0: 20 24 66 64 20 5b 76 66 73 3a 3a 7a 69 70 20 2d $fd [vfs::zip -
58f0: 6d 6f 64 65 20 64 65 63 6f 6d 70 72 65 73 73 20 mode decompress
5900: 24 73 5d 0a 0a 09 09 20 20 20 20 20 20 66 63 6f $s].... fco
5910: 6e 66 69 67 75 72 65 20 24 66 64 20 2d 74 72 61 nfigure $fd -tra
5920: 6e 73 6c 61 74 69 6f 6e 20 61 75 74 6f 0a 09 09 nslation auto...
5930: 20 20 20 20 20 20 73 65 65 6b 20 24 66 64 20 30 seek $fd 0
5940: 0a 09 09 20 20 20 20 7d 0a 09 09 7d 20 65 6c 73 ... }...} els
5950: 65 69 66 20 7b 20 24 3a 3a 6d 6b 63 6c 5f 76 66 eif { $::mkcl_vf
5960: 73 3a 3a 64 69 72 65 63 74 20 7d 20 7b 0a 09 09 s::direct } {...
5970: 20 20 20 20 73 65 74 20 66 64 20 5b 76 66 73 3a set fd [vfs:
5980: 3a 6d 65 6d 63 68 61 6e 5d 0a 09 09 20 20 20 20 :memchan]...
5990: 66 63 6f 6e 66 69 67 75 72 65 20 24 66 64 20 2d fconfigure $fd -
59a0: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 62 69 6e 61 translation bina
59b0: 72 79 0a 09 09 20 20 20 20 70 75 74 73 20 2d 6e ry... puts -n
59c0: 6f 6e 65 77 6c 69 6e 65 20 24 66 64 20 5b 72 65 onewline $fd [re
59d0: 61 64 6b 69 74 3a 3a 67 65 74 20 24 73 62 28 69 adkit::get $sb(i
59e0: 6e 6f 29 20 63 6f 6e 74 65 6e 74 73 5d 0a 0a 09 no) contents]...
59f0: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
5a00: 24 66 64 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e $fd -translation
5a10: 20 61 75 74 6f 0a 09 09 20 20 20 20 73 65 65 6b auto... seek
5a20: 20 24 66 64 20 30 0a 09 09 7d 20 65 6c 73 65 20 $fd 0...} else
5a30: 7b 0a 09 09 20 20 20 20 73 65 74 20 66 64 20 5b {... set fd [
5a40: 72 65 61 64 6b 69 74 3a 3a 63 68 61 6e 6e 65 6c readkit::channel
5a50: 20 24 73 62 28 69 6e 6f 29 20 63 6f 6e 74 65 6e $sb(ino) conten
5a60: 74 73 20 72 5d 0a 09 09 7d 0a 09 09 72 65 74 75 ts r]...}...retu
5a70: 72 6e 20 5b 6c 69 73 74 20 24 66 64 5d 0a 09 20 rn [list $fd]..
5a80: 20 20 20 7d 0a 09 20 20 20 20 61 20 7b 0a 09 09 }.. a {...
5a90: 69 66 20 7b 24 3a 3a 6d 6b 63 6c 5f 76 66 73 3a if {$::mkcl_vfs:
5aa0: 3a 76 3a 3a 6d 6f 64 65 28 24 64 62 29 20 3d 3d :v::mode($db) ==
5ab0: 20 22 72 65 61 64 6f 6e 6c 79 22 7d 20 7b 0a 09 "readonly"} {..
5ac0: 09 20 20 20 20 76 66 73 3a 3a 66 69 6c 65 73 79 . vfs::filesy
5ad0: 73 74 65 6d 20 70 6f 73 69 78 65 72 72 6f 72 20 stem posixerror
5ae0: 24 3a 3a 76 66 73 3a 3a 70 6f 73 69 78 28 45 52 $::vfs::posix(ER
5af0: 4f 46 53 29 0a 09 09 7d 0a 09 09 69 66 20 7b 20 OFS)...}...if {
5b00: 5b 63 61 74 63 68 20 7b 3a 3a 6d 6b 63 6c 5f 76 [catch {::mkcl_v
5b10: 66 73 3a 3a 73 74 61 74 20 24 64 62 20 24 66 69 fs::stat $db $fi
5b20: 6c 65 20 73 62 20 7d 5d 20 7d 20 7b 0a 09 09 20 le sb }] } {...
5b30: 20 20 20 23 20 43 72 65 61 74 65 20 66 69 6c 65 # Create file
5b40: 0a 09 09 20 20 20 20 3a 3a 6d 6b 63 6c 5f 76 66 ... ::mkcl_vf
5b50: 73 3a 3a 73 74 61 74 20 24 64 62 20 5b 66 69 6c s::stat $db [fil
5b60: 65 20 64 69 72 6e 61 6d 65 20 24 66 69 6c 65 5d e dirname $file]
5b70: 20 73 62 0a 09 09 20 20 20 20 73 65 74 20 74 61 sb... set ta
5b80: 69 6c 20 5b 66 69 6c 65 20 74 61 69 6c 20 24 66 il [file tail $f
5b90: 69 6c 65 5d 0a 09 09 20 20 20 20 73 65 74 20 66 ile]... set f
5ba0: 76 69 65 77 20 24 73 62 28 69 6e 6f 29 2e 66 69 view $sb(ino).fi
5bb0: 6c 65 73 0a 09 09 20 20 20 20 69 66 20 7b 5b 69 les... if {[i
5bc0: 6e 66 6f 20 65 78 69 73 74 73 20 6d 6b 63 6c 5f nfo exists mkcl_
5bd0: 76 66 73 3a 3a 76 3a 3a 66 63 61 63 68 65 28 24 vfs::v::fcache($
5be0: 66 76 69 65 77 29 5d 7d 20 7b 0a 09 09 09 6c 61 fview)]} {....la
5bf0: 70 70 65 6e 64 20 6d 6b 63 6c 5f 76 66 73 3a 3a ppend mkcl_vfs::
5c00: 76 3a 3a 66 63 61 63 68 65 28 24 66 76 69 65 77 v::fcache($fview
5c10: 29 20 24 74 61 69 6c 0a 09 09 20 20 20 20 7d 0a ) $tail... }.
5c20: 09 09 20 20 20 20 73 65 74 20 6e 6f 77 20 5b 63 .. set now [c
5c30: 6c 6f 63 6b 20 73 65 63 6f 6e 64 73 5d 0a 09 09 lock seconds]...
5c40: 20 20 20 20 73 65 74 20 73 62 28 69 6e 6f 29 20 set sb(ino)
5c50: 5b 72 65 61 64 6b 69 74 3a 3a 72 6f 77 20 61 70 [readkit::row ap
5c60: 70 65 6e 64 20 24 66 76 69 65 77 20 5c 0a 09 09 pend $fview \...
5c70: 09 20 20 20 20 6e 61 6d 65 20 24 74 61 69 6c 20 . name $tail
5c80: 73 69 7a 65 20 30 20 64 61 74 65 20 24 6e 6f 77 size 0 date $now
5c90: 20 5d 0a 0a 09 09 20 20 20 20 69 66 20 7b 20 5b ].... if { [
5ca0: 73 74 72 69 6e 67 20 6d 61 74 63 68 20 2a 7a 2a string match *z*
5cb0: 20 24 6d 6f 64 65 5d 20 7c 7c 20 24 6d 6b 63 6c $mode] || $mkcl
5cc0: 5f 76 66 73 3a 3a 63 6f 6d 70 72 65 73 73 20 7d _vfs::compress }
5cd0: 20 7b 0a 09 09 09 73 65 74 20 73 62 28 63 73 69 {....set sb(csi
5ce0: 7a 65 29 20 2d 31 20 20 3b 23 20 48 41 43 4b 20 ze) -1 ;# HACK
5cf0: 2d 20 66 6f 72 63 65 20 63 6f 6d 70 72 65 73 73 - force compress
5d00: 69 6f 6e 0a 09 09 20 20 20 20 7d 20 65 6c 73 65 ion... } else
5d10: 20 7b 0a 09 09 09 73 65 74 20 73 62 28 63 73 69 {....set sb(csi
5d20: 7a 65 29 20 30 0a 09 09 20 20 20 20 7d 0a 09 09 ze) 0... }...
5d30: 7d 0a 0a 09 09 73 65 74 20 66 64 20 5b 76 66 73 }....set fd [vfs
5d40: 3a 3a 6d 65 6d 63 68 61 6e 5d 0a 09 09 66 63 6f ::memchan]...fco
5d50: 6e 66 69 67 75 72 65 20 24 66 64 20 2d 74 72 61 nfigure $fd -tra
5d60: 6e 73 6c 61 74 69 6f 6e 20 62 69 6e 61 72 79 0a nslation binary.
5d70: 09 09 73 65 74 20 73 20 5b 72 65 61 64 6b 69 74 ..set s [readkit
5d80: 3a 3a 67 65 74 20 24 73 62 28 69 6e 6f 29 20 63 ::get $sb(ino) c
5d90: 6f 6e 74 65 6e 74 73 5d 0a 0a 09 09 69 66 20 7b ontents]....if {
5da0: 20 24 73 62 28 63 73 69 7a 65 29 20 21 3d 20 24 $sb(csize) != $
5db0: 73 62 28 73 69 7a 65 29 20 26 26 20 24 73 62 28 sb(size) && $sb(
5dc0: 63 73 69 7a 65 29 20 3e 20 30 20 7d 20 7b 0a 09 csize) > 0 } {..
5dd0: 09 20 20 20 20 61 70 70 65 6e 64 20 6d 6f 64 65 . append mode
5de0: 20 7a 0a 09 09 20 20 20 20 70 75 74 73 20 2d 6e z... puts -n
5df0: 6f 6e 65 77 6c 69 6e 65 20 24 66 64 20 5b 76 66 onewline $fd [vf
5e00: 73 3a 3a 7a 69 70 20 2d 6d 6f 64 65 20 64 65 63 s::zip -mode dec
5e10: 6f 6d 70 72 65 73 73 20 24 73 5d 0a 09 09 7d 20 ompress $s]...}
5e20: 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 69 66 20 else {... if
5e30: 7b 20 24 6d 6b 63 6c 5f 76 66 73 3a 3a 63 6f 6d { $mkcl_vfs::com
5e40: 70 72 65 73 73 20 7d 20 7b 20 61 70 70 65 6e 64 press } { append
5e50: 20 6d 6f 64 65 20 7a 20 7d 0a 09 09 20 20 20 20 mode z }...
5e60: 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 puts -nonewline
5e70: 24 66 64 20 24 73 0a 09 09 20 20 20 20 23 73 65 $fd $s... #se
5e80: 74 20 66 64 20 5b 72 65 61 64 6b 69 74 3a 3a 63 t fd [readkit::c
5e90: 68 61 6e 6e 65 6c 20 24 73 62 28 69 6e 6f 29 20 hannel $sb(ino)
5ea0: 63 6f 6e 74 65 6e 74 73 20 61 5d 0a 09 09 7d 0a contents a]...}.
5eb0: 09 09 66 63 6f 6e 66 69 67 75 72 65 20 24 66 64 ..fconfigure $fd
5ec0: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 61 75 -translation au
5ed0: 74 6f 0a 09 09 73 65 65 6b 20 24 66 64 20 30 20 to...seek $fd 0
5ee0: 65 6e 64 0a 09 09 72 65 74 75 72 6e 20 5b 6c 69 end...return [li
5ef0: 73 74 20 24 66 64 20 5b 6c 69 73 74 20 6d 6b 63 st $fd [list mkc
5f00: 6c 5f 76 66 73 3a 3a 64 6f 5f 63 6c 6f 73 65 20 l_vfs::do_close
5f10: 24 64 62 20 24 66 64 20 24 6d 6f 64 65 20 24 73 $db $fd $mode $s
5f20: 62 28 69 6e 6f 29 5d 5d 0a 09 20 20 20 20 7d 0a b(ino)]].. }.
5f30: 09 20 20 20 20 77 2a 20 20 7b 0a 09 09 69 66 20 . w* {...if
5f40: 7b 24 3a 3a 6d 6b 63 6c 5f 76 66 73 3a 3a 76 3a {$::mkcl_vfs::v:
5f50: 3a 6d 6f 64 65 28 24 64 62 29 20 3d 3d 20 22 72 :mode($db) == "r
5f60: 65 61 64 6f 6e 6c 79 22 7d 20 7b 0a 09 09 20 20 eadonly"} {...
5f70: 20 20 76 66 73 3a 3a 66 69 6c 65 73 79 73 74 65 vfs::filesyste
5f80: 6d 20 70 6f 73 69 78 65 72 72 6f 72 20 24 3a 3a m posixerror $::
5f90: 76 66 73 3a 3a 70 6f 73 69 78 28 45 52 4f 46 53 vfs::posix(EROFS
5fa0: 29 0a 09 09 7d 0a 09 09 69 66 20 7b 20 5b 63 61 )...}...if { [ca
5fb0: 74 63 68 20 7b 3a 3a 6d 6b 63 6c 5f 76 66 73 3a tch {::mkcl_vfs:
5fc0: 3a 73 74 61 74 20 24 64 62 20 24 66 69 6c 65 20 :stat $db $file
5fd0: 73 62 20 7d 5d 20 7d 20 7b 0a 09 09 20 20 20 20 sb }] } {...
5fe0: 23 20 43 72 65 61 74 65 20 66 69 6c 65 0a 09 09 # Create file...
5ff0: 20 20 20 20 3a 3a 6d 6b 63 6c 5f 76 66 73 3a 3a ::mkcl_vfs::
6000: 73 74 61 74 20 24 64 62 20 5b 66 69 6c 65 20 64 stat $db [file d
6010: 69 72 6e 61 6d 65 20 24 66 69 6c 65 5d 20 73 62 irname $file] sb
6020: 0a 09 09 20 20 20 20 73 65 74 20 74 61 69 6c 20 ... set tail
6030: 5b 66 69 6c 65 20 74 61 69 6c 20 24 66 69 6c 65 [file tail $file
6040: 5d 0a 09 09 20 20 20 20 73 65 74 20 66 76 69 65 ]... set fvie
6050: 77 20 24 73 62 28 69 6e 6f 29 2e 66 69 6c 65 73 w $sb(ino).files
6060: 0a 09 09 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f ... if {[info
6070: 20 65 78 69 73 74 73 20 6d 6b 63 6c 5f 76 66 73 exists mkcl_vfs
6080: 3a 3a 76 3a 3a 66 63 61 63 68 65 28 24 66 76 69 ::v::fcache($fvi
6090: 65 77 29 5d 7d 20 7b 0a 09 09 09 6c 61 70 70 65 ew)]} {....lappe
60a0: 6e 64 20 6d 6b 63 6c 5f 76 66 73 3a 3a 76 3a 3a nd mkcl_vfs::v::
60b0: 66 63 61 63 68 65 28 24 66 76 69 65 77 29 20 24 fcache($fview) $
60c0: 74 61 69 6c 0a 09 09 20 20 20 20 7d 0a 09 09 20 tail... }...
60d0: 20 20 20 73 65 74 20 6e 6f 77 20 5b 63 6c 6f 63 set now [cloc
60e0: 6b 20 73 65 63 6f 6e 64 73 5d 0a 09 09 20 20 20 k seconds]...
60f0: 20 73 65 74 20 73 62 28 69 6e 6f 29 20 5b 72 65 set sb(ino) [re
6100: 61 64 6b 69 74 3a 3a 72 6f 77 20 61 70 70 65 6e adkit::row appen
6110: 64 20 24 66 76 69 65 77 20 5c 0a 09 09 09 20 20 d $fview \....
6120: 20 20 6e 61 6d 65 20 24 74 61 69 6c 20 73 69 7a name $tail siz
6130: 65 20 30 20 64 61 74 65 20 24 6e 6f 77 20 5d 0a e 0 date $now ].
6140: 09 09 7d 0a 0a 09 09 69 66 20 7b 20 5b 73 74 72 ..}....if { [str
6150: 69 6e 67 20 6d 61 74 63 68 20 2a 7a 2a 20 24 6d ing match *z* $m
6160: 6f 64 65 5d 20 7c 7c 20 24 6d 6b 63 6c 5f 76 66 ode] || $mkcl_vf
6170: 73 3a 3a 63 6f 6d 70 72 65 73 73 20 7d 20 7b 0a s::compress } {.
6180: 09 09 20 20 20 20 61 70 70 65 6e 64 20 6d 6f 64 .. append mod
6190: 65 20 7a 0a 09 09 20 20 20 20 73 65 74 20 66 64 e z... set fd
61a0: 20 5b 76 66 73 3a 3a 6d 65 6d 63 68 61 6e 5d 0a [vfs::memchan].
61b0: 09 09 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 ..} else {...
61c0: 20 73 65 74 20 66 64 20 5b 72 65 61 64 6b 69 74 set fd [readkit
61d0: 3a 3a 63 68 61 6e 6e 65 6c 20 24 73 62 28 69 6e ::channel $sb(in
61e0: 6f 29 20 63 6f 6e 74 65 6e 74 73 20 77 5d 0a 09 o) contents w]..
61f0: 09 7d 0a 09 09 72 65 74 75 72 6e 20 5b 6c 69 73 .}...return [lis
6200: 74 20 24 66 64 20 5b 6c 69 73 74 20 6d 6b 63 6c t $fd [list mkcl
6210: 5f 76 66 73 3a 3a 64 6f 5f 63 6c 6f 73 65 20 24 _vfs::do_close $
6220: 64 62 20 24 66 64 20 24 6d 6f 64 65 20 24 73 62 db $fd $mode $sb
6230: 28 69 6e 6f 29 5d 5d 0a 09 20 20 20 20 7d 0a 09 (ino)]].. }..
6240: 20 20 20 20 64 65 66 61 75 6c 74 20 20 20 7b 0a default {.
6250: 09 09 65 72 72 6f 72 20 22 69 6c 6c 65 67 61 6c ..error "illegal
6260: 20 61 63 63 65 73 73 20 6d 6f 64 65 20 5c 22 24 access mode \"$
6270: 6d 6f 64 65 5c 22 22 0a 09 20 20 20 20 7d 0a 09 mode\"".. }..
6280: 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f }. }.. pro
6290: 63 20 63 72 65 61 74 65 64 69 72 65 63 74 6f 72 c createdirector
62a0: 79 20 7b 64 62 20 6e 61 6d 65 7d 20 7b 0a 09 6d y {db name} {..m
62b0: 6b 63 6c 5f 76 66 73 3a 3a 6d 6b 64 69 72 20 24 kcl_vfs::mkdir $
62c0: 64 62 20 24 6e 61 6d 65 0a 20 20 20 20 7d 0a 0a db $name. }..
62d0: 20 20 20 20 70 72 6f 63 20 72 65 6d 6f 76 65 64 proc removed
62e0: 69 72 65 63 74 6f 72 79 20 7b 64 62 20 6e 61 6d irectory {db nam
62f0: 65 20 72 65 63 75 72 73 69 76 65 7d 20 7b 0a 09 e recursive} {..
6300: 6d 6b 63 6c 5f 76 66 73 3a 3a 64 65 6c 65 74 65 mkcl_vfs::delete
6310: 20 24 64 62 20 24 6e 61 6d 65 20 24 72 65 63 75 $db $name $recu
6320: 72 73 69 76 65 0a 20 20 20 20 7d 0a 0a 20 20 20 rsive. }..
6330: 20 70 72 6f 63 20 64 65 6c 65 74 65 66 69 6c 65 proc deletefile
6340: 20 7b 64 62 20 6e 61 6d 65 7d 20 7b 0a 09 6d 6b {db name} {..mk
6350: 63 6c 5f 76 66 73 3a 3a 64 65 6c 65 74 65 20 24 cl_vfs::delete $
6360: 64 62 20 24 6e 61 6d 65 0a 20 20 20 20 7d 0a 0a db $name. }..
6370: 20 20 20 20 70 72 6f 63 20 66 69 6c 65 61 74 74 proc fileatt
6380: 72 69 62 75 74 65 73 20 7b 64 62 20 72 6f 6f 74 ributes {db root
6390: 20 72 65 6c 61 74 69 76 65 20 61 72 67 73 7d 20 relative args}
63a0: 7b 0a 09 73 77 69 74 63 68 20 2d 2d 20 5b 6c 6c {..switch -- [ll
63b0: 65 6e 67 74 68 20 24 61 72 67 73 5d 20 7b 0a 09 ength $args] {..
63c0: 20 20 20 20 30 20 7b 0a 09 09 23 20 6c 69 73 74 0 {...# list
63d0: 20 73 74 72 69 6e 67 73 0a 09 09 72 65 74 75 72 strings...retur
63e0: 6e 20 5b 3a 3a 76 66 73 3a 3a 6c 69 73 74 41 74 n [::vfs::listAt
63f0: 74 72 69 62 75 74 65 73 5d 0a 09 20 20 20 20 7d tributes].. }
6400: 0a 09 20 20 20 20 31 20 7b 0a 09 09 23 20 67 65 .. 1 {...# ge
6410: 74 20 76 61 6c 75 65 0a 09 09 73 65 74 20 69 6e t value...set in
6420: 64 65 78 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 dex [lindex $arg
6430: 73 20 30 5d 0a 09 09 72 65 74 75 72 6e 20 5b 3a s 0]...return [:
6440: 3a 76 66 73 3a 3a 61 74 74 72 69 62 75 74 65 73 :vfs::attributes
6450: 47 65 74 20 24 72 6f 6f 74 20 24 72 65 6c 61 74 Get $root $relat
6460: 69 76 65 20 24 69 6e 64 65 78 5d 0a 0a 09 20 20 ive $index]...
6470: 20 20 7d 0a 09 20 20 20 20 32 20 7b 0a 09 09 23 }.. 2 {...#
6480: 20 73 65 74 20 76 61 6c 75 65 0a 09 09 69 66 20 set value...if
6490: 7b 24 3a 3a 6d 6b 63 6c 5f 76 66 73 3a 3a 76 3a {$::mkcl_vfs::v:
64a0: 3a 6d 6f 64 65 28 24 64 62 29 20 3d 3d 20 22 72 :mode($db) == "r
64b0: 65 61 64 6f 6e 6c 79 22 7d 20 7b 0a 09 09 20 20 eadonly"} {...
64c0: 20 20 76 66 73 3a 3a 66 69 6c 65 73 79 73 74 65 vfs::filesyste
64d0: 6d 20 70 6f 73 69 78 65 72 72 6f 72 20 24 3a 3a m posixerror $::
64e0: 76 66 73 3a 3a 70 6f 73 69 78 28 45 52 4f 46 53 vfs::posix(EROFS
64f0: 29 0a 09 09 7d 0a 09 09 73 65 74 20 69 6e 64 65 )...}...set inde
6500: 78 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 73 20 x [lindex $args
6510: 30 5d 0a 09 09 73 65 74 20 76 61 6c 20 5b 6c 69 0]...set val [li
6520: 6e 64 65 78 20 24 61 72 67 73 20 31 5d 0a 09 09 ndex $args 1]...
6530: 72 65 74 75 72 6e 20 5b 3a 3a 76 66 73 3a 3a 61 return [::vfs::a
6540: 74 74 72 69 62 75 74 65 73 53 65 74 20 24 72 6f ttributesSet $ro
6550: 6f 74 20 24 72 65 6c 61 74 69 76 65 20 24 69 6e ot $relative $in
6560: 64 65 78 20 24 76 61 6c 5d 0a 09 20 20 20 20 7d dex $val].. }
6570: 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 6e 61 6d ..}. }.}..nam
6580: 65 73 70 61 63 65 20 65 76 61 6c 20 6d 6b 63 6c espace eval mkcl
6590: 5f 76 66 73 20 7b 0a 20 20 20 20 76 61 72 69 61 _vfs {. varia
65a0: 62 6c 65 20 63 6f 6d 70 72 65 73 73 20 31 20 20 ble compress 1
65b0: 20 20 20 3b 23 20 48 41 43 4b 20 2d 20 6e 65 65 ;# HACK - nee
65c0: 64 73 20 74 6f 20 62 65 20 70 61 72 74 20 6f 66 ds to be part of
65d0: 20 22 53 75 70 65 72 2d 42 6c 6f 63 6b 22 0a 20 "Super-Block".
65e0: 20 20 20 76 61 72 69 61 62 6c 65 20 66 6c 75 73 variable flus
65f0: 68 20 20 20 20 35 30 30 30 20 20 3b 23 20 41 75 h 5000 ;# Au
6600: 74 6f 2d 43 6f 6d 6d 69 74 20 66 72 65 71 75 65 to-Commit freque
6610: 6e 63 79 0a 20 20 20 20 76 61 72 69 61 62 6c 65 ncy. variable
6620: 20 64 69 72 65 63 74 20 20 20 30 09 20 20 20 20 direct 0.
6630: 3b 23 20 72 65 61 64 20 74 68 72 6f 75 67 68 20 ;# read through
6640: 61 20 6d 65 6d 63 68 61 6e 2c 20 6f 72 20 66 72 a memchan, or fr
6650: 6f 6d 20 4d 6b 34 74 63 6c 20 69 66 20 7a 65 72 om Mk4tcl if zer
6660: 6f 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 7a o. variable z
6670: 73 74 72 65 61 6d 65 64 20 30 20 20 20 20 3b 23 streamed 0 ;#
6680: 20 64 65 63 6f 6d 70 72 65 73 73 20 6f 6e 20 74 decompress on t
6690: 68 65 20 66 6c 79 20 28 6e 65 65 64 73 20 7a 6c he fly (needs zl
66a0: 69 62 20 31 2e 31 29 0a 0a 20 20 20 20 6e 61 6d ib 1.1).. nam
66b0: 65 73 70 61 63 65 20 65 76 61 6c 20 76 20 7b 0a espace eval v {.
66c0: 09 76 61 72 69 61 62 6c 65 20 73 65 71 20 20 20 .variable seq
66d0: 20 20 20 30 0a 09 76 61 72 69 61 62 6c 65 20 6d 0..variable m
66e0: 6f 64 65 09 20 20 20 20 3b 23 20 61 72 72 61 79 ode. ;# array
66f0: 20 6b 65 79 20 69 73 20 64 62 2c 20 76 61 6c 75 key is db, valu
6700: 65 20 69 73 20 6d 6f 64 65 20 0a 09 20 20 20 20 e is mode ..
6710: 20 20 20 20 20 20 20 20 20 09 20 20 20 20 20 23 . #
6720: 20 28 72 65 61 64 77 72 69 74 65 2f 74 72 61 6e (readwrite/tran
6730: 73 6c 75 63 65 6e 74 2f 72 65 61 64 6f 6e 6c 79 slucent/readonly
6740: 29 0a 09 76 61 72 69 61 62 6c 65 20 74 69 6d 65 )..variable time
6750: 72 09 20 20 20 20 3b 23 20 61 72 72 61 79 20 6b r. ;# array k
6760: 65 79 20 69 73 20 64 62 2c 20 73 65 74 20 74 6f ey is db, set to
6770: 20 61 66 74 65 72 69 64 2c 20 70 65 72 69 6f 64 afterid, period
6780: 69 63 43 6f 6d 6d 69 74 0a 0a 09 61 72 72 61 79 icCommit...array
6790: 20 73 65 74 20 63 61 63 68 65 20 7b 7d 0a 09 61 set cache {}..a
67a0: 72 72 61 79 20 73 65 74 20 66 63 61 63 68 65 20 rray set fcache
67b0: 7b 7d 0a 0a 09 61 72 72 61 79 20 73 65 74 20 6d {}...array set m
67c0: 6f 64 65 20 7b 65 78 65 20 74 72 61 6e 73 6c 75 ode {exe translu
67d0: 63 65 6e 74 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 cent}. }..
67e0: 20 70 72 6f 63 20 69 6e 69 74 20 7b 64 62 7d 20 proc init {db}
67f0: 7b 0a 09 72 65 61 64 6b 69 74 3a 3a 76 69 65 77 {..readkit::view
6800: 20 6c 61 79 6f 75 74 20 24 64 62 2e 64 69 72 73 layout $db.dirs
6810: 20 5c 0a 09 09 7b 6e 61 6d 65 3a 53 20 70 61 72 \...{name:S par
6820: 65 6e 74 3a 49 20 7b 66 69 6c 65 73 20 7b 6e 61 ent:I {files {na
6830: 6d 65 3a 53 20 73 69 7a 65 3a 49 20 64 61 74 65 me:S size:I date
6840: 3a 49 20 63 6f 6e 74 65 6e 74 73 3a 4d 7d 7d 7d :I contents:M}}}
6850: 0a 0a 09 69 66 20 7b 20 5b 72 65 61 64 6b 69 74 ...if { [readkit
6860: 3a 3a 76 69 65 77 20 73 69 7a 65 20 24 64 62 2e ::view size $db.
6870: 64 69 72 73 5d 20 3d 3d 20 30 20 7d 20 7b 0a 09 dirs] == 0 } {..
6880: 20 20 20 20 72 65 61 64 6b 69 74 3a 3a 72 6f 77 readkit::row
6890: 20 61 70 70 65 6e 64 20 24 64 62 2e 64 69 72 73 append $db.dirs
68a0: 20 6e 61 6d 65 20 3c 72 6f 6f 74 3e 20 70 61 72 name <root> par
68b0: 65 6e 74 20 2d 31 0a 09 7d 0a 20 20 20 20 7d 0a ent -1..}. }.
68c0: 0a 20 20 20 20 70 72 6f 63 20 5f 6d 6f 75 6e 74 . proc _mount
68d0: 20 7b 7b 66 69 6c 65 20 22 22 7d 20 61 72 67 73 {{file ""} args
68e0: 7d 20 7b 0a 09 73 65 74 20 64 62 20 6d 6b 34 76 } {..set db mk4v
68f0: 66 73 5b 69 6e 63 72 20 76 3a 3a 73 65 71 5d 0a fs[incr v::seq].
6900: 0a 09 69 66 20 7b 24 66 69 6c 65 20 3d 3d 20 22 ..if {$file == "
6910: 22 7d 20 7b 0a 09 20 20 20 20 72 65 61 64 6b 69 "} {.. readki
6920: 74 3a 3a 66 69 6c 65 20 6f 70 65 6e 20 24 64 62 t::file open $db
6930: 0a 09 20 20 20 20 69 6e 69 74 20 24 64 62 0a 09 .. init $db..
6940: 20 20 20 20 73 65 74 20 76 3a 3a 6d 6f 64 65 28 set v::mode(
6950: 24 64 62 29 20 22 74 72 61 6e 73 6c 75 63 65 6e $db) "translucen
6960: 74 22 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 t"..} else {..
6970: 20 20 65 76 61 6c 20 5b 6c 69 73 74 20 72 65 61 eval [list rea
6980: 64 6b 69 74 3a 3a 66 69 6c 65 20 6f 70 65 6e 20 dkit::file open
6990: 24 64 62 20 24 66 69 6c 65 5d 20 24 61 72 67 73 $db $file] $args
69a0: 0a 09 20 20 20 20 0a 09 20 20 20 20 69 6e 69 74 .. .. init
69b0: 20 24 64 62 0a 09 20 20 20 20 0a 09 20 20 20 20 $db.. ..
69c0: 73 65 74 20 6d 6f 64 65 20 30 0a 09 20 20 20 20 set mode 0..
69d0: 66 6f 72 65 61 63 68 20 61 72 67 20 24 61 72 67 foreach arg $arg
69e0: 73 20 7b 0a 09 09 73 77 69 74 63 68 20 2d 2d 20 s {...switch --
69f0: 24 61 72 67 20 7b 0a 09 09 20 20 20 20 2d 72 65 $arg {... -re
6a00: 61 64 6f 6e 6c 79 20 20 20 7b 20 73 65 74 20 6d adonly { set m
6a10: 6f 64 65 20 31 20 7d 0a 09 09 20 20 20 20 2d 6e ode 1 }... -n
6a20: 6f 63 6f 6d 6d 69 74 20 20 20 7b 20 73 65 74 20 ocommit { set
6a30: 6d 6f 64 65 20 32 20 7d 0a 09 09 7d 0a 09 20 20 mode 2 }...}..
6a40: 20 20 7d 0a 09 20 20 20 20 69 66 20 7b 24 6d 6f }.. if {$mo
6a50: 64 65 20 3d 3d 20 30 7d 20 7b 0a 09 09 70 65 72 de == 0} {...per
6a60: 69 6f 64 69 63 43 6f 6d 6d 69 74 20 24 64 62 0a iodicCommit $db.
6a70: 09 20 20 20 20 7d 0a 09 20 20 20 20 73 65 74 20 . }.. set
6a80: 76 3a 3a 6d 6f 64 65 28 24 64 62 29 20 5b 6c 69 v::mode($db) [li
6a90: 6e 64 65 78 20 7b 74 72 61 6e 73 6c 75 63 65 6e ndex {translucen
6aa0: 74 20 72 65 61 64 77 72 69 74 65 20 72 65 61 64 t readwrite read
6ab0: 77 72 69 74 65 7d 20 24 6d 6f 64 65 5d 0a 09 7d write} $mode]..}
6ac0: 0a 09 72 65 74 75 72 6e 20 24 64 62 0a 20 20 20 ..return $db.
6ad0: 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 70 65 72 }.. proc per
6ae0: 69 6f 64 69 63 43 6f 6d 6d 69 74 20 7b 64 62 7d iodicCommit {db}
6af0: 20 7b 0a 09 76 61 72 69 61 62 6c 65 20 66 6c 75 {..variable flu
6b00: 73 68 0a 09 73 65 74 20 76 3a 3a 74 69 6d 65 72 sh..set v::timer
6b10: 28 24 64 62 29 20 5b 61 66 74 65 72 20 24 66 6c ($db) [after $fl
6b20: 75 73 68 20 5b 6c 69 73 74 20 3a 3a 6d 6b 63 6c ush [list ::mkcl
6b30: 5f 76 66 73 3a 3a 70 65 72 69 6f 64 69 63 43 6f _vfs::periodicCo
6b40: 6d 6d 69 74 20 24 64 62 5d 5d 0a 09 72 65 61 64 mmit $db]]..read
6b50: 6b 69 74 3a 3a 66 69 6c 65 20 63 6f 6d 6d 69 74 kit::file commit
6b60: 20 24 64 62 0a 09 72 65 74 75 72 6e 20 3b 23 20 $db..return ;#
6b70: 32 30 30 35 2d 30 31 2d 32 30 20 61 76 6f 69 64 2005-01-20 avoid
6b80: 20 72 65 74 75 72 6e 69 6e 67 20 61 20 76 61 6c returning a val
6b90: 75 65 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 ue. }.. pr
6ba0: 6f 63 20 5f 75 6d 6f 75 6e 74 20 7b 64 62 20 61 oc _umount {db a
6bb0: 72 67 73 7d 20 7b 0a 09 63 61 74 63 68 20 7b 61 rgs} {..catch {a
6bc0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 76 3a 3a fter cancel $v::
6bd0: 74 69 6d 65 72 28 24 64 62 29 7d 0a 09 61 72 72 timer($db)}..arr
6be0: 61 79 20 75 6e 73 65 74 20 76 3a 3a 6d 6f 64 65 ay unset v::mode
6bf0: 20 24 64 62 0a 09 61 72 72 61 79 20 75 6e 73 65 $db..array unse
6c00: 74 20 76 3a 3a 74 69 6d 65 72 20 24 64 62 0a 09 t v::timer $db..
6c10: 61 72 72 61 79 20 75 6e 73 65 74 20 76 3a 3a 63 array unset v::c
6c20: 61 63 68 65 20 24 64 62 2c 2a 0a 09 61 72 72 61 ache $db,*..arra
6c30: 79 20 75 6e 73 65 74 20 76 3a 3a 66 63 61 63 68 y unset v::fcach
6c40: 65 20 24 64 62 2e 2a 0a 09 72 65 61 64 6b 69 74 e $db.*..readkit
6c50: 3a 3a 66 69 6c 65 20 63 6c 6f 73 65 20 24 64 62 ::file close $db
6c60: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 . }.. proc
6c70: 20 73 74 61 74 20 7b 64 62 20 70 61 74 68 20 7b stat {db path {
6c80: 61 72 72 20 22 22 7d 7d 20 7b 0a 09 73 65 74 20 arr ""}} {..set
6c90: 73 70 20 5b 3a 3a 66 69 6c 65 20 73 70 6c 69 74 sp [::file split
6ca0: 20 24 70 61 74 68 5d 0a 09 73 65 74 20 74 61 69 $path]..set tai
6cb0: 6c 20 5b 6c 69 6e 64 65 78 20 24 73 70 20 65 6e l [lindex $sp en
6cc0: 64 5d 0a 0a 09 73 65 74 20 70 61 72 65 6e 74 20 d]...set parent
6cd0: 30 0a 09 73 65 74 20 76 69 65 77 20 24 64 62 2e 0..set view $db.
6ce0: 64 69 72 73 0a 09 73 65 74 20 74 79 70 65 20 64 dirs..set type d
6cf0: 69 72 65 63 74 6f 72 79 0a 0a 09 66 6f 72 65 61 irectory...forea
6d00: 63 68 20 65 6c 65 20 5b 6c 72 61 6e 67 65 20 24 ch ele [lrange $
6d10: 73 70 20 30 20 65 6e 64 2d 31 5d 20 7b 0a 09 20 sp 0 end-1] {..
6d20: 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 if {[info exi
6d30: 73 74 73 20 76 3a 3a 63 61 63 68 65 28 24 64 62 sts v::cache($db
6d40: 2c 24 70 61 72 65 6e 74 2c 24 65 6c 65 29 5d 7d ,$parent,$ele)]}
6d50: 20 7b 0a 09 09 73 65 74 20 70 61 72 65 6e 74 20 {...set parent
6d60: 24 76 3a 3a 63 61 63 68 65 28 24 64 62 2c 24 70 $v::cache($db,$p
6d70: 61 72 65 6e 74 2c 24 65 6c 65 29 0a 09 20 20 20 arent,$ele)..
6d80: 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 } else {...set
6d90: 72 6f 77 20 5b 72 65 61 64 6b 69 74 3a 3a 73 65 row [readkit::se
6da0: 6c 65 63 74 20 24 76 69 65 77 20 2d 63 6f 75 6e lect $view -coun
6db0: 74 20 31 20 70 61 72 65 6e 74 20 24 70 61 72 65 t 1 parent $pare
6dc0: 6e 74 20 6e 61 6d 65 20 24 65 6c 65 5d 0a 09 09 nt name $ele]...
6dd0: 69 66 20 7b 20 24 72 6f 77 20 3d 3d 20 22 22 20 if { $row == ""
6de0: 7d 20 7b 0a 09 09 20 20 20 20 76 66 73 3a 3a 66 } {... vfs::f
6df0: 69 6c 65 73 79 73 74 65 6d 20 70 6f 73 69 78 65 ilesystem posixe
6e00: 72 72 6f 72 20 24 3a 3a 76 66 73 3a 3a 70 6f 73 rror $::vfs::pos
6e10: 69 78 28 45 4e 4f 45 4e 54 29 0a 09 09 7d 0a 09 ix(ENOENT)...}..
6e20: 09 73 65 74 20 76 3a 3a 63 61 63 68 65 28 24 64 .set v::cache($d
6e30: 62 2c 24 70 61 72 65 6e 74 2c 24 65 6c 65 29 20 b,$parent,$ele)
6e40: 24 72 6f 77 0a 09 09 73 65 74 20 70 61 72 65 6e $row...set paren
6e50: 74 20 24 72 6f 77 0a 09 20 20 20 20 7d 0a 09 7d t $row.. }..}
6e60: 0a 09 0a 09 23 20 4e 6f 77 20 63 68 65 63 6b 20 ....# Now check
6e70: 69 66 20 66 69 6e 61 6c 20 63 6f 6d 70 20 69 73 if final comp is
6e80: 20 61 20 64 69 72 65 63 74 6f 72 79 20 6f 72 20 a directory or
6e90: 61 20 66 69 6c 65 0a 09 23 20 43 41 43 48 49 4e a file..# CACHIN
6ea0: 47 20 69 73 20 72 65 71 75 69 72 65 64 20 2d 20 G is required -
6eb0: 69 74 20 63 61 6e 20 64 65 6c 69 76 65 72 20 61 it can deliver a
6ec0: 20 78 31 35 20 73 70 65 65 64 2d 75 70 21 0a 09 x15 speed-up!..
6ed0: 0a 09 69 66 20 7b 20 5b 73 74 72 69 6e 67 20 65 ..if { [string e
6ee0: 71 75 61 6c 20 24 74 61 69 6c 20 22 2e 22 5d 20 qual $tail "."]
6ef0: 7c 7c 20 5b 73 74 72 69 6e 67 20 65 71 75 61 6c || [string equal
6f00: 20 24 74 61 69 6c 20 22 3a 22 5d 20 5c 0a 09 20 $tail ":"] \..
6f10: 20 7c 7c 20 5b 73 74 72 69 6e 67 20 65 71 75 61 || [string equa
6f20: 6c 20 24 74 61 69 6c 20 22 22 5d 20 7d 20 7b 0a l $tail ""] } {.
6f30: 09 20 20 20 20 73 65 74 20 72 6f 77 20 24 70 61 . set row $pa
6f40: 72 65 6e 74 0a 0a 09 7d 20 65 6c 73 65 69 66 20 rent...} elseif
6f50: 7b 20 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 76 { [info exists v
6f60: 3a 3a 63 61 63 68 65 28 24 64 62 2c 24 70 61 72 ::cache($db,$par
6f70: 65 6e 74 2c 24 74 61 69 6c 29 5d 20 7d 20 7b 0a ent,$tail)] } {.
6f80: 09 20 20 20 20 73 65 74 20 72 6f 77 20 24 76 3a . set row $v:
6f90: 3a 63 61 63 68 65 28 24 64 62 2c 24 70 61 72 65 :cache($db,$pare
6fa0: 6e 74 2c 24 74 61 69 6c 29 0a 09 7d 20 65 6c 73 nt,$tail)..} els
6fb0: 65 20 7b 0a 09 20 20 20 20 23 20 46 69 6c 65 3f e {.. # File?
6fc0: 0a 09 20 20 20 20 73 65 74 20 66 76 69 65 77 20 .. set fview
6fd0: 24 76 69 65 77 21 24 70 61 72 65 6e 74 2e 66 69 $view!$parent.fi
6fe0: 6c 65 73 0a 09 20 20 20 20 23 20 63 72 65 61 74 les.. # creat
6ff0: 65 20 61 20 6e 61 6d 65 20 63 61 63 68 65 20 6f e a name cache o
7000: 66 20 66 69 6c 65 73 20 69 6e 20 74 68 69 73 20 f files in this
7010: 64 69 72 65 63 74 6f 72 79 0a 09 20 20 20 20 69 directory.. i
7020: 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 f {![info exists
7030: 20 76 3a 3a 66 63 61 63 68 65 28 24 66 76 69 65 v::fcache($fvie
7040: 77 29 5d 7d 20 7b 0a 09 09 23 20 63 61 63 68 65 w)]} {...# cache
7050: 20 6f 6e 6c 79 20 61 20 6c 69 6d 69 74 65 64 20 only a limited
7060: 6e 75 6d 62 65 72 20 6f 66 20 64 69 72 65 63 74 number of direct
7070: 6f 72 69 65 73 0a 09 09 69 66 20 7b 5b 61 72 72 ories...if {[arr
7080: 61 79 20 73 69 7a 65 20 76 3a 3a 66 63 61 63 68 ay size v::fcach
7090: 65 5d 20 3e 3d 20 31 30 7d 20 7b 0a 09 09 20 20 e] >= 10} {...
70a0: 20 20 61 72 72 61 79 20 75 6e 73 65 74 20 76 3a array unset v:
70b0: 3a 66 63 61 63 68 65 20 2a 0a 09 09 7d 0a 09 09 :fcache *...}...
70c0: 73 65 74 20 76 3a 3a 66 63 61 63 68 65 28 24 66 set v::fcache($f
70d0: 76 69 65 77 29 20 7b 7d 0a 09 09 72 65 61 64 6b view) {}...readk
70e0: 69 74 3a 3a 6c 6f 6f 70 20 63 20 24 66 76 69 65 it::loop c $fvie
70f0: 77 20 7b 0a 09 09 20 20 20 20 6c 61 70 70 65 6e w {... lappen
7100: 64 20 76 3a 3a 66 63 61 63 68 65 28 24 66 76 69 d v::fcache($fvi
7110: 65 77 29 20 5b 72 65 61 64 6b 69 74 3a 3a 67 65 ew) [readkit::ge
7120: 74 20 24 63 20 6e 61 6d 65 5d 0a 09 09 7d 0a 09 t $c name]...}..
7130: 20 20 20 20 7d 0a 09 20 20 20 20 73 65 74 20 72 }.. set r
7140: 6f 77 20 5b 6c 73 65 61 72 63 68 20 2d 65 78 61 ow [lsearch -exa
7150: 63 74 20 24 76 3a 3a 66 63 61 63 68 65 28 24 66 ct $v::fcache($f
7160: 76 69 65 77 29 20 24 74 61 69 6c 5d 0a 09 20 20 view) $tail]..
7170: 20 20 23 73 65 74 20 72 6f 77 20 5b 72 65 61 64 #set row [read
7180: 6b 69 74 3a 3a 73 65 6c 65 63 74 20 24 66 76 69 kit::select $fvi
7190: 65 77 20 2d 63 6f 75 6e 74 20 31 20 6e 61 6d 65 ew -count 1 name
71a0: 20 24 74 61 69 6c 5d 0a 09 20 20 20 20 23 69 66 $tail].. #if
71b0: 20 7b 24 72 6f 77 20 3d 3d 20 22 22 7d 20 7b 20 {$row == ""} {
71c0: 73 65 74 20 72 6f 77 20 2d 31 20 7d 0a 09 20 20 set row -1 }..
71d0: 20 20 69 66 20 7b 20 24 72 6f 77 20 21 3d 20 2d if { $row != -
71e0: 31 20 7d 20 7b 0a 09 09 73 65 74 20 74 79 70 65 1 } {...set type
71f0: 20 66 69 6c 65 0a 09 09 73 65 74 20 76 69 65 77 file...set view
7200: 20 24 76 69 65 77 21 24 70 61 72 65 6e 74 2e 66 $view!$parent.f
7210: 69 6c 65 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 iles.. } else
7220: 20 7b 0a 09 09 23 20 44 69 72 65 63 74 6f 72 79 {...# Directory
7230: 3f 0a 09 09 73 65 74 20 72 6f 77 20 5b 72 65 61 ?...set row [rea
7240: 64 6b 69 74 3a 3a 73 65 6c 65 63 74 20 24 76 69 dkit::select $vi
7250: 65 77 20 2d 63 6f 75 6e 74 20 31 20 70 61 72 65 ew -count 1 pare
7260: 6e 74 20 24 70 61 72 65 6e 74 20 6e 61 6d 65 20 nt $parent name
7270: 24 74 61 69 6c 5d 0a 09 09 69 66 20 7b 20 24 72 $tail]...if { $r
7280: 6f 77 20 21 3d 20 22 22 20 7d 20 7b 0a 09 09 20 ow != "" } {...
7290: 20 20 20 73 65 74 20 76 3a 3a 63 61 63 68 65 28 set v::cache(
72a0: 24 64 62 2c 24 70 61 72 65 6e 74 2c 24 74 61 69 $db,$parent,$tai
72b0: 6c 29 20 24 72 6f 77 0a 09 09 7d 20 65 6c 73 65 l) $row...} else
72c0: 20 7b 20 0a 09 09 20 20 20 20 76 66 73 3a 3a 66 { ... vfs::f
72d0: 69 6c 65 73 79 73 74 65 6d 20 70 6f 73 69 78 65 ilesystem posixe
72e0: 72 72 6f 72 20 24 3a 3a 76 66 73 3a 3a 70 6f 73 rror $::vfs::pos
72f0: 69 78 28 45 4e 4f 45 4e 54 29 0a 09 09 7d 0a 09 ix(ENOENT)...}..
7300: 20 20 20 20 7d 0a 09 7d 0a 20 0a 20 20 20 20 20 }..}. .
7310: 20 20 20 69 66 20 7b 21 5b 73 74 72 69 6e 67 20 if {![string
7320: 6c 65 6e 67 74 68 20 24 61 72 72 5d 7d 20 7b 0a length $arr]} {.
7330: 20 20 20 20 20 20 20 20 20 20 20 20 23 20 54 68 # Th
7340: 65 20 63 61 6c 6c 65 72 20 64 6f 65 73 6e 27 74 e caller doesn't
7350: 20 6e 65 65 64 20 6d 6f 72 65 20 64 65 74 61 69 need more detai
7360: 6c 65 64 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 2e led information.
7370: 0a 20 20 20 20 20 20 20 20 20 20 20 20 72 65 74 . ret
7380: 75 72 6e 20 31 0a 20 20 20 20 20 20 20 20 7d 0a urn 1. }.
7390: 20 0a 09 73 65 74 20 63 75 72 20 24 76 69 65 77 ..set cur $view
73a0: 21 24 72 6f 77 0a 0a 09 75 70 76 61 72 20 31 20 !$row...upvar 1
73b0: 24 61 72 72 20 73 62 0a 0a 09 73 65 74 20 73 62 $arr sb...set sb
73c0: 28 74 79 70 65 29 20 20 20 20 24 74 79 70 65 0a (type) $type.
73d0: 09 73 65 74 20 73 62 28 76 69 65 77 29 20 20 20 .set sb(view)
73e0: 20 24 76 69 65 77 0a 09 73 65 74 20 73 62 28 69 $view..set sb(i
73f0: 6e 6f 29 20 20 20 20 20 24 63 75 72 0a 0a 09 69 no) $cur...i
7400: 66 20 7b 20 5b 73 74 72 69 6e 67 20 65 71 75 61 f { [string equa
7410: 6c 20 24 74 79 70 65 20 22 64 69 72 65 63 74 6f l $type "directo
7420: 72 79 22 5d 20 7d 20 7b 0a 09 20 20 20 20 73 65 ry"] } {.. se
7430: 74 20 73 62 28 61 74 69 6d 65 29 20 30 0a 09 20 t sb(atime) 0..
7440: 20 20 20 73 65 74 20 73 62 28 63 74 69 6d 65 29 set sb(ctime)
7450: 20 30 0a 09 20 20 20 20 73 65 74 20 73 62 28 67 0.. set sb(g
7460: 69 64 29 20 20 20 30 0a 09 20 20 20 20 73 65 74 id) 0.. set
7470: 20 73 62 28 6d 6f 64 65 29 20 20 30 37 37 37 0a sb(mode) 0777.
7480: 09 20 20 20 20 73 65 74 20 73 62 28 6d 74 69 6d . set sb(mtim
7490: 65 29 20 30 0a 09 20 20 20 20 73 65 74 20 73 62 e) 0.. set sb
74a0: 28 6e 6c 69 6e 6b 29 20 5b 65 78 70 72 20 7b 20 (nlink) [expr {
74b0: 5b 72 65 61 64 6b 69 74 3a 3a 67 65 74 20 24 63 [readkit::get $c
74c0: 75 72 20 66 69 6c 65 73 5d 20 2b 20 31 20 7d 5d ur files] + 1 }]
74d0: 0a 09 20 20 20 20 73 65 74 20 73 62 28 73 69 7a .. set sb(siz
74e0: 65 29 20 20 30 0a 09 20 20 20 20 73 65 74 20 73 e) 0.. set s
74f0: 62 28 63 73 69 7a 65 29 20 30 0a 09 20 20 20 20 b(csize) 0..
7500: 73 65 74 20 73 62 28 75 69 64 29 20 20 20 30 0a set sb(uid) 0.
7510: 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 .} else {.. s
7520: 65 74 20 6d 74 69 6d 65 20 20 20 5b 72 65 61 64 et mtime [read
7530: 6b 69 74 3a 3a 67 65 74 20 24 63 75 72 20 64 61 kit::get $cur da
7540: 74 65 5d 0a 09 20 20 20 20 73 65 74 20 73 62 28 te].. set sb(
7550: 61 74 69 6d 65 29 20 24 6d 74 69 6d 65 0a 09 20 atime) $mtime..
7560: 20 20 20 73 65 74 20 73 62 28 63 74 69 6d 65 29 set sb(ctime)
7570: 20 24 6d 74 69 6d 65 0a 09 20 20 20 20 73 65 74 $mtime.. set
7580: 20 73 62 28 67 69 64 29 20 20 20 30 0a 09 20 20 sb(gid) 0..
7590: 20 20 73 65 74 20 73 62 28 6d 6f 64 65 29 20 20 set sb(mode)
75a0: 30 37 37 37 0a 09 20 20 20 20 73 65 74 20 73 62 0777.. set sb
75b0: 28 6d 74 69 6d 65 29 20 24 6d 74 69 6d 65 0a 09 (mtime) $mtime..
75c0: 20 20 20 20 73 65 74 20 73 62 28 6e 6c 69 6e 6b set sb(nlink
75d0: 29 20 31 0a 09 20 20 20 20 73 65 74 20 73 62 28 ) 1.. set sb(
75e0: 73 69 7a 65 29 20 20 5b 72 65 61 64 6b 69 74 3a size) [readkit:
75f0: 3a 67 65 74 20 24 63 75 72 20 73 69 7a 65 5d 0a :get $cur size].
7600: 09 20 20 20 20 73 65 74 20 73 62 28 63 73 69 7a . set sb(csiz
7610: 65 29 20 5b 72 65 61 64 6b 69 74 3a 3a 67 65 74 e) [readkit::get
7620: 20 24 63 75 72 20 2d 73 69 7a 65 20 63 6f 6e 74 $cur -size cont
7630: 65 6e 74 73 5d 0a 09 20 20 20 20 73 65 74 20 73 ents].. set s
7640: 62 28 75 69 64 29 20 20 20 30 0a 09 7d 0a 20 20 b(uid) 0..}.
7650: 20 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 64 6f }.. proc do
7660: 5f 63 6c 6f 73 65 20 7b 64 62 20 66 64 20 6d 6f _close {db fd mo
7670: 64 65 20 63 75 72 7d 20 7b 0a 09 69 66 20 7b 21 de cur} {..if {!
7680: 5b 72 65 67 65 78 70 20 7b 5b 61 77 5d 7d 20 24 [regexp {[aw]} $
7690: 6d 6f 64 65 5d 7d 20 7b 0a 09 20 20 20 20 65 72 mode]} {.. er
76a0: 72 6f 72 20 22 6d 6b 63 6c 5f 76 66 73 3a 3a 64 ror "mkcl_vfs::d
76b0: 6f 5f 63 6c 6f 73 65 20 63 61 6c 6c 65 64 20 77 o_close called w
76c0: 69 74 68 20 62 61 64 20 6d 6f 64 65 3a 20 24 6d ith bad mode: $m
76d0: 6f 64 65 22 0a 09 7d 0a 0a 09 72 65 61 64 6b 69 ode"..}...readki
76e0: 74 3a 3a 73 65 74 20 24 63 75 72 20 73 69 7a 65 t::set $cur size
76f0: 20 2d 31 20 64 61 74 65 20 5b 63 6c 6f 63 6b 20 -1 date [clock
7700: 73 65 63 6f 6e 64 73 5d 0a 09 66 6c 75 73 68 20 seconds]..flush
7710: 24 66 64 0a 09 69 66 20 7b 20 5b 73 74 72 69 6e $fd..if { [strin
7720: 67 20 6d 61 74 63 68 20 2a 7a 2a 20 24 6d 6f 64 g match *z* $mod
7730: 65 5d 20 7d 20 7b 0a 09 20 20 20 20 66 63 6f 6e e] } {.. fcon
7740: 66 69 67 75 72 65 20 24 66 64 20 2d 74 72 61 6e figure $fd -tran
7750: 73 6c 61 74 69 6f 6e 20 62 69 6e 61 72 79 0a 09 slation binary..
7760: 20 20 20 20 73 65 65 6b 20 24 66 64 20 30 0a 09 seek $fd 0..
7770: 20 20 20 20 73 65 74 20 64 61 74 61 20 5b 72 65 set data [re
7780: 61 64 20 24 66 64 5d 0a 09 20 20 20 20 73 65 74 ad $fd].. set
7790: 20 63 64 61 74 61 20 5b 76 66 73 3a 3a 7a 69 70 cdata [vfs::zip
77a0: 20 2d 6d 6f 64 65 20 63 6f 6d 70 72 65 73 73 20 -mode compress
77b0: 24 64 61 74 61 5d 0a 09 20 20 20 20 73 65 74 20 $data].. set
77c0: 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 len [string leng
77d0: 74 68 20 24 64 61 74 61 5d 0a 09 20 20 20 20 73 th $data].. s
77e0: 65 74 20 63 6c 65 6e 20 5b 73 74 72 69 6e 67 20 et clen [string
77f0: 6c 65 6e 67 74 68 20 24 63 64 61 74 61 5d 0a 09 length $cdata]..
7800: 20 20 20 20 69 66 20 7b 20 24 63 6c 65 6e 20 3c if { $clen <
7810: 20 24 6c 65 6e 20 7d 20 7b 0a 09 09 72 65 61 64 $len } {...read
7820: 6b 69 74 3a 3a 73 65 74 20 24 63 75 72 20 73 69 kit::set $cur si
7830: 7a 65 20 24 6c 65 6e 20 63 6f 6e 74 65 6e 74 73 ze $len contents
7840: 20 24 63 64 61 74 61 0a 09 20 20 20 20 7d 20 65 $cdata.. } e
7850: 6c 73 65 20 7b 0a 09 09 72 65 61 64 6b 69 74 3a lse {...readkit:
7860: 3a 73 65 74 20 24 63 75 72 20 73 69 7a 65 20 24 :set $cur size $
7870: 6c 65 6e 20 63 6f 6e 74 65 6e 74 73 20 24 64 61 len contents $da
7880: 74 61 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 ta.. }..} els
7890: 65 20 7b 0a 09 20 20 20 20 72 65 61 64 6b 69 74 e {.. readkit
78a0: 3a 3a 73 65 74 20 24 63 75 72 20 73 69 7a 65 20 ::set $cur size
78b0: 5b 72 65 61 64 6b 69 74 3a 3a 67 65 74 20 24 63 [readkit::get $c
78c0: 75 72 20 2d 73 69 7a 65 20 63 6f 6e 74 65 6e 74 ur -size content
78d0: 73 5d 0a 09 7d 0a 09 23 20 31 36 6f 63 74 30 32 s]..}..# 16oct02
78e0: 20 6e 65 77 20 6c 6f 67 69 63 20 74 6f 20 73 74 new logic to st
78f0: 61 72 74 20 61 20 70 65 72 69 6f 64 69 63 20 63 art a periodic c
7900: 6f 6d 6d 69 74 20 74 69 6d 65 72 20 69 66 20 6e ommit timer if n
7910: 6f 74 20 79 65 74 20 72 75 6e 6e 69 6e 67 0a 09 ot yet running..
7920: 73 65 74 75 70 43 6f 6d 6d 69 74 73 20 24 64 62 setupCommits $db
7930: 0a 09 72 65 74 75 72 6e 20 22 22 0a 20 20 20 20 ..return "".
7940: 7d 0a 0a 20 20 20 20 70 72 6f 63 20 73 65 74 75 }.. proc setu
7950: 70 43 6f 6d 6d 69 74 73 20 7b 64 62 7d 20 7b 0a pCommits {db} {.
7960: 09 69 66 20 7b 24 76 3a 3a 6d 6f 64 65 28 24 64 .if {$v::mode($d
7970: 62 29 20 65 71 20 22 72 65 61 64 77 72 69 74 65 b) eq "readwrite
7980: 22 20 26 26 20 21 5b 69 6e 66 6f 20 65 78 69 73 " && ![info exis
7990: 74 73 20 76 3a 3a 74 69 6d 65 72 28 24 64 62 29 ts v::timer($db)
79a0: 5d 7d 20 7b 0a 09 20 20 20 20 70 65 72 69 6f 64 ]} {.. period
79b0: 69 63 43 6f 6d 6d 69 74 20 24 64 62 0a 09 20 20 icCommit $db..
79c0: 20 20 72 65 61 64 6b 69 74 3a 3a 66 69 6c 65 20 readkit::file
79d0: 61 75 74 6f 63 6f 6d 6d 69 74 20 24 64 62 0a 09 autocommit $db..
79e0: 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 70 72 6f }. }.. pro
79f0: 63 20 6d 6b 64 69 72 20 7b 64 62 20 70 61 74 68 c mkdir {db path
7a00: 7d 20 7b 0a 09 69 66 20 7b 24 76 3a 3a 6d 6f 64 } {..if {$v::mod
7a10: 65 28 24 64 62 29 20 3d 3d 20 22 72 65 61 64 6f e($db) == "reado
7a20: 6e 6c 79 22 7d 20 7b 0a 09 20 20 20 20 76 66 73 nly"} {.. vfs
7a30: 3a 3a 66 69 6c 65 73 79 73 74 65 6d 20 70 6f 73 ::filesystem pos
7a40: 69 78 65 72 72 6f 72 20 24 3a 3a 76 66 73 3a 3a ixerror $::vfs::
7a50: 70 6f 73 69 78 28 45 52 4f 46 53 29 0a 09 7d 0a posix(EROFS)..}.
7a60: 09 73 65 74 20 73 70 20 5b 3a 3a 66 69 6c 65 20 .set sp [::file
7a70: 73 70 6c 69 74 20 24 70 61 74 68 5d 0a 09 73 65 split $path]..se
7a80: 74 20 70 61 72 65 6e 74 20 30 0a 09 73 65 74 20 t parent 0..set
7a90: 76 69 65 77 20 24 64 62 2e 64 69 72 73 0a 0a 09 view $db.dirs...
7aa0: 73 65 74 20 6e 70 61 74 68 20 7b 7d 0a 09 23 20 set npath {}..#
7ab0: 54 68 69 73 20 61 63 74 75 61 6c 6c 79 20 64 6f This actually do
7ac0: 65 73 20 6d 6f 72 65 20 77 6f 72 6b 20 74 68 61 es more work tha
7ad0: 6e 20 69 73 20 6e 65 65 64 65 64 2e 20 54 63 6c n is needed. Tcl
7ae0: 27 73 0a 09 23 20 76 66 73 20 6f 6e 6c 79 20 72 's..# vfs only r
7af0: 65 71 75 69 72 65 73 20 75 73 20 74 6f 20 63 72 equires us to cr
7b00: 65 61 74 65 20 74 68 65 20 6c 61 73 74 20 70 69 eate the last pi
7b10: 65 63 65 2c 20 61 6e 64 0a 09 23 20 54 63 6c 20 ece, and..# Tcl
7b20: 61 6c 72 65 61 64 79 20 6b 6e 6f 77 73 20 69 74 already knows it
7b30: 20 69 73 20 6e 6f 74 20 61 20 66 69 6c 65 2e 0a is not a file..
7b40: 09 66 6f 72 65 61 63 68 20 65 6c 65 20 24 73 70 .foreach ele $sp
7b50: 20 7b 0a 09 20 20 20 20 73 65 74 20 6e 70 61 74 {.. set npat
7b60: 68 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 6e 70 h [file join $np
7b70: 61 74 68 20 24 65 6c 65 5d 0a 0a 09 20 20 20 20 ath $ele]...
7b80: 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 74 61 if {![catch {sta
7b90: 74 20 24 64 62 20 24 6e 70 61 74 68 20 73 62 7d t $db $npath sb}
7ba0: 5d 20 7d 20 7b 0a 09 09 69 66 20 7b 20 24 73 62 ] } {...if { $sb
7bb0: 28 74 79 70 65 29 20 21 3d 20 22 64 69 72 65 63 (type) != "direc
7bc0: 74 6f 72 79 22 20 7d 20 7b 0a 09 09 20 20 20 20 tory" } {...
7bd0: 76 66 73 3a 3a 66 69 6c 65 73 79 73 74 65 6d 20 vfs::filesystem
7be0: 70 6f 73 69 78 65 72 72 6f 72 20 24 3a 3a 76 66 posixerror $::vf
7bf0: 73 3a 3a 70 6f 73 69 78 28 45 52 4f 46 53 29 0a s::posix(EROFS).
7c00: 09 09 7d 0a 09 09 73 65 74 20 70 61 72 65 6e 74 ..}...set parent
7c10: 20 5b 72 65 61 64 6b 69 74 3a 3a 63 75 72 73 6f [readkit::curso
7c20: 72 20 70 6f 73 69 74 69 6f 6e 20 73 62 28 69 6e r position sb(in
7c30: 6f 29 5d 0a 09 09 63 6f 6e 74 69 6e 75 65 0a 09 o)]...continue..
7c40: 20 20 20 20 7d 0a 09 20 20 20 20 23 73 65 74 20 }.. #set
7c50: 70 61 72 65 6e 74 20 5b 72 65 61 64 6b 69 74 3a parent [readkit:
7c60: 3a 63 75 72 73 6f 72 20 70 6f 73 69 74 69 6f 6e :cursor position
7c70: 20 73 62 28 69 6e 6f 29 5d 0a 09 20 20 20 20 73 sb(ino)].. s
7c80: 65 74 20 63 75 72 20 5b 72 65 61 64 6b 69 74 3a et cur [readkit:
7c90: 3a 72 6f 77 20 61 70 70 65 6e 64 20 24 76 69 65 :row append $vie
7ca0: 77 20 6e 61 6d 65 20 24 65 6c 65 20 70 61 72 65 w name $ele pare
7cb0: 6e 74 20 24 70 61 72 65 6e 74 5d 0a 09 20 20 20 nt $parent]..
7cc0: 20 73 65 74 20 70 61 72 65 6e 74 20 5b 72 65 61 set parent [rea
7cd0: 64 6b 69 74 3a 3a 63 75 72 73 6f 72 20 70 6f 73 dkit::cursor pos
7ce0: 69 74 69 6f 6e 20 63 75 72 5d 0a 09 7d 0a 09 73 ition cur]..}..s
7cf0: 65 74 75 70 43 6f 6d 6d 69 74 73 20 24 64 62 0a etupCommits $db.
7d00: 09 72 65 74 75 72 6e 20 22 22 0a 20 20 20 20 7d .return "". }
7d10: 0a 0a 20 20 20 20 70 72 6f 63 20 67 65 74 64 69 .. proc getdi
7d20: 72 20 7b 64 62 20 70 61 74 68 20 7b 70 61 74 20 r {db path {pat
7d30: 2a 7d 7d 20 7b 0a 09 69 66 20 7b 5b 63 61 74 63 *}} {..if {[catc
7d40: 68 20 7b 20 73 74 61 74 20 24 64 62 20 24 70 61 h { stat $db $pa
7d50: 74 68 20 73 62 20 7d 5d 20 7c 7c 20 24 73 62 28 th sb }] || $sb(
7d60: 74 79 70 65 29 20 21 3d 20 22 64 69 72 65 63 74 type) != "direct
7d70: 6f 72 79 22 20 7d 20 7b 0a 09 20 20 20 20 72 65 ory" } {.. re
7d80: 74 75 72 6e 0a 09 7d 0a 0a 09 23 20 4d 61 74 63 turn..}...# Matc
7d90: 68 20 64 69 72 65 63 74 6f 72 69 65 73 0a 09 73 h directories..s
7da0: 65 74 20 70 61 72 65 6e 74 20 5b 72 65 61 64 6b et parent [readk
7db0: 69 74 3a 3a 63 75 72 73 6f 72 20 70 6f 73 69 74 it::cursor posit
7dc0: 69 6f 6e 20 73 62 28 69 6e 6f 29 5d 20 0a 09 66 ion sb(ino)] ..f
7dd0: 6f 72 65 61 63 68 20 72 6f 77 20 5b 72 65 61 64 oreach row [read
7de0: 6b 69 74 3a 3a 73 65 6c 65 63 74 20 24 73 62 28 kit::select $sb(
7df0: 76 69 65 77 29 20 70 61 72 65 6e 74 20 24 70 61 view) parent $pa
7e00: 72 65 6e 74 20 2d 67 6c 6f 62 20 6e 61 6d 65 20 rent -glob name
7e10: 24 70 61 74 5d 20 7b 0a 09 20 20 20 20 73 65 74 $pat] {.. set
7e20: 20 68 69 74 73 28 5b 72 65 61 64 6b 69 74 3a 3a hits([readkit::
7e30: 67 65 74 20 24 73 62 28 76 69 65 77 29 21 24 72 get $sb(view)!$r
7e40: 6f 77 20 6e 61 6d 65 5d 29 20 31 0a 09 7d 0a 09 ow name]) 1..}..
7e50: 23 20 4d 61 74 63 68 20 66 69 6c 65 73 0a 09 73 # Match files..s
7e60: 65 74 20 76 69 65 77 20 24 73 62 28 76 69 65 77 et view $sb(view
7e70: 29 21 24 70 61 72 65 6e 74 2e 66 69 6c 65 73 0a )!$parent.files.
7e80: 09 66 6f 72 65 61 63 68 20 72 6f 77 20 5b 72 65 .foreach row [re
7e90: 61 64 6b 69 74 3a 3a 73 65 6c 65 63 74 20 24 76 adkit::select $v
7ea0: 69 65 77 20 2d 67 6c 6f 62 20 6e 61 6d 65 20 24 iew -glob name $
7eb0: 70 61 74 5d 20 7b 0a 09 20 20 20 20 73 65 74 20 pat] {.. set
7ec0: 68 69 74 73 28 5b 72 65 61 64 6b 69 74 3a 3a 67 hits([readkit::g
7ed0: 65 74 20 24 76 69 65 77 21 24 72 6f 77 20 6e 61 et $view!$row na
7ee0: 6d 65 5d 29 20 31 0a 09 7d 0a 09 72 65 74 75 72 me]) 1..}..retur
7ef0: 6e 20 5b 6c 73 6f 72 74 20 5b 61 72 72 61 79 20 n [lsort [array
7f00: 6e 61 6d 65 73 20 68 69 74 73 5d 5d 0a 20 20 20 names hits]].
7f10: 20 7d 0a 0a 20 20 20 20 70 72 6f 63 20 6d 74 69 }.. proc mti
7f20: 6d 65 20 7b 64 62 20 70 61 74 68 20 74 69 6d 65 me {db path time
7f30: 7d 20 7b 0a 09 69 66 20 7b 24 76 3a 3a 6d 6f 64 } {..if {$v::mod
7f40: 65 28 24 64 62 29 20 3d 3d 20 22 72 65 61 64 6f e($db) == "reado
7f50: 6e 6c 79 22 7d 20 7b 0a 09 20 20 20 20 76 66 73 nly"} {.. vfs
7f60: 3a 3a 66 69 6c 65 73 79 73 74 65 6d 20 70 6f 73 ::filesystem pos
7f70: 69 78 65 72 72 6f 72 20 24 3a 3a 76 66 73 3a 3a ixerror $::vfs::
7f80: 70 6f 73 69 78 28 45 52 4f 46 53 29 0a 09 7d 0a posix(EROFS)..}.
7f90: 09 73 74 61 74 20 24 64 62 20 24 70 61 74 68 20 .stat $db $path
7fa0: 73 62 0a 09 69 66 20 7b 20 24 73 62 28 74 79 70 sb..if { $sb(typ
7fb0: 65 29 20 3d 3d 20 22 66 69 6c 65 22 20 7d 20 7b e) == "file" } {
7fc0: 0a 09 20 20 20 20 72 65 61 64 6b 69 74 3a 3a 73 .. readkit::s
7fd0: 65 74 20 24 73 62 28 69 6e 6f 29 20 64 61 74 65 et $sb(ino) date
7fe0: 20 24 74 69 6d 65 0a 09 7d 0a 09 72 65 74 75 72 $time..}..retur
7ff0: 6e 20 24 74 69 6d 65 0a 20 20 20 20 7d 0a 0a 20 n $time. }..
8000: 20 20 20 70 72 6f 63 20 64 65 6c 65 74 65 20 7b proc delete {
8010: 64 62 20 70 61 74 68 20 7b 72 65 63 75 72 73 69 db path {recursi
8020: 76 65 20 30 7d 7d 20 7b 0a 09 23 70 75 74 73 20 ve 0}} {..#puts
8030: 73 74 64 65 72 72 20 22 6d 6b 34 64 65 6c 65 74 stderr "mk4delet
8040: 65 20 64 62 20 24 64 62 20 70 61 74 68 20 24 70 e db $db path $p
8050: 61 74 68 20 72 65 63 75 72 73 69 76 65 20 24 72 ath recursive $r
8060: 65 63 75 72 73 69 76 65 22 0a 09 69 66 20 7b 24 ecursive"..if {$
8070: 76 3a 3a 6d 6f 64 65 28 24 64 62 29 20 3d 3d 20 v::mode($db) ==
8080: 22 72 65 61 64 6f 6e 6c 79 22 7d 20 7b 0a 09 20 "readonly"} {..
8090: 20 20 20 76 66 73 3a 3a 66 69 6c 65 73 79 73 74 vfs::filesyst
80a0: 65 6d 20 70 6f 73 69 78 65 72 72 6f 72 20 24 3a em posixerror $:
80b0: 3a 76 66 73 3a 3a 70 6f 73 69 78 28 45 52 4f 46 :vfs::posix(EROF
80c0: 53 29 0a 09 7d 0a 09 73 74 61 74 20 24 64 62 20 S)..}..stat $db
80d0: 24 70 61 74 68 20 73 62 0a 09 69 66 20 7b 24 73 $path sb..if {$s
80e0: 62 28 74 79 70 65 29 20 3d 3d 20 22 66 69 6c 65 b(type) == "file
80f0: 22 20 7d 20 7b 0a 09 20 20 20 20 72 65 61 64 6b " } {.. readk
8100: 69 74 3a 3a 72 6f 77 20 64 65 6c 65 74 65 20 24 it::row delete $
8110: 73 62 28 69 6e 6f 29 0a 09 20 20 20 20 69 66 20 sb(ino).. if
8120: 7b 5b 72 65 67 65 78 70 20 7b 28 2e 2a 29 21 28 {[regexp {(.*)!(
8130: 5c 64 2b 29 7d 20 24 73 62 28 69 6e 6f 29 20 2d \d+)} $sb(ino) -
8140: 20 76 20 72 5d 20 5c 0a 09 09 20 20 20 20 26 26 v r] \... &&
8150: 20 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 76 3a [info exists v:
8160: 3a 66 63 61 63 68 65 28 24 76 29 5d 7d 20 7b 0a :fcache($v)]} {.
8170: 09 09 73 65 74 20 76 3a 3a 66 63 61 63 68 65 28 ..set v::fcache(
8180: 24 76 29 20 5b 6c 72 65 70 6c 61 63 65 20 24 76 $v) [lreplace $v
8190: 3a 3a 66 63 61 63 68 65 28 24 76 29 20 24 72 20 ::fcache($v) $r
81a0: 24 72 5d 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c $r].. }..} el
81b0: 73 65 20 7b 0a 09 20 20 20 20 23 20 6a 75 73 74 se {.. # just
81c0: 20 6d 61 72 6b 20 64 69 72 73 20 61 73 20 64 65 mark dirs as de
81d0: 6c 65 74 65 64 0a 09 20 20 20 20 73 65 74 20 63 leted.. set c
81e0: 6f 6e 74 65 6e 74 73 20 5b 67 65 74 64 69 72 20 ontents [getdir
81f0: 24 64 62 20 24 70 61 74 68 20 2a 5d 0a 09 20 20 $db $path *]..
8200: 20 20 69 66 20 7b 24 72 65 63 75 72 73 69 76 65 if {$recursive
8210: 7d 20 7b 0a 09 09 23 20 57 65 20 68 61 76 65 20 } {...# We have
8220: 74 6f 20 64 65 6c 65 74 65 20 74 68 65 73 65 20 to delete these
8230: 6d 61 6e 75 61 6c 6c 79 2c 20 65 6c 73 65 0a 09 manually, else..
8240: 09 23 20 74 68 65 79 20 28 6f 72 20 74 68 65 69 .# they (or thei
8250: 72 20 63 61 63 68 65 29 20 6d 61 79 20 63 6f 6e r cache) may con
8260: 66 6c 69 63 74 20 77 69 74 68 0a 09 09 23 20 73 flict with...# s
8270: 6f 6d 65 74 68 69 6e 67 20 6c 61 74 65 72 0a 09 omething later..
8280: 09 66 6f 72 65 61 63 68 20 66 20 24 63 6f 6e 74 .foreach f $cont
8290: 65 6e 74 73 20 7b 0a 09 09 20 20 20 20 64 65 6c ents {... del
82a0: 65 74 65 20 24 64 62 20 5b 66 69 6c 65 20 6a 6f ete $db [file jo
82b0: 69 6e 20 24 70 61 74 68 20 24 66 5d 20 24 72 65 in $path $f] $re
82c0: 63 75 72 73 69 76 65 0a 09 09 7d 0a 09 20 20 20 cursive...}..
82d0: 20 7d 20 65 6c 73 65 20 7b 0a 09 09 69 66 20 7b } else {...if {
82e0: 5b 6c 6c 65 6e 67 74 68 20 24 63 6f 6e 74 65 6e [llength $conten
82f0: 74 73 5d 7d 20 7b 0a 09 09 20 20 20 20 76 66 73 ts]} {... vfs
8300: 3a 3a 66 69 6c 65 73 79 73 74 65 6d 20 70 6f 73 ::filesystem pos
8310: 69 78 65 72 72 6f 72 20 24 3a 3a 76 66 73 3a 3a ixerror $::vfs::
8320: 70 6f 73 69 78 28 45 4e 4f 54 45 4d 50 54 59 29 posix(ENOTEMPTY)
8330: 0a 09 09 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 ...}.. }..
8340: 20 61 72 72 61 79 20 75 6e 73 65 74 20 76 3a 3a array unset v::
8350: 63 61 63 68 65 20 5c 0a 09 09 20 20 20 20 22 24 cache \... "$
8360: 64 62 2c 5b 72 65 61 64 6b 69 74 3a 3a 67 65 74 db,[readkit::get
8370: 20 24 73 62 28 69 6e 6f 29 20 70 61 72 65 6e 74 $sb(ino) parent
8380: 5d 2c 5b 66 69 6c 65 20 74 61 69 6c 20 24 70 61 ],[file tail $pa
8390: 74 68 5d 22 0a 09 20 20 20 20 0a 09 20 20 20 20 th]".. ..
83a0: 23 20 66 6c 61 67 20 77 69 74 68 20 2d 39 39 2c # flag with -99,
83b0: 20 62 65 63 61 75 73 65 20 70 61 72 65 6e 74 20 because parent
83c0: 2d 31 20 69 73 20 6e 6f 74 20 72 65 73 65 72 76 -1 is not reserv
83d0: 65 64 20 66 6f 72 20 74 68 65 20 72 6f 6f 74 20 ed for the root
83e0: 64 69 72 0a 09 20 20 20 20 23 20 64 65 6c 65 74 dir.. # delet
83f0: 65 64 20 65 6e 74 72 69 65 73 20 6e 65 76 65 72 ed entries never
8400: 20 67 65 74 20 72 65 2d 75 73 65 64 2c 20 73 68 get re-used, sh
8410: 6f 75 6c 64 20 62 65 20 63 6c 65 61 6e 65 64 20 ould be cleaned
8420: 75 70 20 6f 6e 65 20 64 61 79 0a 09 20 20 20 20 up one day..
8430: 72 65 61 64 6b 69 74 3a 3a 73 65 74 20 24 73 62 readkit::set $sb
8440: 28 69 6e 6f 29 20 70 61 72 65 6e 74 20 2d 39 39 (ino) parent -99
8450: 20 6e 61 6d 65 20 22 22 0a 09 20 20 20 20 23 20 name "".. #
8460: 67 65 74 20 72 69 64 20 6f 66 20 66 69 6c 65 20 get rid of file
8470: 65 6e 74 72 69 65 73 20 74 6f 20 72 65 6c 65 61 entries to relea
8480: 73 65 20 74 68 65 20 73 70 61 63 65 20 69 6e 20 se the space in
8490: 74 68 65 20 64 61 74 61 66 69 6c 65 0a 09 20 20 the datafile..
84a0: 20 20 72 65 61 64 6b 69 74 3a 3a 76 69 65 77 20 readkit::view
84b0: 73 69 7a 65 20 24 73 62 28 69 6e 6f 29 2e 66 69 size $sb(ino).fi
84c0: 6c 65 73 20 30 0a 09 7d 0a 09 73 65 74 75 70 43 les 0..}..setupC
84d0: 6f 6d 6d 69 74 73 20 24 64 62 0a 09 72 65 74 75 ommits $db..retu
84e0: 72 6e 20 22 22 0a 20 20 20 20 7d 0a 7d 0a 0a 70 rn "". }.}..p
84f0: 61 63 6b 61 67 65 20 70 72 6f 76 69 64 65 20 72 ackage provide r
8500: 65 61 64 6b 69 74 20 30 2e 38 0a 70 61 63 6b 61 eadkit 0.8.packa
8510: 67 65 20 70 72 6f 76 69 64 65 20 76 66 73 3a 3a ge provide vfs::
8520: 6d 6b 63 6c 20 32 2e 34 2e 30 2e 31 0a mkcl 2.4.0.1.