0000: 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d .;;=============
0010: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0020: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 43 6f 70 =========.;; Cop
0050: 79 72 69 67 68 74 20 32 30 31 37 2c 20 4d 61 74 yright 2017, Mat
0060: 74 68 65 77 20 57 65 6c 6c 61 6e 64 2e 0a 3b 3b thew Welland..;;
0070: 20 0a 3b 3b 20 54 68 69 73 20 66 69 6c 65 20 69 .;; This file i
0080: 73 20 70 61 72 74 20 6f 66 20 4d 65 67 61 74 65 s part of Megate
0090: 73 74 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d st..;; .;; M
00a0: 65 67 61 74 65 73 74 20 69 73 20 66 72 65 65 20 egatest is free
00b0: 73 6f 66 74 77 61 72 65 3a 20 79 6f 75 20 63 61 software: you ca
00c0: 6e 20 72 65 64 69 73 74 72 69 62 75 74 65 20 69 n redistribute i
00d0: 74 20 61 6e 64 2f 6f 72 20 6d 6f 64 69 66 79 0a t and/or modify.
00e0: 3b 3b 20 20 20 20 20 69 74 20 75 6e 64 65 72 20 ;; it under
00f0: 74 68 65 20 74 65 72 6d 73 20 6f 66 20 74 68 65 the terms of the
0100: 20 47 4e 55 20 47 65 6e 65 72 61 6c 20 50 75 62 GNU General Pub
0110: 6c 69 63 20 4c 69 63 65 6e 73 65 20 61 73 20 70 lic License as p
0120: 75 62 6c 69 73 68 65 64 20 62 79 0a 3b 3b 20 20 ublished by.;;
0130: 20 20 20 74 68 65 20 46 72 65 65 20 53 6f 66 74 the Free Soft
0140: 77 61 72 65 20 46 6f 75 6e 64 61 74 69 6f 6e 2c ware Foundation,
0150: 20 65 69 74 68 65 72 20 76 65 72 73 69 6f 6e 20 either version
0160: 33 20 6f 66 20 74 68 65 20 4c 69 63 65 6e 73 65 3 of the License
0170: 2c 20 6f 72 0a 3b 3b 20 20 20 20 20 28 61 74 20 , or.;; (at
0180: 79 6f 75 72 20 6f 70 74 69 6f 6e 29 20 61 6e 79 your option) any
0190: 20 6c 61 74 65 72 20 76 65 72 73 69 6f 6e 2e 0a later version..
01a0: 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d 65 67 61 74 ;; .;; Megat
01b0: 65 73 74 20 69 73 20 64 69 73 74 72 69 62 75 74 est is distribut
01c0: 65 64 20 69 6e 20 74 68 65 20 68 6f 70 65 20 74 ed in the hope t
01d0: 68 61 74 20 69 74 20 77 69 6c 6c 20 62 65 20 75 hat it will be u
01e0: 73 65 66 75 6c 2c 0a 3b 3b 20 20 20 20 20 62 75 seful,.;; bu
01f0: 74 20 57 49 54 48 4f 55 54 20 41 4e 59 20 57 41 t WITHOUT ANY WA
0200: 52 52 41 4e 54 59 3b 20 77 69 74 68 6f 75 74 20 RRANTY; without
0210: 65 76 65 6e 20 74 68 65 20 69 6d 70 6c 69 65 64 even the implied
0220: 20 77 61 72 72 61 6e 74 79 20 6f 66 0a 3b 3b 20 warranty of.;;
0230: 20 20 20 20 4d 45 52 43 48 41 4e 54 41 42 49 4c MERCHANTABIL
0240: 49 54 59 20 6f 72 20 46 49 54 4e 45 53 53 20 46 ITY or FITNESS F
0250: 4f 52 20 41 20 50 41 52 54 49 43 55 4c 41 52 20 OR A PARTICULAR
0260: 50 55 52 50 4f 53 45 2e 20 20 53 65 65 20 74 68 PURPOSE. See th
0270: 65 0a 3b 3b 20 20 20 20 20 47 4e 55 20 47 65 6e e.;; GNU Gen
0280: 65 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 eral Public Lice
0290: 6e 73 65 20 66 6f 72 20 6d 6f 72 65 20 64 65 74 nse for more det
02a0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 ails..;; .;;
02b0: 20 59 6f 75 20 73 68 6f 75 6c 64 20 68 61 76 65 You should have
02c0: 20 72 65 63 65 69 76 65 64 20 61 20 63 6f 70 79 received a copy
02d0: 20 6f 66 20 74 68 65 20 47 4e 55 20 47 65 6e 65 of the GNU Gene
02e0: 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e ral Public Licen
02f0: 73 65 0a 3b 3b 20 20 20 20 20 61 6c 6f 6e 67 20 se.;; along
0300: 77 69 74 68 20 4d 65 67 61 74 65 73 74 2e 20 20 with Megatest.
0310: 49 66 20 6e 6f 74 2c 20 73 65 65 20 3c 68 74 74 If not, see <htt
0320: 70 3a 2f 2f 77 77 77 2e 67 6e 75 2e 6f 72 67 2f p://www.gnu.org/
0330: 6c 69 63 65 6e 73 65 73 2f 3e 2e 0a 0a 3b 3b 3d licenses/>...;;=
0340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0380: 3d 3d 3d 3d 3d 0a 0a 28 64 65 63 6c 61 72 65 20 =====..(declare
0390: 28 75 6e 69 74 20 64 62 6d 6f 64 29 29 0a 28 64 (unit dbmod)).(d
03a0: 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 62 66 eclare (uses dbf
03b0: 69 6c 65 29 29 0a 28 64 65 63 6c 61 72 65 20 28 ile)).(declare (
03c0: 75 73 65 73 20 63 6f 6d 6d 6f 6e 6d 6f 64 29 29 uses commonmod))
03d0: 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 20 .(declare (uses
03e0: 64 65 62 75 67 70 72 69 6e 74 29 29 0a 0a 28 6d debugprint))..(m
03f0: 6f 64 75 6c 65 20 64 62 6d 6f 64 0a 09 2a 0a 09 odule dbmod..*..
0400: 0a 28 69 6d 70 6f 72 74 20 73 63 68 65 6d 65 0a .(import scheme.
0410: 09 63 68 69 63 6b 65 6e 0a 09 64 61 74 61 2d 73 .chicken..data-s
0420: 74 72 75 63 74 75 72 65 73 0a 09 65 78 74 72 61 tructures..extra
0430: 73 0a 09 66 69 6c 65 73 0a 0a 09 66 6f 72 6d 61 s..files...forma
0440: 74 0a 09 28 70 72 65 66 69 78 20 73 71 6c 69 74 t..(prefix sqlit
0450: 65 33 20 73 71 6c 69 74 65 33 3a 29 0a 09 6d 61 e3 sqlite3:)..ma
0460: 74 63 68 61 62 6c 65 0a 09 70 6f 73 69 78 0a 09 tchable..posix..
0470: 74 79 70 65 64 2d 72 65 63 6f 72 64 73 0a 09 73 typed-records..s
0480: 72 66 69 2d 31 0a 09 73 72 66 69 2d 31 38 0a 09 rfi-1..srfi-18..
0490: 73 72 66 69 2d 36 39 0a 0a 09 63 6f 6d 6d 6f 6e srfi-69...common
04a0: 6d 6f 64 0a 09 64 62 66 69 6c 65 0a 09 64 65 62 mod..dbfile..deb
04b0: 75 67 70 72 69 6e 74 0a 09 29 0a 0a 3b 3b 20 4e ugprint..)..;; N
04c0: 4f 54 45 3a 20 54 68 69 73 20 72 65 74 75 72 6e OTE: This return
04d0: 73 20 6f 6e 6c 79 20 74 68 65 20 6e 61 6d 65 20 s only the name
04e0: 22 31 2e 64 62 22 2c 20 22 6d 61 69 6e 2e 64 62 "1.db", "main.db
04f0: 22 2c 20 6e 6f 74 20 74 68 65 20 70 61 74 68 0a ", not the path.
0500: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 62 6d 6f ;;.(define (dbmo
0510: 64 3a 72 75 6e 2d 69 64 2d 3e 64 62 66 6e 61 6d d:run-id->dbfnam
0520: 65 20 72 75 6e 2d 69 64 29 0a 20 20 28 63 6f 6e e run-id). (con
0530: 63 20 28 64 62 66 69 6c 65 3a 72 75 6e 2d 69 64 c (dbfile:run-id
0540: 2d 3e 64 62 6e 75 6d 20 72 75 6e 2d 69 64 29 22 ->dbnum run-id)"
0550: 2e 64 62 22 29 29 0a 0a 28 64 65 66 69 6e 65 20 .db"))..(define
0560: 28 64 62 6d 6f 64 3a 67 65 74 2d 64 62 64 69 72 (dbmod:get-dbdir
0570: 20 64 62 73 74 72 75 63 74 29 0a 20 20 28 6c 65 dbstruct). (le
0580: 74 2a 20 28 28 61 72 65 61 70 61 74 68 20 28 64 t* ((areapath (d
0590: 62 72 3a 64 62 73 74 72 75 63 74 2d 61 72 65 61 br:dbstruct-area
05a0: 70 61 74 68 20 64 62 73 74 72 75 63 74 29 29 0a path dbstruct)).
05b0: 09 20 28 64 62 64 69 72 20 20 20 20 28 63 6f 6e . (dbdir (con
05c0: 63 20 61 72 65 61 70 61 74 68 22 2f 2e 6d 74 64 c areapath"/.mtd
05d0: 62 22 29 29 29 0a 20 20 20 20 28 69 66 20 28 61 b"))). (if (a
05e0: 6e 64 20 28 66 69 6c 65 2d 77 72 69 74 65 2d 61 nd (file-write-a
05f0: 63 63 65 73 73 3f 20 61 72 65 61 70 61 74 68 29 ccess? areapath)
0600: 0a 09 20 20 20 20 20 28 6e 6f 74 20 28 66 69 6c .. (not (fil
0610: 65 2d 65 78 69 73 74 73 3f 20 64 62 64 69 72 29 e-exists? dbdir)
0620: 29 29 0a 09 28 63 72 65 61 74 65 2d 64 69 72 65 ))..(create-dire
0630: 63 74 6f 72 79 20 64 62 64 69 72 29 29 0a 20 20 ctory dbdir)).
0640: 20 20 64 62 64 69 72 29 29 0a 0a 28 64 65 66 69 dbdir))..(defi
0650: 6e 65 20 28 64 62 6d 6f 64 3a 72 75 6e 2d 69 64 ne (dbmod:run-id
0660: 2d 3e 66 75 6c 6c 2d 64 62 66 6e 61 6d 65 20 64 ->full-dbfname d
0670: 62 73 74 72 75 63 74 20 72 75 6e 2d 69 64 29 0a bstruct run-id).
0680: 20 20 28 63 6f 6e 63 20 28 64 62 6d 6f 64 3a 67 (conc (dbmod:g
0690: 65 74 2d 64 62 64 69 72 20 64 62 73 74 72 75 63 et-dbdir dbstruc
06a0: 74 0a 0a 09 09 09 20 72 75 6e 2d 69 64 0a 0a 09 t..... run-id...
06b0: 09 09 20 29 22 2f 22 28 64 62 6d 6f 64 3a 72 75 .. )"/"(dbmod:ru
06c0: 6e 2d 69 64 2d 3e 64 62 66 6e 61 6d 65 20 72 75 n-id->dbfname ru
06d0: 6e 2d 69 64 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d n-id)))..;;=====
06e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0720: 3d 0a 3b 3b 20 52 65 61 64 2d 6f 6e 6c 79 20 63 =.;; Read-only c
0730: 61 63 68 65 64 62 20 63 61 63 68 65 64 20 64 69 achedb cached di
0740: 72 65 63 74 20 66 72 6f 6d 20 64 69 73 6b 20 6d rect from disk m
0750: 65 74 68 6f 64 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d ethod.;;========
0760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0790: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
07a0: 28 64 65 66 69 6e 65 20 2a 64 62 6d 6f 64 3a 6e (define *dbmod:n
07b0: 66 73 2d 64 62 2d 68 61 6e 64 6c 65 73 2a 20 28 fs-db-handles* (
07c0: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
07d0: 29 20 3b 3b 20 64 62 66 6e 61 6d 65 20 2d 3e 20 ) ;; dbfname ->
07e0: 64 62 73 74 72 75 63 74 0a 0a 3b 3b 20 63 61 6c dbstruct..;; cal
07f0: 6c 65 64 20 69 6e 20 72 6d 74 2e 73 63 6d 20 6e led in rmt.scm n
0800: 66 73 2d 74 72 61 6e 73 70 6f 72 74 2d 68 61 6e fs-transport-han
0810: 64 6c 65 72 0a 28 64 65 66 69 6e 65 20 28 64 62 dler.(define (db
0820: 6d 6f 64 3a 6e 66 73 2d 67 65 74 2d 64 62 73 74 mod:nfs-get-dbst
0830: 72 75 63 74 20 72 75 6e 2d 69 64 20 6b 65 79 73 ruct run-id keys
0840: 20 69 6e 69 74 2d 70 72 6f 63 20 61 72 65 61 70 init-proc areap
0850: 61 74 68 20 23 21 6b 65 79 20 28 74 6d 70 61 64 ath #!key (tmpad
0860: 6a 20 22 22 29 29 0a 20 20 28 61 73 73 65 72 74 j "")). (assert
0870: 20 61 72 65 61 70 61 74 68 20 22 46 41 54 41 4c areapath "FATAL
0880: 3a 20 64 62 6d 6f 64 3a 6e 66 73 2d 67 65 74 2d : dbmod:nfs-get-
0890: 64 62 73 74 72 75 63 74 20 63 61 6c 6c 65 64 20 dbstruct called
08a0: 77 69 74 68 6f 75 74 20 61 72 65 61 70 61 74 68 without areapath
08b0: 20 73 65 74 2e 22 29 0a 20 20 28 6c 65 74 2a 20 set."). (let*
08c0: 28 28 64 62 66 6e 61 6d 65 20 20 28 64 62 6d 6f ((dbfname (dbmo
08d0: 64 3a 72 75 6e 2d 69 64 2d 3e 64 62 66 6e 61 6d d:run-id->dbfnam
08e0: 65 20 72 75 6e 2d 69 64 29 29 0a 09 20 28 64 62 e run-id)).. (db
08f0: 73 74 72 75 63 74 20 28 68 61 73 68 2d 74 61 62 struct (hash-tab
0900: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 2a le-ref/default *
0910: 64 62 6d 6f 64 3a 6e 66 73 2d 64 62 2d 68 61 6e dbmod:nfs-db-han
0920: 64 6c 65 73 2a 20 64 62 66 6e 61 6d 65 20 23 66 dles* dbfname #f
0930: 29 29 29 0a 20 20 20 20 28 69 66 20 64 62 73 74 ))). (if dbst
0940: 72 75 63 74 0a 09 64 62 73 74 72 75 63 74 0a 09 ruct..dbstruct..
0950: 28 6c 65 74 2a 20 28 28 6e 65 77 64 62 73 74 72 (let* ((newdbstr
0960: 75 63 74 20 28 64 62 6d 6f 64 3a 6f 70 65 6e 2d uct (dbmod:open-
0970: 64 62 6d 6f 64 64 62 20 61 72 65 61 70 61 74 68 dbmoddb areapath
0980: 20 72 75 6e 2d 69 64 20 64 62 66 6e 61 6d 65 20 run-id dbfname
0990: 69 6e 69 74 2d 70 72 6f 63 20 6b 65 79 73 20 73 init-proc keys s
09a0: 79 6e 63 64 69 72 3a 20 27 66 72 6f 6d 64 69 73 yncdir: 'fromdis
09b0: 6b 20 74 6d 70 61 64 6a 3a 20 74 6d 70 61 64 6a k tmpadj: tmpadj
09c0: 29 29 29 0a 09 20 20 28 68 61 73 68 2d 74 61 62 ))).. (hash-tab
09d0: 6c 65 2d 73 65 74 21 20 2a 64 62 6d 6f 64 3a 6e le-set! *dbmod:n
09e0: 66 73 2d 64 62 2d 68 61 6e 64 6c 65 73 2a 20 64 fs-db-handles* d
09f0: 62 66 6e 61 6d 65 20 6e 65 77 64 62 73 74 72 75 bfname newdbstru
0a00: 63 74 29 0a 09 20 20 6e 65 77 64 62 73 74 72 75 ct).. newdbstru
0a10: 63 74 29 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d ct))))..;;======
0a20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a60: 0a 3b 3b 20 54 68 65 20 63 61 63 68 65 64 62 20 .;; The cachedb
0a70: 6f 6e 65 2d 64 62 20 66 69 6c 65 20 70 65 72 20 one-db file per
0a80: 73 65 72 76 65 72 20 6d 65 74 68 6f 64 20 67 6f server method go
0a90: 65 73 20 69 6e 20 68 65 72 65 0a 3b 3b 3d 3d 3d es in here.;;===
0aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ac0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ad0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ae0: 3d 3d 3d 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 74 68 ===..;; NOTE: th
0af0: 65 20 72 2f 77 20 69 73 20 6e 6f 77 20 77 2f 72 e r/w is now w/r
0b00: 2c 20 23 74 3d 64 62 20 6d 6f 64 69 66 69 65 64 , #t=db modified
0b10: 20 62 79 20 71 75 65 72 79 2c 20 23 66 3d 64 62 by query, #f=db
0b20: 20 4e 4f 54 20 6d 6f 64 69 66 69 65 64 20 62 79 NOT modified by
0b30: 20 71 75 65 72 79 0a 28 64 65 66 69 6e 65 20 28 query.(define (
0b40: 64 62 6d 6f 64 3a 77 69 74 68 2d 64 62 20 64 62 dbmod:with-db db
0b50: 73 74 72 75 63 74 20 72 75 6e 2d 69 64 20 77 2f struct run-id w/
0b60: 72 20 70 72 6f 63 20 70 61 72 61 6d 73 29 0a 20 r proc params).
0b70: 20 28 6c 65 74 2a 20 28 28 75 73 65 2d 6d 75 74 (let* ((use-mut
0b80: 65 78 20 77 2f 72 29 20 3b 3b 20 28 6f 72 20 28 ex w/r) ;; (or (
0b90: 61 6e 64 20 77 2f 72 20 3b 3b 20 75 73 65 20 74 and w/r ;; use t
0ba0: 68 65 20 6d 75 74 65 78 20 6f 6e 20 71 75 65 72 he mutex on quer
0bb0: 69 65 73 20 74 68 61 74 20 6d 6f 64 69 66 79 20 ies that modify
0bc0: 74 68 65 20 64 62 20 61 6e 64 20 66 6f 72 20 73 the db and for s
0bd0: 79 6e 63 20 74 6f 20 64 69 73 6b 0a 09 09 09 20 ync to disk....
0be0: 20 20 20 20 3b 3b 20 28 3e 20 2a 61 70 69 2d 70 ;; (> *api-p
0bf0: 72 6f 63 65 73 73 2d 72 65 71 75 65 73 74 2d 63 rocess-request-c
0c00: 6f 75 6e 74 2a 20 35 29 29 20 3b 3b 20 77 68 65 ount* 5)) ;; whe
0c10: 6e 20 77 72 69 74 65 73 20 61 72 65 20 68 61 70 n writes are hap
0c20: 70 65 6e 69 6e 67 20 74 68 72 6f 74 74 6c 65 20 pening throttle
0c30: 6d 6f 72 65 0a 09 09 09 3b 3b 20 28 3e 20 2a 61 more....;; (> *a
0c40: 70 69 2d 70 72 6f 63 65 73 73 2d 72 65 71 75 65 pi-process-reque
0c50: 73 74 2d 63 6f 75 6e 74 2a 20 35 30 29 29 29 0a st-count* 50))).
0c60: 09 20 28 64 62 64 61 74 20 20 20 20 20 28 64 62 . (dbdat (db
0c70: 6d 6f 64 3a 6f 70 65 6e 2d 64 62 20 64 62 73 74 mod:open-db dbst
0c80: 72 75 63 74 20 72 75 6e 2d 69 64 20 28 64 62 66 ruct run-id (dbf
0c90: 69 6c 65 3a 64 62 2d 69 6e 69 74 2d 70 72 6f 63 ile:db-init-proc
0ca0: 29 29 29 0a 09 20 28 64 62 68 20 20 20 20 20 20 ))).. (dbh
0cb0: 20 28 64 62 72 3a 64 62 64 61 74 2d 64 62 68 20 (dbr:dbdat-dbh
0cc0: 64 62 64 61 74 29 29 20 3b 3b 20 74 68 69 73 20 dbdat)) ;; this
0cd0: 77 69 6c 6c 20 62 65 20 74 68 65 20 63 61 63 68 will be the cach
0ce0: 65 64 62 20 68 61 6e 64 6c 65 0a 09 20 28 64 62 edb handle.. (db
0cf0: 66 69 6c 65 20 20 20 20 28 64 62 72 3a 64 62 64 file (dbr:dbd
0d00: 61 74 2d 64 62 66 69 6c 65 20 64 62 64 61 74 29 at-dbfile dbdat)
0d10: 29 29 0a 20 20 20 20 3b 3b 20 69 66 20 6e 66 73 )). ;; if nfs
0d20: 20 6d 6f 64 65 20 64 6f 20 61 20 73 79 6e 63 20 mode do a sync
0d30: 69 66 20 64 65 6c 74 61 20 3e 20 32 0a 20 20 20 if delta > 2.
0d40: 20 23 3b 28 6c 65 74 2a 20 28 28 6c 61 73 74 2d #;(let* ((last-
0d50: 75 70 64 61 74 65 20 28 64 62 72 3a 64 62 73 74 update (dbr:dbst
0d60: 72 75 63 74 2d 6c 61 73 74 2d 75 70 64 61 74 65 ruct-last-update
0d70: 20 64 62 73 74 72 75 63 74 29 29 0a 09 20 20 20 dbstruct))..
0d80: 3b 3b 20 28 73 79 6e 63 2d 70 72 6f 63 20 20 20 ;; (sync-proc
0d90: 28 64 62 72 3a 64 62 73 74 72 75 63 74 2d 73 79 (dbr:dbstruct-sy
0da0: 6e 63 2d 70 72 6f 63 20 64 62 73 74 72 75 63 74 nc-proc dbstruct
0db0: 29 29 0a 09 20 20 20 28 63 75 72 72 2d 73 65 63 )).. (curr-sec
0dc0: 73 20 20 20 28 63 75 72 72 65 6e 74 2d 73 65 63 s (current-sec
0dd0: 6f 6e 64 73 29 29 29 0a 20 20 20 20 20 20 28 69 onds))). (i
0de0: 66 20 28 3e 20 28 2d 20 63 75 72 72 2d 73 65 63 f (> (- curr-sec
0df0: 73 20 6c 61 73 74 2d 75 70 64 61 74 65 29 20 35 s last-update) 5
0e00: 29 0a 09 20 20 28 62 65 67 69 6e 0a 09 20 20 20 ).. (begin..
0e10: 20 28 73 79 6e 63 2d 70 72 6f 63 20 6c 61 73 74 (sync-proc last
0e20: 2d 75 70 64 61 74 65 29 0a 0a 09 20 20 20 20 3b -update)... ;
0e30: 3b 20 4d 4f 56 45 20 54 48 49 53 20 43 41 4c 4c ; MOVE THIS CALL
0e40: 20 54 4f 20 49 4e 53 49 44 45 20 54 48 45 20 73 TO INSIDE THE s
0e50: 79 6e 63 2d 70 72 6f 63 20 43 41 4c 4c 0a 09 20 ync-proc CALL..
0e60: 20 20 20 28 64 62 72 3a 64 62 73 74 72 75 63 74 (dbr:dbstruct
0e70: 2d 6c 61 73 74 2d 75 70 64 61 74 65 2d 73 65 74 -last-update-set
0e80: 21 20 64 62 73 74 72 75 63 74 20 63 75 72 72 2d ! dbstruct curr-
0e90: 73 65 63 73 29 0a 09 20 20 20 20 29 29 29 0a 20 secs).. ))).
0ea0: 20 20 20 28 61 73 73 65 72 74 20 28 73 71 6c 69 (assert (sqli
0eb0: 74 65 33 3a 64 61 74 61 62 61 73 65 3f 20 64 62 te3:database? db
0ec0: 68 29 20 22 46 41 54 41 4c 3a 20 62 61 64 20 64 h) "FATAL: bad d
0ed0: 62 20 68 61 6e 64 6c 65 20 69 6e 20 64 62 6d 6f b handle in dbmo
0ee0: 64 3a 77 69 74 68 2d 64 62 22 29 20 0a 20 20 20 d:with-db") .
0ef0: 20 28 69 66 20 75 73 65 2d 6d 75 74 65 78 20 28 (if use-mutex (
0f00: 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 64 62 2d mutex-lock! *db-
0f10: 77 69 74 68 2d 64 62 2d 6d 75 74 65 78 2a 29 29 with-db-mutex*))
0f20: 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 72 65 73 . (let* ((res
0f30: 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 63 6f 75 (let loop ((cou
0f40: 6e 74 20 33 29 29 0a 09 09 20 20 28 63 6f 6e 64 nt 3))... (cond
0f50: 69 74 69 6f 6e 2d 63 61 73 65 0a 09 09 20 20 20 ition-case...
0f60: 28 61 70 70 6c 79 20 70 72 6f 63 20 64 62 64 61 (apply proc dbda
0f70: 74 20 64 62 68 20 70 61 72 61 6d 73 29 0a 09 09 t dbh params)...
0f80: 20 20 20 28 65 78 6e 20 28 62 75 73 79 29 0a 09 (exn (busy)..
0f90: 09 09 28 69 66 20 28 3e 20 63 6f 75 6e 74 20 30 ..(if (> count 0
0fa0: 29 0a 09 09 09 20 20 20 20 28 62 65 67 69 6e 0a ).... (begin.
0fb0: 09 09 09 20 20 20 20 20 20 28 64 65 62 75 67 3a ... (debug:
0fc0: 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 print-info 0 *de
0fd0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
0fe0: 22 64 62 6d 6f 64 3a 77 69 74 68 2d 64 62 2c 20 "dbmod:with-db,
0ff0: 64 61 74 61 62 61 73 65 20 69 73 20 62 75 73 79 database is busy
1000: 2c 20 77 69 6c 6c 20 74 72 79 20 22 63 6f 75 6e , will try "coun
1010: 74 22 20 6d 6f 72 65 20 74 69 6d 65 73 2e 22 29 t" more times.")
1020: 0a 09 09 09 20 20 20 20 20 20 28 74 68 72 65 61 .... (threa
1030: 64 2d 73 6c 65 65 70 21 20 31 29 0a 09 09 09 20 d-sleep! 1)....
1040: 20 20 20 20 20 28 6c 6f 6f 70 20 28 2d 20 63 6f (loop (- co
1050: 75 6e 74 20 31 29 29 29 0a 09 09 09 20 20 20 20 unt 1)))....
1060: 28 62 65 67 69 6e 0a 09 09 09 20 20 20 20 20 20 (begin....
1070: 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 (debug:print-inf
1080: 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 o 0 *default-log
1090: 2d 70 6f 72 74 2a 20 22 64 62 6d 6f 64 3a 77 69 -port* "dbmod:wi
10a0: 74 68 2d 64 62 2c 20 64 61 74 61 62 61 73 65 20 th-db, database
10b0: 69 73 20 62 75 73 79 2c 20 67 69 76 69 6e 67 20 is busy, giving
10c0: 75 70 2e 22 29 0a 09 09 09 20 20 20 20 20 20 28 up.").... (
10d0: 65 78 69 74 20 31 29 29 29 29 0a 09 09 20 20 20 exit 1))))...
10e0: 28 65 78 6e 20 28 29 0a 09 09 09 28 64 62 66 69 (exn ()....(dbfi
10f0: 6c 65 3a 70 72 69 6e 74 2d 65 72 72 20 65 78 6e le:print-err exn
1100: 20 22 45 52 52 4f 52 3a 20 55 6e 6b 6e 6f 77 6e "ERROR: Unknown
1110: 20 65 72 72 6f 72 20 77 69 74 68 20 64 61 74 61 error with data
1120: 62 61 73 65 20 66 6f 72 20 72 75 6e 2d 69 64 20 base for run-id
1130: 22 72 75 6e 2d 69 64 22 2c 20 6d 65 73 73 61 67 "run-id", messag
1140: 65 3a 20 22 0a 09 09 09 09 09 20 20 28 28 63 6f e: "...... ((co
1150: 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 74 79 ndition-property
1160: 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e 20 27 -accessor 'exn '
1170: 6d 65 73 73 61 67 65 29 20 65 78 6e 29 29 0a 09 message) exn))..
1180: 09 09 28 65 78 69 74 20 32 29 29 29 29 29 29 0a ..(exit 2)))))).
1190: 20 20 20 20 20 20 28 69 66 20 75 73 65 2d 6d 75 (if use-mu
11a0: 74 65 78 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 tex (mutex-unloc
11b0: 6b 21 20 2a 64 62 2d 77 69 74 68 2d 64 62 2d 6d k! *db-with-db-m
11c0: 75 74 65 78 2a 29 29 0a 20 20 20 20 20 20 72 65 utex*)). re
11d0: 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 s)))..(define (d
11e0: 62 3a 77 69 74 68 2d 64 62 20 64 62 73 74 72 75 b:with-db dbstru
11f0: 63 74 20 72 75 6e 2d 69 64 20 77 2f 72 20 70 72 ct run-id w/r pr
1200: 6f 63 20 2e 20 70 61 72 61 6d 73 29 0a 20 20 28 oc . params). (
1210: 64 62 6d 6f 64 3a 77 69 74 68 2d 64 62 20 64 62 dbmod:with-db db
1220: 73 74 72 75 63 74 20 72 75 6e 2d 69 64 20 77 2f struct run-id w/
1230: 72 20 70 72 6f 63 20 70 61 72 61 6d 73 29 29 0a r proc params)).
1240: 0a 3b 3b 20 0a 28 64 65 66 69 6e 65 20 28 64 62 .;; .(define (db
1250: 6d 6f 64 3a 6f 70 65 6e 2d 63 61 63 68 65 64 62 mod:open-cachedb
1260: 2d 64 62 20 69 6e 69 74 2d 70 72 6f 63 20 64 62 -db init-proc db
1270: 66 75 6c 6c 6e 61 6d 65 29 0a 20 20 28 6c 65 74 fullname). (let
1280: 2a 20 28 28 64 62 20 20 20 20 20 20 28 69 66 20 * ((db (if
1290: 64 62 66 75 6c 6c 6e 61 6d 65 0a 09 09 20 20 20 dbfullname...
12a0: 20 20 20 28 64 62 6d 6f 64 3a 73 61 66 65 6c 79 (dbmod:safely
12b0: 2d 6f 70 65 6e 2d 64 62 20 64 62 66 75 6c 6c 6e -open-db dbfulln
12c0: 61 6d 65 20 69 6e 69 74 2d 70 72 6f 63 20 23 74 ame init-proc #t
12d0: 29 0a 09 09 20 20 20 20 20 20 28 73 71 6c 69 74 )... (sqlit
12e0: 65 33 3a 6f 70 65 6e 2d 64 61 74 61 62 61 73 65 e3:open-database
12f0: 20 22 3a 6d 65 6d 6f 72 79 3a 22 29 29 29 0a 09 ":memory:")))..
1300: 20 28 68 61 6e 64 6c 65 72 20 28 73 71 6c 69 74 (handler (sqlit
1310: 65 33 3a 6d 61 6b 65 2d 62 75 73 79 2d 74 69 6d e3:make-busy-tim
1320: 65 6f 75 74 20 31 33 36 30 30 30 29 29 29 0a 20 eout 136000))).
1330: 20 20 20 28 73 71 6c 69 74 65 33 3a 73 65 74 2d (sqlite3:set-
1340: 62 75 73 79 2d 68 61 6e 64 6c 65 72 21 20 64 62 busy-handler! db
1350: 20 68 61 6e 64 6c 65 72 29 0a 20 20 20 20 28 69 handler). (i
1360: 6e 69 74 2d 70 72 6f 63 20 64 62 29 0a 20 20 20 nit-proc db).
1370: 20 64 62 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 db))..(define (
1380: 64 62 6d 6f 64 3a 6f 70 65 6e 2d 64 62 20 64 62 dbmod:open-db db
1390: 73 74 72 75 63 74 20 72 75 6e 2d 69 64 20 64 62 struct run-id db
13a0: 69 6e 69 74 29 0a 20 20 28 6f 72 20 28 64 62 72 init). (or (dbr
13b0: 3a 64 62 73 74 72 75 63 74 2d 64 62 64 61 74 20 :dbstruct-dbdat
13c0: 64 62 73 74 72 75 63 74 29 0a 20 20 20 20 20 20 dbstruct).
13d0: 28 6c 65 74 2a 20 28 28 64 62 64 61 74 20 28 6d (let* ((dbdat (m
13e0: 61 6b 65 2d 64 62 72 3a 64 62 64 61 74 0a 09 09 ake-dbr:dbdat...
13f0: 20 20 20 20 20 64 62 66 69 6c 65 3a 20 28 64 62 dbfile: (db
1400: 72 3a 64 62 73 74 72 75 63 74 2d 64 62 66 69 6c r:dbstruct-dbfil
1410: 65 20 64 62 73 74 72 75 63 74 29 0a 09 09 20 20 e dbstruct)...
1420: 20 20 20 64 62 68 3a 20 20 20 20 28 64 62 72 3a dbh: (dbr:
1430: 64 62 73 74 72 75 63 74 2d 63 61 63 68 65 64 62 dbstruct-cachedb
1440: 20 20 64 62 73 74 72 75 63 74 29 0a 09 09 20 20 dbstruct)...
1450: 20 20 20 29 29 29 0a 09 28 64 62 72 3a 64 62 73 )))..(dbr:dbs
1460: 74 72 75 63 74 2d 64 62 64 61 74 2d 73 65 74 21 truct-dbdat-set!
1470: 20 64 62 73 74 72 75 63 74 20 64 62 64 61 74 29 dbstruct dbdat)
1480: 0a 09 64 62 64 61 74 29 29 29 0a 0a 3b 3b 20 4e ..dbdat)))..;; N
1490: 4f 54 20 55 53 45 44 3f 0a 28 64 65 66 69 6e 65 OT USED?.(define
14a0: 20 28 64 62 6d 6f 64 3a 6e 65 65 64 2d 6f 6e 2d (dbmod:need-on-
14b0: 64 69 73 6b 2d 64 62 2d 68 61 6e 64 6c 65 29 0a disk-db-handle).
14c0: 20 20 20 20 28 63 61 73 65 20 28 64 62 66 69 6c (case (dbfil
14d0: 65 3a 63 61 63 68 65 2d 6d 65 74 68 6f 64 29 0a e:cache-method).
14e0: 20 20 20 20 20 20 28 28 6e 6f 6e 65 20 74 6d 70 ((none tmp
14f0: 29 20 23 74 29 0a 20 20 20 20 20 20 28 28 63 61 ) #t). ((ca
1500: 63 68 65 64 62 29 0a 20 20 20 20 20 20 20 28 63 chedb). (c
1510: 61 73 65 20 28 64 62 66 69 6c 65 3a 73 79 6e 63 ase (dbfile:sync
1520: 2d 6d 65 74 68 6f 64 29 0a 09 20 28 28 6f 72 69 -method).. ((ori
1530: 67 69 6e 61 6c 29 20 23 74 29 0a 09 20 28 28 61 ginal) #t).. ((a
1540: 74 74 61 63 68 29 20 20 20 23 74 29 20 3b 3b 20 ttach) #t) ;;
1550: 77 65 20 6e 65 65 64 20 69 74 20 74 6f 20 66 6f we need it to fo
1560: 72 63 65 20 63 72 65 61 74 69 6f 6e 20 6f 66 20 rce creation of
1570: 74 68 65 20 6f 6e 2d 64 69 73 6b 20 66 69 6c 65 the on-disk file
1580: 20 2d 20 46 49 58 4d 45 0a 09 20 28 65 6c 73 65 - FIXME.. (else
1590: 0a 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 .. (debug:print
15a0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
15b0: 70 6f 72 74 2a 20 22 55 6e 6b 6e 6f 77 6e 20 64 port* "Unknown d
15c0: 62 66 69 6c 65 3a 73 79 6e 63 2d 6d 65 74 68 6f bfile:sync-metho
15d0: 64 20 73 65 74 74 69 6e 67 3a 20 22 0a 09 09 20 d setting: "...
15e0: 20 20 20 20 20 20 28 64 62 66 69 6c 65 3a 73 79 (dbfile:sy
15f0: 6e 63 2d 6d 65 74 68 6f 64 29 29 29 29 29 0a 20 nc-method))))).
1600: 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else.
1610: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
1620: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
1630: 72 74 2a 20 22 55 6e 6b 6e 6f 77 6e 20 64 62 66 rt* "Unknown dbf
1640: 69 6c 65 3a 63 61 63 68 65 2d 6d 65 74 68 6f 64 ile:cache-method
1650: 20 73 65 74 74 69 6e 67 3a 20 22 0a 09 09 20 20 setting: "...
1660: 20 20 28 64 62 66 69 6c 65 3a 63 61 63 68 65 2d (dbfile:cache-
1670: 6d 65 74 68 6f 64 29 29 0a 20 20 20 20 20 20 20 method)).
1680: 23 66 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 #f)))..(define (
1690: 64 62 6d 6f 64 3a 73 61 66 65 6c 79 2d 6f 70 65 dbmod:safely-ope
16a0: 6e 2d 64 62 20 64 62 66 75 6c 6c 6e 61 6d 65 20 n-db dbfullname
16b0: 69 6e 69 74 2d 70 72 6f 63 20 77 72 69 74 65 2d init-proc write-
16c0: 61 63 63 65 73 73 29 0a 20 20 28 64 62 66 69 6c access). (dbfil
16d0: 65 3a 77 69 74 68 2d 73 69 6d 70 6c 65 2d 66 69 e:with-simple-fi
16e0: 6c 65 2d 6c 6f 63 6b 0a 20 20 20 28 63 6f 6e 63 le-lock. (conc
16f0: 20 64 62 66 75 6c 6c 6e 61 6d 65 22 2e 6c 6f 63 dbfullname".loc
1700: 6b 22 29 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 k"). (lambda (
1710: 29 0a 20 20 20 20 20 28 6c 65 74 2a 20 28 28 64 ). (let* ((d
1720: 62 65 78 69 73 74 73 20 28 66 69 6c 65 2d 65 78 bexists (file-ex
1730: 69 73 74 73 3f 20 64 62 66 75 6c 6c 6e 61 6d 65 ists? dbfullname
1740: 29 29 0a 09 20 20 20 20 28 64 62 20 20 20 20 20 )).. (db
1750: 20 20 28 73 71 6c 69 74 65 33 3a 6f 70 65 6e 2d (sqlite3:open-
1760: 64 61 74 61 62 61 73 65 20 64 62 66 75 6c 6c 6e database dbfulln
1770: 61 6d 65 29 29 0a 09 20 20 20 20 28 68 61 6e 64 ame)).. (hand
1780: 6c 65 72 20 20 28 73 71 6c 69 74 65 33 3a 6d 61 ler (sqlite3:ma
1790: 6b 65 2d 62 75 73 79 2d 74 69 6d 65 6f 75 74 20 ke-busy-timeout
17a0: 31 33 36 30 30 30 29 29 29 0a 20 20 20 20 20 20 136000))).
17b0: 20 28 73 71 6c 69 74 65 33 3a 73 65 74 2d 62 75 (sqlite3:set-bu
17c0: 73 79 2d 68 61 6e 64 6c 65 72 21 20 64 62 20 68 sy-handler! db h
17d0: 61 6e 64 6c 65 72 29 0a 20 20 20 20 20 20 20 28 andler). (
17e0: 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 64 62 65 if (and (not dbe
17f0: 78 69 73 74 73 29 0a 09 09 77 72 69 74 65 2d 61 xists)...write-a
1800: 63 63 65 73 73 29 0a 09 20 20 20 28 69 6e 69 74 ccess).. (init
1810: 2d 70 72 6f 63 20 64 62 29 29 0a 20 20 20 20 20 -proc db)).
1820: 20 20 64 62 29 29 0a 20 20 20 72 75 6e 2d 61 6e db)). run-an
1830: 79 77 61 79 3a 20 23 74 29 29 0a 0a 28 64 65 66 yway: #t))..(def
1840: 69 6e 65 20 2a 73 79 6e 63 2d 69 6e 2d 70 72 6f ine *sync-in-pro
1850: 67 72 65 73 73 2a 20 23 66 29 0a 0a 3b 3b 20 4f gress* #f)..;; O
1860: 70 65 6e 20 74 68 65 20 63 61 63 68 65 64 62 20 pen the cachedb
1870: 64 62 20 61 6e 64 20 74 68 65 20 6f 6e 2d 64 69 db and the on-di
1880: 73 6b 20 64 62 0a 3b 3b 20 70 6f 70 75 6c 61 74 sk db.;; populat
1890: 65 20 74 68 65 20 63 61 63 68 65 64 62 20 64 62 e the cachedb db
18a0: 20 77 69 74 68 20 64 61 74 61 0a 3b 3b 0a 3b 3b with data.;;.;;
18b0: 20 55 70 64 61 74 65 73 20 66 69 65 6c 64 73 20 Updates fields
18c0: 69 6e 20 64 62 73 74 72 75 63 74 0a 3b 3b 20 52 in dbstruct.;; R
18d0: 65 74 75 72 6e 73 20 64 62 73 74 72 75 63 74 0a eturns dbstruct.
18e0: 3b 3b 0a 3b 3b 20 2a 20 54 68 69 73 20 72 6f 75 ;;.;; * This rou
18f0: 74 69 6e 65 20 63 72 65 61 74 65 73 20 74 68 65 tine creates the
1900: 20 64 62 20 69 66 20 6e 6f 74 20 66 6f 75 6e 64 db if not found
1910: 0a 3b 3b 20 2a 20 50 72 6f 62 61 62 6c 79 20 63 .;; * Probably c
1920: 61 6e 20 67 65 74 20 72 69 64 20 6f 66 20 74 68 an get rid of th
1930: 65 20 64 62 73 74 72 75 63 74 2d 69 6e 0a 3b 3b e dbstruct-in.;;
1940: 20 0a 28 64 65 66 69 6e 65 20 28 64 62 6d 6f 64 .(define (dbmod
1950: 3a 6f 70 65 6e 2d 64 62 6d 6f 64 64 62 20 61 72 :open-dbmoddb ar
1960: 65 61 70 61 74 68 20 72 75 6e 2d 69 64 20 64 62 eapath run-id db
1970: 66 6e 61 6d 65 2d 69 6e 20 69 6e 69 74 2d 70 72 fname-in init-pr
1980: 6f 63 20 6b 65 79 73 0a 09 09 09 20 20 20 20 23 oc keys.... #
1990: 21 6b 65 79 20 28 64 62 73 74 72 75 63 74 2d 69 !key (dbstruct-i
19a0: 6e 20 23 66 29 0a 09 09 09 20 20 20 20 3b 3b 20 n #f).... ;;
19b0: 28 64 62 63 6f 6e 74 65 78 74 20 27 6d 65 67 61 (dbcontext 'mega
19c0: 74 65 73 74 29 20 3b 3b 20 75 73 65 20 64 61 73 test) ;; use das
19d0: 68 62 6f 61 72 64 20 74 6f 20 64 6f 20 74 68 65 hboard to do the
19e0: 20 64 61 73 68 62 6f 61 72 64 0a 09 09 09 20 20 dashboard....
19f0: 20 20 28 74 6d 70 61 64 6a 20 20 22 22 29 20 20 (tmpadj "")
1a00: 20 20 20 20 20 3b 3b 20 61 64 64 20 74 6f 20 74 ;; add to t
1a10: 6d 70 20 70 61 74 68 0a 09 09 09 20 20 20 20 28 mp path.... (
1a20: 73 79 6e 63 64 69 72 20 27 74 6f 64 69 73 6b 29 syncdir 'todisk)
1a30: 29 20 3b 3b 20 74 6f 64 69 73 6b 20 69 73 20 75 ) ;; todisk is u
1a40: 73 65 64 20 77 68 65 6e 20 63 61 63 68 69 6e 67 sed when caching
1a50: 20 69 6e 20 2f 74 6d 70 20 61 6e 64 20 77 72 69 in /tmp and wri
1a60: 74 69 6e 67 20 64 61 74 61 20 62 61 63 6b 20 74 ting data back t
1a70: 6f 20 4d 54 52 41 48 0a 20 20 28 6c 65 74 2a 20 o MTRAH. (let*
1a80: 28 28 64 62 73 74 72 75 63 74 20 20 20 20 20 28 ((dbstruct (
1a90: 6f 72 20 64 62 73 74 72 75 63 74 2d 69 6e 20 28 or dbstruct-in (
1aa0: 6d 61 6b 65 2d 64 62 72 3a 64 62 73 74 72 75 63 make-dbr:dbstruc
1ab0: 74 20 61 72 65 61 70 61 74 68 3a 20 61 72 65 61 t areapath: area
1ac0: 70 61 74 68 29 29 29 0a 09 20 28 64 62 66 6e 61 path))).. (dbfna
1ad0: 6d 65 20 20 20 20 20 20 28 6f 72 20 64 62 66 6e me (or dbfn
1ae0: 61 6d 65 2d 69 6e 20 28 64 62 6d 6f 64 3a 72 75 ame-in (dbmod:ru
1af0: 6e 2d 69 64 2d 3e 64 62 66 6e 61 6d 65 20 72 75 n-id->dbfname ru
1b00: 6e 2d 69 64 29 29 29 0a 09 20 28 64 62 70 61 74 n-id))).. (dbpat
1b10: 68 20 20 20 20 20 20 20 28 64 62 6d 6f 64 3a 67 h (dbmod:g
1b20: 65 74 2d 64 62 64 69 72 20 64 62 73 74 72 75 63 et-dbdir dbstruc
1b30: 74 29 29 20 20 20 20 20 20 20 20 20 20 20 20 20 t))
1b40: 3b 3b 20 64 69 72 65 63 74 6f 72 79 20 77 68 65 ;; directory whe
1b50: 72 65 20 61 6c 6c 20 74 68 65 20 2e 64 62 20 66 re all the .db f
1b60: 69 6c 65 73 20 61 72 65 20 6b 65 70 74 0a 09 20 iles are kept..
1b70: 28 64 62 66 75 6c 6c 6e 61 6d 65 20 20 20 28 63 (dbfullname (c
1b80: 6f 6e 63 20 64 62 70 61 74 68 22 2f 22 64 62 66 onc dbpath"/"dbf
1b90: 6e 61 6d 65 29 29 20 3b 3b 20 28 64 62 6d 6f 64 name)) ;; (dbmod
1ba0: 3a 72 75 6e 2d 69 64 2d 3e 66 75 6c 6c 2d 64 62 :run-id->full-db
1bb0: 66 6e 61 6d 65 20 64 62 73 74 72 75 63 74 20 72 fname dbstruct r
1bc0: 75 6e 2d 69 64 29 29 0a 09 20 28 64 62 65 78 69 un-id)).. (dbexi
1bd0: 73 74 73 20 20 20 20 20 28 66 69 6c 65 2d 65 78 sts (file-ex
1be0: 69 73 74 73 3f 20 64 62 66 75 6c 6c 6e 61 6d 65 ists? dbfullname
1bf0: 29 29 0a 09 20 28 74 6d 70 64 69 72 20 20 20 20 )).. (tmpdir
1c00: 20 20 20 28 63 6f 6d 6d 6f 6e 3a 6d 61 6b 65 2d (common:make-
1c10: 74 6d 70 64 69 72 2d 6e 61 6d 65 20 61 72 65 61 tmpdir-name area
1c20: 70 61 74 68 20 74 6d 70 61 64 6a 29 29 0a 09 20 path tmpadj))..
1c30: 28 74 6d 70 64 62 20 20 20 20 20 20 20 20 28 6c (tmpdb (l
1c40: 65 74 2a 20 28 28 66 6e 61 6d 65 20 28 63 6f 6e et* ((fname (con
1c50: 63 20 74 6d 70 64 69 72 22 2f 22 64 62 66 6e 61 c tmpdir"/"dbfna
1c60: 6d 65 29 29 29 0a 09 09 09 20 66 6e 61 6d 65 29 me))).... fname)
1c70: 29 0a 09 20 28 63 61 63 68 65 64 62 20 20 20 20 ).. (cachedb
1c80: 20 20 20 20 28 64 62 6d 6f 64 3a 6f 70 65 6e 2d (dbmod:open-
1c90: 63 61 63 68 65 64 62 2d 64 62 20 69 6e 69 74 2d cachedb-db init-
1ca0: 70 72 6f 63 0a 09 09 09 09 09 20 20 20 20 3b 3b proc...... ;;
1cb0: 20 28 69 66 20 28 65 71 3f 20 28 64 62 66 69 6c (if (eq? (dbfil
1cc0: 65 3a 63 61 63 68 65 2d 6d 65 74 68 6f 64 29 20 e:cache-method)
1cd0: 27 63 61 63 68 65 64 62 29 0a 09 09 09 09 09 20 'cachedb)......
1ce0: 20 20 20 3b 3b 20 09 23 66 0a 09 09 09 09 09 20 ;; .#f......
1cf0: 20 20 20 74 6d 70 64 62 0a 09 09 09 09 09 20 20 tmpdb......
1d00: 20 20 3b 3b 20 29 0a 09 09 09 09 09 20 20 20 20 ;; )......
1d10: 29 29 0a 09 20 28 77 72 69 74 65 2d 61 63 63 65 )).. (write-acce
1d20: 73 73 20 28 66 69 6c 65 2d 77 72 69 74 65 2d 61 ss (file-write-a
1d30: 63 63 65 73 73 3f 20 64 62 70 61 74 68 29 29 0a ccess? dbpath)).
1d40: 09 20 28 64 62 20 20 20 20 20 20 20 20 20 20 20 . (db
1d50: 28 64 62 6d 6f 64 3a 73 61 66 65 6c 79 2d 6f 70 (dbmod:safely-op
1d60: 65 6e 2d 64 62 20 64 62 66 75 6c 6c 6e 61 6d 65 en-db dbfullname
1d70: 20 69 6e 69 74 2d 70 72 6f 63 20 77 72 69 74 65 init-proc write
1d80: 2d 61 63 63 65 73 73 29 29 0a 09 20 28 74 61 62 -access)).. (tab
1d90: 6c 65 73 20 20 20 20 20 20 20 28 64 62 3a 73 79 les (db:sy
1da0: 6e 63 2d 61 6c 6c 2d 74 61 62 6c 65 73 2d 6c 69 nc-all-tables-li
1db0: 73 74 20 6b 65 79 73 29 29 29 0a 20 20 20 20 28 st keys))). (
1dc0: 69 66 20 28 6e 6f 74 20 28 61 6e 64 20 28 73 71 if (not (and (sq
1dd0: 6c 69 74 65 33 3a 64 61 74 61 62 61 73 65 3f 20 lite3:database?
1de0: 63 61 63 68 65 64 62 29 0a 09 09 20 20 28 73 71 cachedb)... (sq
1df0: 6c 69 74 65 33 3a 64 61 74 61 62 61 73 65 3f 20 lite3:database?
1e00: 64 62 29 29 29 0a 09 28 62 65 67 69 6e 0a 09 20 db)))..(begin..
1e10: 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 (debug:print 0
1e20: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
1e30: 74 2a 20 22 45 52 52 4f 52 3a 20 46 61 69 6c 65 t* "ERROR: Faile
1e40: 64 20 74 6f 20 70 72 6f 70 65 72 6c 79 20 6f 70 d to properly op
1e50: 65 6e 20 22 64 62 66 6e 61 6d 65 2d 69 6e 22 2c en "dbfname-in",
1e60: 20 65 78 69 74 69 6e 67 20 69 6d 6d 65 64 69 61 exiting immedia
1e70: 74 65 6c 79 2e 22 29 0a 09 20 20 28 65 78 69 74 tely.").. (exit
1e80: 29 29 29 20 20 20 20 3b 3b 20 28 61 73 73 65 72 ))) ;; (asser
1e90: 74 20 28 73 71 6c 69 74 65 33 3a 64 61 74 61 62 t (sqlite3:datab
1ea0: 61 73 65 3f 20 63 61 63 68 65 64 62 29 20 22 46 ase? cachedb) "F
1eb0: 41 54 41 4c 3a 20 6f 70 65 6e 2d 64 62 6d 6f 64 ATAL: open-dbmod
1ec0: 64 62 3a 20 63 61 63 68 65 64 62 20 69 73 20 6e db: cachedb is n
1ed0: 6f 74 20 61 20 64 62 22 29 0a 20 20 20 20 3b 3b ot a db"). ;;
1ee0: 20 28 61 73 73 65 72 74 20 28 73 71 6c 69 74 65 (assert (sqlite
1ef0: 33 3a 64 61 74 61 62 61 73 65 3f 20 64 62 29 20 3:database? db)
1f00: 22 46 41 54 41 4c 3a 20 20 6f 70 65 6e 2d 64 62 "FATAL: open-db
1f10: 6d 6f 64 64 62 3a 20 64 62 20 69 73 20 6e 6f 74 moddb: db is not
1f20: 20 61 20 64 62 22 29 0a 20 20 20 20 28 64 62 72 a db"). (dbr
1f30: 3a 64 62 73 74 72 75 63 74 2d 63 61 63 68 65 64 :dbstruct-cached
1f40: 62 2d 73 65 74 21 20 20 20 20 20 64 62 73 74 72 b-set! dbstr
1f50: 75 63 74 20 63 61 63 68 65 64 62 29 0a 20 20 20 uct cachedb).
1f60: 20 28 64 62 72 3a 64 62 73 74 72 75 63 74 2d 6f (dbr:dbstruct-o
1f70: 6e 64 69 73 6b 64 62 2d 73 65 74 21 20 20 64 62 ndiskdb-set! db
1f80: 73 74 72 75 63 74 20 64 62 29 0a 20 20 20 20 28 struct db). (
1f90: 64 62 72 3a 64 62 73 74 72 75 63 74 2d 64 62 66 dbr:dbstruct-dbf
1fa0: 69 6c 65 2d 73 65 74 21 20 20 20 20 64 62 73 74 ile-set! dbst
1fb0: 72 75 63 74 20 64 62 66 75 6c 6c 6e 61 6d 65 29 ruct dbfullname)
1fc0: 0a 20 20 20 20 28 64 62 72 3a 64 62 73 74 72 75 . (dbr:dbstru
1fd0: 63 74 2d 64 62 74 6d 70 6e 61 6d 65 2d 73 65 74 ct-dbtmpname-set
1fe0: 21 20 64 62 73 74 72 75 63 74 20 74 6d 70 64 62 ! dbstruct tmpdb
1ff0: 29 0a 20 20 20 20 28 64 62 72 3a 64 62 73 74 72 ). (dbr:dbstr
2000: 75 63 74 2d 64 62 66 6e 61 6d 65 2d 73 65 74 21 uct-dbfname-set!
2010: 20 20 20 64 62 73 74 72 75 63 74 20 64 62 66 6e dbstruct dbfn
2020: 61 6d 65 29 0a 20 20 20 20 28 64 62 72 3a 64 62 ame). (dbr:db
2030: 73 74 72 75 63 74 2d 73 79 6e 63 2d 70 72 6f 63 struct-sync-proc
2040: 2d 73 65 74 21 20 64 62 73 74 72 75 63 74 0a 09 -set! dbstruct..
2050: 09 09 09 20 28 6c 61 6d 62 64 61 20 28 6c 61 73 ... (lambda (las
2060: 74 2d 75 70 64 61 74 65 29 0a 09 09 09 09 20 20 t-update).....
2070: 20 28 69 66 20 2a 73 79 6e 63 2d 69 6e 2d 70 72 (if *sync-in-pr
2080: 6f 67 72 65 73 73 2a 0a 09 09 09 09 20 20 20 20 ogress*.....
2090: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
20a0: 33 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 3 *default-log-p
20b0: 6f 72 74 2a 20 22 57 41 52 4e 49 4e 47 3a 20 6f ort* "WARNING: o
20c0: 76 65 72 6c 61 70 70 69 6e 67 20 63 61 6c 6c 73 verlapping calls
20d0: 20 74 6f 20 73 79 6e 63 20 74 6f 20 64 69 73 6b to sync to disk
20e0: 22 29 0a 09 09 09 09 20 20 20 20 20 20 20 28 62 ")..... (b
20f0: 65 67 69 6e 0a 09 09 09 09 09 20 3b 3b 20 74 75 egin...... ;; tu
2100: 72 6e 20 6f 66 66 20 77 72 69 74 65 73 20 2d 20 rn off writes -
2110: 73 65 6e 64 20 62 75 73 79 20 6f 72 20 62 6c 6f send busy or blo
2120: 63 6b 3f 0a 09 09 09 09 09 20 3b 3b 20 63 61 6c ck?...... ;; cal
2130: 6c 20 64 62 32 64 62 20 69 6e 74 65 72 6e 61 6c l db2db internal
2140: 6c 79 0a 09 09 09 09 09 20 3b 3b 20 74 75 72 6e ly...... ;; turn
2150: 20 77 72 69 74 65 73 20 62 61 63 6b 20 6f 6e 0a writes back on.
2160: 09 09 09 09 09 20 3b 3b 0a 09 09 09 09 09 20 28 ..... ;;...... (
2170: 73 65 74 21 20 2a 61 70 69 2d 68 61 6c 74 2d 77 set! *api-halt-w
2180: 72 69 74 65 73 2a 20 23 74 29 20 3b 3b 20 64 6f rites* #t) ;; do
2190: 20 77 65 20 6e 65 65 64 20 61 20 6d 75 74 65 78 we need a mutex
21a0: 3f 0a 09 09 09 09 09 20 3b 3b 20 28 64 62 6d 6f ?...... ;; (dbmo
21b0: 64 3a 64 62 2d 74 6f 2d 64 62 2d 73 79 6e 63 20 d:db-to-db-sync
21c0: 73 72 63 2d 64 62 20 64 65 73 74 2d 64 62 20 6c src-db dest-db l
21d0: 61 73 74 2d 75 70 64 61 74 65 20 28 64 62 66 69 ast-update (dbfi
21e0: 6c 65 3a 64 62 2d 69 6e 69 74 2d 70 72 6f 63 29 le:db-init-proc)
21f0: 20 6b 65 79 73 29 0a 09 09 09 09 09 20 28 64 65 keys)...... (de
2200: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 bug:print-info 2
2210: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
2220: 72 74 2a 20 22 49 6e 74 65 72 6e 61 6c 20 73 79 rt* "Internal sy
2230: 6e 63 20 72 75 6e 6e 69 6e 67 20 66 72 6f 6d 20 nc running from
2240: 22 74 6d 70 64 62 22 20 74 6f 20 22 64 62 66 75 "tmpdb" to "dbfu
2250: 6c 6c 6e 61 6d 65 29 0a 09 09 09 09 09 20 28 64 llname)...... (d
2260: 62 6d 6f 64 3a 64 62 2d 74 6f 2d 64 62 2d 73 79 bmod:db-to-db-sy
2270: 6e 63 20 74 6d 70 64 62 20 64 62 66 75 6c 6c 6e nc tmpdb dbfulln
2280: 61 6d 65 20 6c 61 73 74 2d 75 70 64 61 74 65 20 ame last-update
2290: 28 64 62 66 69 6c 65 3a 64 62 2d 69 6e 69 74 2d (dbfile:db-init-
22a0: 70 72 6f 63 29 20 6b 65 79 73 29 0a 09 09 09 09 proc) keys).....
22b0: 09 20 28 73 65 74 21 20 2a 61 70 69 2d 68 61 6c . (set! *api-hal
22c0: 74 2d 77 72 69 74 65 73 2a 20 23 66 29 0a 09 09 t-writes* #f)...
22d0: 09 09 09 20 29 29 29 29 0a 20 20 20 20 3b 3b 20 ... )))). ;;
22e0: 28 64 62 6d 6f 64 3a 73 79 6e 63 2d 74 61 62 6c (dbmod:sync-tabl
22f0: 65 73 20 74 61 62 6c 65 73 20 23 66 20 64 62 20 es tables #f db
2300: 63 61 63 68 65 64 62 29 0a 20 20 20 20 3b 3b 20 cachedb). ;;
2310: 0a 20 20 20 20 28 74 68 72 65 61 64 2d 73 6c 65 . (thread-sle
2320: 65 70 21 20 31 29 20 3b 3b 20 6c 65 74 20 74 68 ep! 1) ;; let th
2330: 69 6e 67 73 20 73 65 74 74 6c 65 20 62 65 66 6f ings settle befo
2340: 72 65 20 73 79 6e 63 69 6e 67 20 69 6e 20 6e 65 re syncing in ne
2350: 65 64 65 64 20 64 61 74 61 0a 20 20 20 20 28 64 eded data. (d
2360: 62 6d 6f 64 3a 73 79 6e 63 2d 67 61 73 6b 65 74 bmod:sync-gasket
2370: 20 74 61 62 6c 65 73 20 23 66 20 63 61 63 68 65 tables #f cache
2380: 64 62 20 64 62 20 64 62 66 75 6c 6c 6e 61 6d 65 db db dbfullname
2390: 20 27 66 72 6f 6d 64 65 73 74 20 6b 65 79 73 29 'fromdest keys)
23a0: 20 3b 3b 20 29 20 3b 3b 20 6c 6f 61 64 20 69 6e ;; ) ;; load in
23b0: 74 6f 20 63 61 63 68 65 64 62 0a 20 20 20 20 28 to cachedb. (
23c0: 64 62 72 3a 64 62 73 74 72 75 63 74 2d 6c 61 73 dbr:dbstruct-las
23d0: 74 2d 75 70 64 61 74 65 2d 73 65 74 21 20 64 62 t-update-set! db
23e0: 73 74 72 75 63 74 20 28 2b 20 28 63 75 72 72 65 struct (+ (curre
23f0: 6e 74 2d 73 65 63 6f 6e 64 73 29 20 2d 31 30 29 nt-seconds) -10)
2400: 29 20 3b 3b 20 73 68 6f 75 6c 64 20 74 68 69 73 ) ;; should this
2410: 20 62 65 20 6f 66 66 73 65 74 20 62 61 63 6b 20 be offset back
2420: 69 6e 20 74 69 6d 65 20 62 79 20 6f 6e 65 20 73 in time by one s
2430: 65 63 6f 6e 64 3f 0a 20 20 20 20 64 62 73 74 72 econd?. dbstr
2440: 75 63 74 29 29 0a 0a 3b 3b 20 20 20 20 28 69 66 uct))..;; (if
2450: 20 28 65 71 3f 20 73 79 6e 63 64 69 72 20 27 74 (eq? syncdir 't
2460: 6f 64 69 73 6b 29 20 3b 3b 20 73 79 6e 63 20 74 odisk) ;; sync t
2470: 6f 20 64 69 73 6b 20 6e 6f 72 6d 61 6c 6c 79 2c o disk normally,
2480: 20 73 79 6e 63 20 66 72 6f 6d 20 69 6e 20 64 61 sync from in da
2490: 73 68 62 6f 61 72 64 0a 3b 3b 20 20 20 20 20 20 shboard.;;
24a0: 20 20 28 64 62 6d 6f 64 3a 73 79 6e 63 2d 74 61 (dbmod:sync-ta
24b0: 62 6c 65 73 20 74 61 62 6c 65 73 20 6c 61 73 74 bles tables last
24c0: 2d 75 70 64 61 74 65 20 63 61 63 68 65 64 62 20 -update cachedb
24d0: 64 62 29 0a 3b 3b 20 20 20 20 20 20 20 20 28 64 db).;; (d
24e0: 62 6d 6f 64 3a 73 79 6e 63 2d 74 61 62 6c 65 73 bmod:sync-tables
24f0: 20 74 61 62 6c 65 73 20 6c 61 73 74 2d 75 70 64 tables last-upd
2500: 61 74 65 20 64 62 20 63 61 63 68 65 64 62 29 29 ate db cachedb))
2510: 29 29 0a 3b 3b 0a 3b 3b 20 64 69 72 65 63 74 69 )).;;.;; directi
2520: 6f 6e 3a 20 27 66 72 6f 6d 64 65 73 74 20 27 74 on: 'fromdest 't
2530: 6f 64 65 73 74 0a 3b 3b 0a 28 64 65 66 69 6e 65 odest.;;.(define
2540: 20 28 64 62 6d 6f 64 3a 73 79 6e 63 2d 67 61 73 (dbmod:sync-gas
2550: 6b 65 74 20 74 61 62 6c 65 73 20 6c 61 73 74 2d ket tables last-
2560: 75 70 64 61 74 65 20 63 61 63 68 65 64 62 20 64 update cachedb d
2570: 62 68 20 64 62 66 6e 61 6d 65 20 64 69 72 65 63 bh dbfname direc
2580: 74 69 6f 6e 20 6b 65 79 73 29 0a 20 20 28 61 73 tion keys). (as
2590: 73 65 72 74 20 28 73 71 6c 69 74 65 33 3a 64 61 sert (sqlite3:da
25a0: 74 61 62 61 73 65 3f 20 63 61 63 68 65 64 62 29 tabase? cachedb)
25b0: 20 22 46 41 54 41 4c 3a 20 73 79 6e 63 2d 67 61 "FATAL: sync-ga
25c0: 73 6b 65 74 3a 20 63 61 63 68 65 64 62 20 69 73 sket: cachedb is
25d0: 20 6e 6f 74 20 61 20 64 62 22 29 0a 20 20 28 61 not a db"). (a
25e0: 73 73 65 72 74 20 28 73 71 6c 69 74 65 33 3a 64 ssert (sqlite3:d
25f0: 61 74 61 62 61 73 65 3f 20 63 61 63 68 65 64 62 atabase? cachedb
2600: 29 20 22 46 41 54 41 4c 3a 20 73 79 6e 63 2d 67 ) "FATAL: sync-g
2610: 61 73 6b 65 74 3a 20 64 62 68 20 69 73 20 6e 6f asket: dbh is no
2620: 74 20 61 20 64 62 22 29 0a 20 20 28 64 65 62 75 t a db"). (debu
2630: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 2a g:print-info 2 *
2640: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
2650: 2a 20 22 64 62 6d 6f 64 3a 73 79 6e 63 2d 67 61 * "dbmod:sync-ga
2660: 73 6b 65 74 20 63 61 6c 6c 65 64 20 77 69 74 68 sket called with
2670: 20 73 79 6e 63 2d 6d 65 74 68 6f 64 3d 22 28 64 sync-method="(d
2680: 62 66 69 6c 65 3a 73 79 6e 63 2d 6d 65 74 68 6f bfile:sync-metho
2690: 64 29 29 0a 20 20 28 63 61 73 65 20 28 64 62 66 d)). (case (dbf
26a0: 69 6c 65 3a 73 79 6e 63 2d 6d 65 74 68 6f 64 29 ile:sync-method)
26b0: 0a 20 20 20 20 28 28 6e 6f 6e 65 29 20 23 66 29 . ((none) #f)
26c0: 0a 20 20 20 20 28 28 61 74 74 61 63 68 29 0a 20 . ((attach).
26d0: 20 20 20 20 28 64 62 6d 6f 64 3a 61 74 74 61 63 (dbmod:attac
26e0: 68 2d 73 79 6e 63 20 74 61 62 6c 65 73 20 63 61 h-sync tables ca
26f0: 63 68 65 64 62 20 64 62 66 6e 61 6d 65 20 64 69 chedb dbfname di
2700: 72 65 63 74 69 6f 6e 29 29 0a 20 20 20 20 28 28 rection)). ((
2710: 6e 65 77 73 79 6e 63 29 0a 20 20 20 20 20 28 64 newsync). (d
2720: 62 6d 6f 64 3a 6e 65 77 2d 73 79 6e 63 20 74 61 bmod:new-sync ta
2730: 62 6c 65 73 20 63 61 63 68 65 64 62 20 64 62 68 bles cachedb dbh
2740: 20 64 62 66 6e 61 6d 65 20 64 69 72 65 63 74 69 dbfname directi
2750: 6f 6e 29 29 0a 20 20 20 20 28 65 6c 73 65 20 3b on)). (else ;
2760: 3b 20 6f 72 69 67 69 6e 61 6c 0a 20 20 20 20 20 ; original.
2770: 28 63 61 73 65 20 64 69 72 65 63 74 69 6f 6e 0a (case direction.
2780: 20 20 20 20 20 20 20 28 28 74 6f 64 69 73 6b 29 ((todisk)
2790: 20 3b 3b 20 69 2e 65 2e 20 66 72 6f 6d 20 74 68 ;; i.e. from th
27a0: 65 20 63 61 63 68 65 20 64 62 20 74 6f 20 74 68 e cache db to th
27b0: 65 20 6d 74 72 61 68 20 64 62 0a 09 28 64 62 6d e mtrah db..(dbm
27c0: 6f 64 3a 73 79 6e 63 2d 74 61 62 6c 65 73 20 74 od:sync-tables t
27d0: 61 62 6c 65 73 20 6c 61 73 74 2d 75 70 64 61 74 ables last-updat
27e0: 65 20 6b 65 79 73 20 63 61 63 68 65 64 62 20 64 e keys cachedb d
27f0: 62 68 29 29 0a 20 20 20 20 20 20 20 28 65 6c 73 bh)). (els
2800: 65 0a 09 28 64 62 6d 6f 64 3a 73 79 6e 63 2d 74 e..(dbmod:sync-t
2810: 61 62 6c 65 73 20 74 61 62 6c 65 73 20 6c 61 73 ables tables las
2820: 74 2d 75 70 64 61 74 65 20 6b 65 79 73 20 64 62 t-update keys db
2830: 68 20 63 61 63 68 65 64 62 29 29 29 29 29 29 0a h cachedb)))))).
2840: 0a 28 64 65 66 69 6e 65 20 28 64 62 6d 6f 64 3a .(define (dbmod:
2850: 63 6c 6f 73 65 2d 64 62 20 64 62 73 74 72 75 63 close-db dbstruc
2860: 74 29 0a 20 20 3b 3b 20 64 6f 20 66 69 6e 61 6c t). ;; do final
2870: 20 73 79 6e 63 20 74 6f 20 64 69 73 6b 20 66 69 sync to disk fi
2880: 6c 65 0a 20 20 3b 3b 20 28 64 6f 2d 73 79 6e 63 le. ;; (do-sync
2890: 20 2e 2e 2e 29 0a 20 20 28 73 71 6c 69 74 65 33 ...). (sqlite3
28a0: 3a 66 69 6e 61 6c 69 7a 65 21 20 28 64 62 72 3a :finalize! (dbr:
28b0: 64 62 73 74 72 75 63 74 2d 6f 6e 64 69 73 6b 64 dbstruct-ondiskd
28c0: 62 20 64 62 73 74 72 75 63 74 29 29 29 0a 0a 3b b dbstruct)))..;
28d0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
28e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
28f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2910: 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 53 79 6e 63 20 =======.;; Sync
2920: 64 62 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d db.;;===========
2930: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2940: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2950: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
2960: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 ===========..(de
2970: 66 69 6e 65 20 28 64 62 6d 6f 64 3a 63 61 6c 63 fine (dbmod:calc
2980: 2d 75 73 65 2d 6c 61 73 74 2d 75 70 64 61 74 65 -use-last-update
2990: 20 68 61 73 2d 6c 61 73 74 2d 75 70 64 61 74 65 has-last-update
29a0: 20 66 69 65 6c 64 73 20 6c 61 73 74 2d 75 70 64 fields last-upd
29b0: 61 74 65 29 0a 20 20 28 63 6f 6e 64 0a 20 20 20 ate). (cond.
29c0: 28 28 61 6e 64 20 68 61 73 2d 6c 61 73 74 2d 75 ((and has-last-u
29d0: 70 64 61 74 65 0a 09 20 28 6d 65 6d 62 65 72 20 pdate.. (member
29e0: 22 6c 61 73 74 5f 75 70 64 61 74 65 22 20 66 69 "last_update" fi
29f0: 65 6c 64 73 29 29 0a 20 20 20 20 23 74 29 20 3b elds)). #t) ;
2a00: 3b 20 69 66 20 67 69 76 65 6e 20 61 20 6e 75 6d ; if given a num
2a10: 62 65 72 2c 20 6a 75 73 74 20 75 73 65 20 69 74 ber, just use it
2a20: 20 66 6f 72 20 61 6c 6c 20 66 69 65 6c 64 73 0a for all fields.
2a30: 20 20 20 28 28 6e 75 6d 62 65 72 3f 20 6c 61 73 ((number? las
2a40: 74 2d 75 70 64 61 74 65 29 20 23 66 29 20 3b 3b t-update) #f) ;;
2a50: 20 69 66 20 6e 6f 74 20 6d 61 74 63 68 65 64 20 if not matched
2a60: 66 69 72 73 74 20 65 6e 74 72 79 20 74 68 65 6e first entry then
2a70: 20 69 67 6e 6f 72 65 20 6c 61 73 74 2d 75 70 64 ignore last-upd
2a80: 61 74 65 20 66 6f 72 20 74 68 69 73 20 74 61 62 ate for this tab
2a90: 6c 65 0a 20 20 20 28 28 61 6e 64 20 28 70 61 69 le. ((and (pai
2aa0: 72 3f 20 6c 61 73 74 2d 75 70 64 61 74 65 29 0a r? last-update).
2ab0: 09 20 28 6d 65 6d 62 65 72 20 28 63 61 72 20 6c . (member (car l
2ac0: 61 73 74 2d 75 70 64 61 74 65 29 20 20 20 20 3b ast-update) ;
2ad0: 3b 20 6c 61 73 74 2d 75 70 64 61 74 65 20 66 69 ; last-update fi
2ae0: 65 6c 64 20 6e 61 6d 65 0a 09 09 20 28 6d 61 70 eld name... (map
2af0: 20 63 61 72 20 66 69 65 6c 64 73 29 29 29 0a 20 car fields))).
2b00: 20 20 20 23 74 29 0a 20 20 20 28 28 61 6e 64 20 #t). ((and
2b10: 6c 61 73 74 2d 75 70 64 61 74 65 20 28 6e 6f 74 last-update (not
2b20: 20 28 70 61 69 72 3f 20 6c 61 73 74 2d 75 70 64 (pair? last-upd
2b30: 61 74 65 29 29 20 28 6e 6f 74 20 28 6e 75 6d 62 ate)) (not (numb
2b40: 65 72 3f 20 6c 61 73 74 2d 75 70 64 61 74 65 29 er? last-update)
2b50: 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a 70 72 )). (debug:pr
2b60: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
2b70: 6f 67 2d 70 6f 72 74 2a 20 22 45 52 52 4f 52 3a og-port* "ERROR:
2b80: 20 70 61 72 61 6d 65 74 65 72 20 6c 61 73 74 2d parameter last-
2b90: 75 70 64 61 74 65 20 66 6f 72 20 64 62 3a 73 79 update for db:sy
2ba0: 6e 63 2d 74 61 62 6c 65 73 20 6d 75 73 74 20 62 nc-tables must b
2bb0: 65 20 61 20 70 61 69 72 20 6f 72 20 61 20 6e 75 e a pair or a nu
2bc0: 6d 62 65 72 2c 20 72 65 63 65 69 76 65 64 3a 20 mber, received:
2bd0: 22 20 6c 61 73 74 2d 75 70 64 61 74 65 29 3b 3b " last-update);;
2be0: 20 66 6f 75 6e 64 20 69 6e 20 66 69 65 6c 64 73 found in fields
2bf0: 0a 20 20 20 20 23 66 29 0a 20 20 20 28 65 6c 73 . #f). (els
2c00: 65 0a 20 20 20 20 23 66 29 29 29 0a 0a 3b 3b 20 e. #f)))..;;
2c10: 74 62 6c 73 20 69 73 20 28 20 28 22 74 61 62 6c tbls is ( ("tabl
2c20: 65 6e 61 6d 65 22 20 28 20 22 66 69 65 6c 64 31 ename" ( "field1
2c30: 22 20 5b 23 66 7c 70 72 6f 63 31 5d 20 29 20 28 " [#f|proc1] ) (
2c40: 20 22 66 69 65 6c 64 32 22 20 5b 23 66 7c 70 72 "field2" [#f|pr
2c50: 6f 63 32 5d 20 29 20 2e 2e 2e 2e 20 29 20 29 0a oc2] ) .... ) ).
2c60: 3b 3b 20 64 62 73 20 61 72 65 20 73 71 6c 69 74 ;; dbs are sqlit
2c70: 65 33 20 64 62 20 68 61 6e 64 6c 65 73 0a 3b 3b e3 db handles.;;
2c80: 0a 3b 3b 20 69 66 20 6c 61 73 74 2d 75 70 64 61 .;; if last-upda
2c90: 74 65 20 73 70 65 63 69 66 69 65 64 20 28 22 66 te specified ("f
2ca0: 69 65 6c 64 2d 6e 61 6d 65 22 20 2e 20 74 69 6d ield-name" . tim
2cb0: 65 2d 69 6e 2d 73 65 63 6f 6e 64 73 29 0a 3b 3b e-in-seconds).;;
2cc0: 20 20 20 20 74 68 65 6e 20 73 79 6e 63 20 6f 6e then sync on
2cd0: 6c 79 20 72 65 63 6f 72 64 73 20 77 68 65 72 65 ly records where
2ce0: 20 66 69 65 6c 64 2d 6e 61 6d 65 20 3e 3d 20 74 field-name >= t
2cf0: 69 6d 65 2d 69 6e 2d 73 65 63 6f 6e 64 73 0a 3b ime-in-seconds.;
2d00: 3b 20 20 20 20 49 46 46 20 66 69 65 6c 64 2d 6e ; IFF field-n
2d10: 61 6d 65 20 65 78 69 73 74 73 0a 3b 3b 0a 3b 3b ame exists.;;.;;
2d20: 20 55 73 65 20 28 64 62 3a 73 79 6e 63 2d 61 6c Use (db:sync-al
2d30: 6c 2d 74 61 62 6c 65 73 2d 6c 69 73 74 20 6b 65 l-tables-list ke
2d40: 79 73 29 20 74 6f 20 67 65 74 20 74 68 65 20 74 ys) to get the t
2d50: 62 6c 73 20 69 6e 70 75 74 0a 3b 3b 0a 28 64 65 bls input.;;.(de
2d60: 66 69 6e 65 20 28 64 62 6d 6f 64 3a 73 79 6e 63 fine (dbmod:sync
2d70: 2d 74 61 62 6c 65 73 20 74 62 6c 73 20 6c 61 73 -tables tbls las
2d80: 74 2d 75 70 64 61 74 65 20 6b 65 79 73 20 66 72 t-update keys fr
2d90: 6f 6d 64 62 20 74 6f 64 62 29 0a 20 20 28 64 65 omdb todb). (de
2da0: 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 bug:print-info 2
2db0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
2dc0: 72 74 2a 20 22 64 62 6d 6f 64 3a 73 79 6e 63 2d rt* "dbmod:sync-
2dd0: 74 61 62 6c 65 73 20 63 61 6c 6c 65 64 2c 20 66 tables called, f
2de0: 72 6f 6d 3a 20 22 66 72 6f 6d 64 62 22 2c 20 74 rom: "fromdb", t
2df0: 6f 3a 20 22 74 6f 64 62 29 0a 20 20 28 61 73 73 o: "todb). (ass
2e00: 65 72 74 20 28 73 71 6c 69 74 65 33 3a 64 61 74 ert (sqlite3:dat
2e10: 61 62 61 73 65 3f 20 66 72 6f 6d 64 62 29 20 22 abase? fromdb) "
2e20: 46 41 54 41 4c 3a 20 64 62 6d 6f 64 3a 73 79 6e FATAL: dbmod:syn
2e30: 63 2d 74 61 62 6c 65 73 20 63 61 6c 6c 65 64 20 c-tables called
2e40: 77 69 74 68 20 66 72 6f 6d 64 62 20 6e 6f 74 20 with fromdb not
2e50: 61 20 64 61 74 61 62 61 73 65 22 20 66 72 6f 6d a database" from
2e60: 64 62 29 0a 20 20 28 61 73 73 65 72 74 20 28 73 db). (assert (s
2e70: 71 6c 69 74 65 33 3a 64 61 74 61 62 61 73 65 3f qlite3:database?
2e80: 20 74 6f 64 62 29 20 22 46 41 54 41 4c 3a 20 64 todb) "FATAL: d
2e90: 62 6d 6f 64 3a 73 79 6e 63 2d 74 61 62 6c 65 73 bmod:sync-tables
2ea0: 20 63 61 6c 6c 65 64 20 77 69 74 68 20 66 72 6f called with fro
2eb0: 6d 64 62 20 6e 6f 74 20 61 20 64 61 74 61 62 61 mdb not a databa
2ec0: 73 65 22 20 74 6f 64 62 29 0a 20 20 28 6c 65 74 se" todb). (let
2ed0: 20 28 28 73 74 6d 74 73 20 20 20 20 20 20 20 28 ((stmts (
2ee0: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
2ef0: 29 20 3b 3b 20 74 61 62 6c 65 2d 66 69 65 6c 64 ) ;; table-field
2f00: 20 3d 3e 20 73 74 6d 74 0a 09 28 61 6c 6c 2d 73 => stmt..(all-s
2f10: 74 6d 74 73 20 20 20 27 28 29 29 20 20 20 20 20 tmts '())
2f20: 20 20 20 20 20 20 20 20 20 3b 3b 20 28 20 28 20 ;; ( (
2f30: 73 74 6d 74 31 20 76 61 6c 75 65 31 20 29 20 28 stmt1 value1 ) (
2f40: 20 73 74 6d 6c 32 20 76 61 6c 75 65 32 20 29 29 stml2 value2 ))
2f50: 0a 09 28 6e 75 6d 72 65 63 73 20 20 20 20 20 28 ..(numrecs (
2f60: 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 make-hash-table)
2f70: 29 0a 09 28 73 74 61 72 74 2d 74 69 6d 65 20 20 )..(start-time
2f80: 28 63 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 (current-millise
2f90: 63 6f 6e 64 73 29 29 0a 09 28 74 6f 74 2d 63 6f conds))..(tot-co
2fa0: 75 6e 74 20 20 20 30 29 29 0a 20 20 20 20 28 66 unt 0)). (f
2fb0: 6f 72 2d 65 61 63 68 20 3b 3b 20 74 61 62 6c 65 or-each ;; table
2fc0: 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 74 . (lambda (t
2fd0: 61 62 6c 65 64 61 74 29 0a 20 20 20 20 20 20 20 abledat).
2fe0: 28 6c 65 74 2a 20 28 28 74 61 62 6c 65 6e 61 6d (let* ((tablenam
2ff0: 65 20 20 20 20 20 20 20 20 28 63 61 72 20 74 61 e (car ta
3000: 62 6c 65 64 61 74 29 29 0a 09 20 20 20 20 20 20 bledat))..
3010: 28 66 69 65 6c 64 73 20 20 20 20 20 20 20 20 20 (fields
3020: 20 20 28 63 64 72 20 74 61 62 6c 65 64 61 74 29 (cdr tabledat)
3030: 29 0a 09 20 20 20 20 20 20 28 68 61 73 2d 6c 61 ).. (has-la
3040: 73 74 2d 75 70 64 61 74 65 20 20 28 6d 65 6d 62 st-update (memb
3050: 65 72 20 22 6c 61 73 74 5f 75 70 64 61 74 65 22 er "last_update"
3060: 20 66 69 65 6c 64 73 29 29 0a 09 20 20 20 20 20 fields))..
3070: 20 28 75 73 65 2d 6c 61 73 74 2d 75 70 64 61 74 (use-last-updat
3080: 65 20 20 28 64 62 6d 6f 64 3a 63 61 6c 63 2d 75 e (dbmod:calc-u
3090: 73 65 2d 6c 61 73 74 2d 75 70 64 61 74 65 20 68 se-last-update h
30a0: 61 73 2d 6c 61 73 74 2d 75 70 64 61 74 65 20 66 as-last-update f
30b0: 69 65 6c 64 73 20 6c 61 73 74 2d 75 70 64 61 74 ields last-updat
30c0: 65 29 29 0a 09 20 20 20 20 20 20 28 6c 61 73 74 e)).. (last
30d0: 2d 75 70 64 61 74 65 2d 76 61 6c 75 65 20 28 69 -update-value (i
30e0: 66 20 75 73 65 2d 6c 61 73 74 2d 75 70 64 61 74 f use-last-updat
30f0: 65 20 3b 3b 20 6e 6f 20 6e 65 65 64 20 74 6f 20 e ;; no need to
3100: 63 68 65 63 6b 20 66 6f 72 20 68 61 73 2d 6c 61 check for has-la
3110: 73 74 2d 75 70 64 61 74 65 20 2d 20 69 74 20 69 st-update - it i
3120: 73 20 61 6c 72 65 61 64 79 20 61 63 63 6f 75 6e s already accoun
3130: 74 65 64 20 66 6f 72 0a 09 09 09 09 20 20 20 20 ted for.....
3140: 20 28 69 66 20 28 6e 75 6d 62 65 72 3f 20 6c 61 (if (number? la
3150: 73 74 2d 75 70 64 61 74 65 29 0a 09 09 09 09 09 st-update)......
3160: 20 6c 61 73 74 2d 75 70 64 61 74 65 0a 09 09 09 last-update....
3170: 09 09 20 28 63 64 72 20 6c 61 73 74 2d 75 70 64 .. (cdr last-upd
3180: 61 74 65 29 29 0a 09 09 09 09 20 20 20 20 20 23 ate))..... #
3190: 66 29 29 0a 09 20 20 20 20 20 20 28 6c 61 73 74 f)).. (last
31a0: 2d 75 70 64 61 74 65 2d 66 69 65 6c 64 20 28 69 -update-field (i
31b0: 66 20 75 73 65 2d 6c 61 73 74 2d 75 70 64 61 74 f use-last-updat
31c0: 65 0a 09 09 09 09 20 20 20 20 20 28 69 66 20 28 e..... (if (
31d0: 6e 75 6d 62 65 72 3f 20 6c 61 73 74 2d 75 70 64 number? last-upd
31e0: 61 74 65 29 0a 09 09 09 09 09 20 22 6c 61 73 74 ate)...... "last
31f0: 5f 75 70 64 61 74 65 22 0a 09 09 09 09 09 20 28 _update"...... (
3200: 63 61 72 20 6c 61 73 74 2d 75 70 64 61 74 65 29 car last-update)
3210: 29 0a 09 09 09 09 20 20 20 20 20 23 66 29 29 0a )..... #f)).
3220: 09 20 20 20 20 20 20 28 6e 75 6d 2d 66 69 65 6c . (num-fiel
3230: 64 73 20 28 6c 65 6e 67 74 68 20 66 69 65 6c 64 ds (length field
3240: 73 29 29 0a 09 20 20 20 20 20 20 28 66 69 65 6c s)).. (fiel
3250: 64 2d 3e 6e 75 6d 20 28 6d 61 6b 65 2d 68 61 73 d->num (make-has
3260: 68 2d 74 61 62 6c 65 29 29 0a 09 20 20 20 20 20 h-table))..
3270: 20 28 6e 75 6d 2d 3e 66 69 65 6c 64 20 28 61 70 (num->field (ap
3280: 70 6c 79 20 76 65 63 74 6f 72 20 28 6d 61 70 20 ply vector (map
3290: 63 61 72 20 66 69 65 6c 64 73 29 29 29 20 3b 3b car fields))) ;;
32a0: 20 42 42 48 45 52 45 0a 09 20 20 20 20 20 20 28 BBHERE.. (
32b0: 66 75 6c 6c 2d 73 65 6c 20 20 20 28 63 6f 6e 63 full-sel (conc
32c0: 20 22 53 45 4c 45 43 54 20 22 20 28 73 74 72 69 "SELECT " (stri
32d0: 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 ng-intersperse (
32e0: 6d 61 70 20 63 61 72 20 66 69 65 6c 64 73 29 20 map car fields)
32f0: 22 2c 22 29 20 0a 09 09 09 09 22 20 46 52 4f 4d ",") ....." FROM
3300: 20 22 20 74 61 62 6c 65 6e 61 6d 65 20 28 69 66 " tablename (if
3310: 20 75 73 65 2d 6c 61 73 74 2d 75 70 64 61 74 65 use-last-update
3320: 20 3b 3b 20 61 70 70 6c 79 20 6c 61 73 74 2d 75 ;; apply last-u
3330: 70 64 61 74 65 20 63 72 69 74 65 72 69 61 0a 09 pdate criteria..
3340: 09 09 09 09 09 20 20 20 20 20 20 20 28 63 6f 6e ..... (con
3350: 63 20 22 20 57 48 45 52 45 20 22 20 6c 61 73 74 c " WHERE " last
3360: 2d 75 70 64 61 74 65 2d 66 69 65 6c 64 20 22 20 -update-field "
3370: 3e 3d 20 22 20 6c 61 73 74 2d 75 70 64 61 74 65 >= " last-update
3380: 2d 76 61 6c 75 65 29 0a 09 09 09 09 09 09 20 20 -value).......
3390: 20 20 20 20 20 22 22 29 0a 09 09 09 09 22 3b 22 "").....";"
33a0: 29 29 0a 09 20 20 20 20 20 20 28 66 75 6c 6c 2d )).. (full-
33b0: 69 6e 73 20 20 20 28 63 6f 6e 63 20 22 49 4e 53 ins (conc "INS
33c0: 45 52 54 20 4f 52 20 52 45 50 4c 41 43 45 20 49 ERT OR REPLACE I
33d0: 4e 54 4f 20 22 20 74 61 62 6c 65 6e 61 6d 65 20 NTO " tablename
33e0: 22 20 28 20 22 20 28 73 74 72 69 6e 67 2d 69 6e " ( " (string-in
33f0: 74 65 72 73 70 65 72 73 65 20 28 6d 61 70 20 63 tersperse (map c
3400: 61 72 20 66 69 65 6c 64 73 29 20 22 2c 22 29 20 ar fields) ",")
3410: 22 20 29 20 22 0a 09 09 09 09 22 20 56 41 4c 55 " ) "....." VALU
3420: 45 53 20 28 20 22 20 28 73 74 72 69 6e 67 2d 69 ES ( " (string-i
3430: 6e 74 65 72 73 70 65 72 73 65 20 28 6d 61 6b 65 ntersperse (make
3440: 2d 6c 69 73 74 20 6e 75 6d 2d 66 69 65 6c 64 73 -list num-fields
3450: 20 22 3f 22 29 20 22 2c 22 29 20 22 20 29 3b 22 "?") ",") " );"
3460: 29 29 0a 09 20 20 20 20 20 20 28 66 72 6f 6d 64 )).. (fromd
3470: 61 74 20 20 20 20 27 28 29 29 0a 09 20 20 20 20 at '())..
3480: 20 20 28 66 72 6f 6d 64 61 74 73 20 20 20 27 28 (fromdats '(
3490: 29 29 0a 09 20 20 20 20 20 20 28 74 6f 74 72 65 )).. (totre
34a0: 63 6f 72 64 73 20 30 29 0a 09 20 20 20 20 20 20 cords 0)..
34b0: 28 62 61 74 63 68 2d 6c 65 6e 20 20 31 30 30 29 (batch-len 100)
34c0: 20 3b 3b 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d ;; (string->num
34d0: 62 65 72 20 28 6f 72 20 28 63 6f 6e 66 69 67 66 ber (or (configf
34e0: 3a 6c 6f 6f 6b 75 70 20 2a 63 6f 6e 66 69 67 64 :lookup *configd
34f0: 61 74 2a 20 22 73 79 6e 63 22 20 22 62 61 74 63 at* "sync" "batc
3500: 68 73 69 7a 65 22 29 20 22 31 30 30 22 29 29 29 hsize") "100")))
3510: 0a 09 20 20 20 20 20 20 28 74 6f 64 61 74 20 20 .. (todat
3520: 20 20 20 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 (make-hash-t
3530: 61 62 6c 65 29 29 0a 09 20 20 20 20 20 20 28 63 able)).. (c
3540: 6f 75 6e 74 20 20 20 20 20 20 30 29 0a 20 20 20 ount 0).
3550: 20 20 20 20 20 20 20 20 20 20 20 28 66 69 65 6c (fiel
3560: 64 2d 6e 61 6d 65 73 20 28 6d 61 70 20 63 61 72 d-names (map car
3570: 20 66 69 65 6c 64 73 29 29 29 0a 09 20 0a 09 20 fields))).. ..
3580: 3b 3b 20 73 65 74 20 75 70 20 74 68 65 20 66 69 ;; set up the fi
3590: 65 6c 64 2d 3e 6e 75 6d 20 74 61 62 6c 65 0a 09 eld->num table..
35a0: 20 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 28 6c (for-each.. (l
35b0: 61 6d 62 64 61 20 28 66 69 65 6c 64 29 0a 09 20 ambda (field)..
35c0: 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 (hash-table-s
35d0: 65 74 21 20 66 69 65 6c 64 2d 3e 6e 75 6d 20 66 et! field->num f
35e0: 69 65 6c 64 20 63 6f 75 6e 74 29 0a 09 20 20 20 ield count)..
35f0: 20 28 73 65 74 21 20 63 6f 75 6e 74 20 28 2b 20 (set! count (+
3600: 63 6f 75 6e 74 20 31 29 29 29 0a 09 20 20 66 69 count 1))).. fi
3610: 65 6c 64 73 29 0a 09 20 0a 09 20 3b 3b 20 72 65 elds).. .. ;; re
3620: 61 64 20 74 68 65 20 73 6f 75 72 63 65 20 74 61 ad the source ta
3630: 62 6c 65 0a 20 20 20 20 20 20 20 20 20 3b 3b 20 ble. ;;
3640: 73 74 6f 72 65 20 61 20 6c 69 73 74 20 6f 66 20 store a list of
3650: 61 6c 6c 20 72 6f 77 73 20 69 6e 20 74 68 65 20 all rows in the
3660: 74 61 62 6c 65 20 69 6e 20 66 72 6f 6d 64 61 74 table in fromdat
3670: 2c 20 75 70 20 74 6f 20 62 61 74 63 68 2d 6c 65 , up to batch-le
3680: 6e 2e 0a 20 20 20 20 20 20 20 20 20 3b 3b 20 54 n.. ;; T
3690: 68 65 6e 20 61 64 64 20 66 72 6f 6d 64 61 74 20 hen add fromdat
36a0: 74 6f 20 74 68 65 20 66 72 6f 6d 64 61 74 73 20 to the fromdats
36b0: 6c 69 73 74 2c 20 63 6c 65 61 72 20 66 72 6f 6d list, clear from
36c0: 64 61 74 20 61 6e 64 20 72 65 70 65 61 74 2e 0a dat and repeat..
36d0: 09 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 . (sqlite3:for-e
36e0: 61 63 68 2d 72 6f 77 0a 09 20 20 28 6c 61 6d 62 ach-row.. (lamb
36f0: 64 61 20 28 61 20 2e 20 62 29 0a 09 20 20 20 20 da (a . b)..
3700: 20 20 20 28 73 65 74 21 20 66 72 6f 6d 64 61 74 (set! fromdat
3710: 20 28 63 6f 6e 73 20 28 61 70 70 6c 79 20 76 65 (cons (apply ve
3720: 63 74 6f 72 20 61 20 62 29 20 66 72 6f 6d 64 61 ctor a b) fromda
3730: 74 29 29 0a 09 20 20 20 20 20 20 20 28 69 66 20 t)).. (if
3740: 28 3e 20 28 6c 65 6e 67 74 68 20 66 72 6f 6d 64 (> (length fromd
3750: 61 74 29 20 62 61 74 63 68 2d 6c 65 6e 29 0a 09 at) batch-len)..
3760: 09 20 20 20 28 62 65 67 69 6e 0a 09 09 20 20 20 . (begin...
3770: 20 20 28 73 65 74 21 20 66 72 6f 6d 64 61 74 73 (set! fromdats
3780: 20 28 63 6f 6e 73 20 66 72 6f 6d 64 61 74 20 66 (cons fromdat f
3790: 72 6f 6d 64 61 74 73 29 29 0a 09 09 20 20 20 20 romdats))...
37a0: 20 28 73 65 74 21 20 66 72 6f 6d 64 61 74 20 20 (set! fromdat
37b0: 27 28 29 29 0a 09 09 20 20 20 20 20 28 73 65 74 '())... (set
37c0: 21 20 74 6f 74 72 65 63 6f 72 64 73 20 28 2b 20 ! totrecords (+
37d0: 74 6f 74 72 65 63 6f 72 64 73 20 31 29 29 29 29 totrecords 1))))
37e0: 29 0a 09 20 20 66 72 6f 6d 64 62 0a 09 20 20 66 ).. fromdb.. f
37f0: 75 6c 6c 2d 73 65 6c 29 0a 09 20 0a 20 20 20 20 ull-sel).. .
3800: 20 20 20 20 20 3b 3b 20 43 6f 75 6e 74 20 6c 65 ;; Count le
3810: 73 73 20 74 68 61 6e 20 62 61 74 63 68 2d 6c 65 ss than batch-le
3820: 6e 20 61 73 20 61 20 72 65 63 6f 72 64 0a 20 20 n as a record.
3830: 20 20 20 20 20 20 20 28 69 66 20 28 3e 20 28 6c (if (> (l
3840: 65 6e 67 74 68 20 66 72 6f 6d 64 61 74 29 20 30 ength fromdat) 0
3850: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
3860: 73 65 74 21 20 74 6f 74 72 65 63 6f 72 64 73 20 set! totrecords
3870: 28 2b 20 74 6f 74 72 65 63 6f 72 64 73 20 31 29 (+ totrecords 1)
3880: 29 29 0a 09 20 0a 09 20 3b 3b 20 74 61 63 6b 20 )).. .. ;; tack
3890: 6f 6e 20 72 65 6d 61 69 6e 69 6e 67 20 72 65 63 on remaining rec
38a0: 6f 72 64 73 20 69 6e 20 66 72 6f 6d 64 61 74 0a ords in fromdat.
38b0: 09 20 28 69 66 20 28 6e 6f 74 20 28 6e 75 6c 6c . (if (not (null
38c0: 3f 20 66 72 6f 6d 64 61 74 29 29 0a 09 20 20 20 ? fromdat))..
38d0: 20 20 28 73 65 74 21 20 66 72 6f 6d 64 61 74 73 (set! fromdats
38e0: 20 28 63 6f 6e 73 20 66 72 6f 6d 64 61 74 20 66 (cons fromdat f
38f0: 72 6f 6d 64 61 74 73 29 29 29 0a 09 20 0a 09 20 romdats))).. ..
3900: 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d 65 61 63 (sqlite3:for-eac
3910: 68 2d 72 6f 77 0a 09 20 20 28 6c 61 6d 62 64 61 h-row.. (lambda
3920: 20 28 61 20 2e 20 62 29 0a 09 20 20 20 20 28 68 (a . b).. (h
3930: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 74 ash-table-set! t
3940: 6f 64 61 74 20 61 20 28 61 70 70 6c 79 20 76 65 odat a (apply ve
3950: 63 74 6f 72 20 61 20 62 29 29 29 0a 09 20 20 74 ctor a b))).. t
3960: 6f 64 62 0a 09 20 20 66 75 6c 6c 2d 73 65 6c 29 odb.. full-sel)
3970: 0a 09 20 0a 09 20 3b 3b 20 66 69 72 73 74 20 70 .. .. ;; first p
3980: 61 73 73 20 69 6d 70 6c 65 6d 65 6e 74 61 74 69 ass implementati
3990: 6f 6e 2c 20 6a 75 73 74 20 69 6e 73 65 72 74 20 on, just insert
39a0: 61 6c 6c 20 63 68 61 6e 67 65 64 20 72 6f 77 73 all changed rows
39b0: 0a 09 20 0a 09 20 28 6c 65 74 2a 20 28 28 64 62 .. .. (let* ((db
39c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
39d0: 20 74 6f 64 62 29 0a 20 20 20 20 20 20 20 20 20 todb).
39e0: 20 20 20 20 20 20 20 28 64 72 70 2d 74 72 69 67 (drp-trig
39f0: 67 65 72 20 20 20 20 20 20 20 20 28 69 66 20 28 ger (if (
3a00: 6d 65 6d 62 65 72 20 22 6c 61 73 74 5f 75 70 64 member "last_upd
3a10: 61 74 65 22 20 66 69 65 6c 64 2d 6e 61 6d 65 73 ate" field-names
3a20: 29 0a 09 09 09 09 09 28 64 62 3a 64 72 6f 70 2d )......(db:drop-
3a30: 74 72 69 67 67 65 72 20 64 62 20 74 61 62 6c 65 trigger db table
3a40: 6e 61 6d 65 29 20 0a 09 09 09 09 09 23 66 29 29 name) ......#f))
3a50: 0a 09 09 28 68 61 73 2d 6c 61 73 74 2d 75 70 64 ...(has-last-upd
3a60: 61 74 65 20 20 20 20 28 6d 65 6d 62 65 72 20 22 ate (member "
3a70: 6c 61 73 74 5f 75 70 64 61 74 65 22 20 66 69 65 last_update" fie
3a80: 6c 64 2d 6e 61 6d 65 73 29 29 0a 20 20 20 20 20 ld-names)).
3a90: 20 20 20 20 20 20 20 20 20 20 20 28 69 73 2d 74 (is-t
3aa0: 72 69 67 67 65 72 2d 64 72 6f 70 70 65 64 20 28 rigger-dropped (
3ab0: 69 66 20 68 61 73 2d 6c 61 73 74 2d 75 70 64 61 if has-last-upda
3ac0: 74 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 te.
3ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ae0: 20 20 20 20 20 20 20 20 20 20 20 28 64 62 3a 69 (db:i
3af0: 73 2d 74 72 69 67 67 65 72 2d 64 72 6f 70 70 65 s-trigger-droppe
3b00: 64 20 64 62 20 74 61 62 6c 65 6e 61 6d 65 29 0a d db tablename).
3b10: 09 09 09 09 09 23 66 29 29 20 0a 09 09 28 73 74 .....#f)) ...(st
3b20: 6d 74 68 20 20 28 73 71 6c 69 74 65 33 3a 70 72 mth (sqlite3:pr
3b30: 65 70 61 72 65 20 64 62 20 66 75 6c 6c 2d 69 6e epare db full-in
3b40: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
3b50: 20 20 20 20 28 63 68 61 6e 67 65 64 2d 72 6f 77 (changed-row
3b60: 73 20 30 29 29 0a 09 20 20 20 28 66 6f 72 2d 65 s 0)).. (for-e
3b70: 61 63 68 0a 09 20 20 20 20 28 6c 61 6d 62 64 61 ach.. (lambda
3b80: 20 28 66 72 6f 6d 64 61 74 2d 6c 73 74 29 0a 09 (fromdat-lst)..
3b90: 20 20 20 20 20 20 28 6d 75 74 65 78 2d 6c 6f 63 (mutex-loc
3ba0: 6b 21 20 2a 64 62 2d 74 72 61 6e 73 61 63 74 69 k! *db-transacti
3bb0: 6f 6e 2d 6d 75 74 65 78 2a 29 0a 09 20 20 20 20 on-mutex*)..
3bc0: 20 20 28 73 71 6c 69 74 65 33 3a 77 69 74 68 2d (sqlite3:with-
3bd0: 74 72 61 6e 73 61 63 74 69 6f 6e 0a 09 20 20 20 transaction..
3be0: 20 20 20 20 64 62 0a 09 20 20 20 20 20 20 20 28 db.. (
3bf0: 6c 61 6d 62 64 61 20 28 29 0a 09 09 20 28 66 6f lambda ()... (fo
3c00: 72 2d 65 61 63 68 20 3b 3b 20 0a 09 09 20 20 28 r-each ;; ... (
3c10: 6c 61 6d 62 64 61 20 28 66 72 6f 6d 72 6f 77 29 lambda (fromrow)
3c20: 0a 09 09 20 20 20 20 28 6c 65 74 2a 20 28 28 61 ... (let* ((a
3c30: 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (vector-ref
3c40: 66 72 6f 6d 72 6f 77 20 30 29 29 0a 09 09 09 20 fromrow 0))....
3c50: 20 20 28 63 75 72 72 20 28 68 61 73 68 2d 74 61 (curr (hash-ta
3c60: 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 ble-ref/default
3c70: 74 6f 64 61 74 20 61 20 23 66 29 29 0a 09 09 09 todat a #f))....
3c80: 20 20 20 28 73 61 6d 65 20 23 74 29 29 0a 09 09 (same #t))...
3c90: 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 (let loop
3ca0: 28 28 69 20 30 29 29 0a 09 09 09 28 69 66 20 28 ((i 0))....(if (
3cb0: 6f 72 20 28 6e 6f 74 20 63 75 72 72 29 0a 09 09 or (not curr)...
3cc0: 09 09 28 6e 6f 74 20 28 65 71 75 61 6c 3f 20 28 ..(not (equal? (
3cd0: 76 65 63 74 6f 72 2d 72 65 66 20 66 72 6f 6d 72 vector-ref fromr
3ce0: 6f 77 20 69 29 28 76 65 63 74 6f 72 2d 72 65 66 ow i)(vector-ref
3cf0: 20 63 75 72 72 20 69 29 29 29 29 0a 09 09 09 20 curr i))))....
3d00: 20 20 20 28 73 65 74 21 20 73 61 6d 65 20 23 66 (set! same #f
3d10: 29 29 0a 09 09 09 28 69 66 20 28 61 6e 64 20 73 ))....(if (and s
3d20: 61 6d 65 0a 09 09 09 09 20 28 3c 20 69 20 28 2d ame..... (< i (-
3d30: 20 6e 75 6d 2d 66 69 65 6c 64 73 20 31 29 29 29 num-fields 1)))
3d40: 0a 09 09 09 20 20 20 20 28 6c 6f 6f 70 20 28 2b .... (loop (+
3d50: 20 69 20 31 29 29 29 29 0a 09 09 20 20 20 20 20 i 1))))...
3d60: 20 28 69 66 20 28 6e 6f 74 20 73 61 6d 65 29 0a (if (not same).
3d70: 09 09 09 20 20 28 62 65 67 69 6e 0a 09 09 09 20 ... (begin....
3d80: 20 20 20 28 61 70 70 6c 79 20 73 71 6c 69 74 65 (apply sqlite
3d90: 33 3a 65 78 65 63 75 74 65 20 73 74 6d 74 68 20 3:execute stmth
3da0: 28 76 65 63 74 6f 72 2d 3e 6c 69 73 74 20 66 72 (vector->list fr
3db0: 6f 6d 72 6f 77 29 29 0a 09 09 09 20 20 20 20 28 omrow)).... (
3dc0: 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 hash-table-set!
3dd0: 6e 75 6d 72 65 63 73 20 74 61 62 6c 65 6e 61 6d numrecs tablenam
3de0: 65 20 28 2b 20 31 20 28 68 61 73 68 2d 74 61 62 e (+ 1 (hash-tab
3df0: 6c 65 2d 72 65 66 2f 64 65 66 61 75 6c 74 20 6e le-ref/default n
3e00: 75 6d 72 65 63 73 20 74 61 62 6c 65 6e 61 6d 65 umrecs tablename
3e10: 20 30 29 29 29 0a 09 09 09 20 20 20 20 28 73 65 0))).... (se
3e20: 74 21 20 63 68 61 6e 67 65 64 2d 72 6f 77 73 20 t! changed-rows
3e30: 28 2b 20 63 68 61 6e 67 65 64 2d 72 6f 77 73 20 (+ changed-rows
3e40: 31 29 29 29 29 29 29 0a 09 09 20 20 66 72 6f 6d 1))))))... from
3e50: 64 61 74 2d 6c 73 74 29 29 29 0a 09 20 20 20 20 dat-lst)))..
3e60: 20 20 28 6d 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 (mutex-unlock!
3e70: 20 2a 64 62 2d 74 72 61 6e 73 61 63 74 69 6f 6e *db-transaction
3e80: 2d 6d 75 74 65 78 2a 29 29 0a 09 20 20 20 20 66 -mutex*)).. f
3e90: 72 6f 6d 64 61 74 73 29 0a 09 09 20 20 20 20 20 romdats)...
3ea0: 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 69 6e ;; (debug:prin
3eb0: 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 t 0 *default-log
3ec0: 2d 70 6f 72 74 2a 20 22 72 6f 77 3d 22 72 6f 77 -port* "row="row
3ed0: 29 0a 09 20 20 20 0a 09 20 20 20 28 73 71 6c 69 ).. .. (sqli
3ee0: 74 65 33 3a 66 69 6e 61 6c 69 7a 65 21 20 73 74 te3:finalize! st
3ef0: 6d 74 68 29 0a 20 20 20 20 20 20 20 20 20 20 20 mth).
3f00: 28 69 66 20 28 6d 65 6d 62 65 72 20 22 6c 61 73 (if (member "las
3f10: 74 5f 75 70 64 61 74 65 22 20 66 69 65 6c 64 2d t_update" field-
3f20: 6e 61 6d 65 73 29 0a 20 20 20 20 20 20 20 20 20 names).
3f30: 20 20 20 20 20 20 28 64 62 3a 63 72 65 61 74 65 (db:create
3f40: 2d 74 72 69 67 67 65 72 20 64 62 20 74 61 62 6c -trigger db tabl
3f50: 65 6e 61 6d 65 29 29 29 0a 09 20 29 29 0a 20 20 ename))).. )).
3f60: 20 20 20 74 62 6c 73 29 0a 20 20 20 20 28 6c 65 tbls). (le
3f70: 74 2a 20 28 28 72 75 6e 74 69 6d 65 20 20 20 20 t* ((runtime
3f80: 20 20 28 2d 20 28 63 75 72 72 65 6e 74 2d 6d 69 (- (current-mi
3f90: 6c 6c 69 73 65 63 6f 6e 64 73 29 20 73 74 61 72 lliseconds) star
3fa0: 74 2d 74 69 6d 65 29 29 0a 09 20 20 20 28 73 68 t-time)).. (sh
3fb0: 6f 75 6c 64 2d 70 72 69 6e 74 20 28 6f 72 20 3b ould-print (or ;
3fc0: 3b 20 28 64 65 62 75 67 3a 64 65 62 75 67 2d 6d ; (debug:debug-m
3fd0: 6f 64 65 20 31 32 29 0a 09 09 09 20 20 28 63 6f ode 12).... (co
3fe0: 6d 6d 6f 6e 3a 6c 6f 77 2d 6e 6f 69 73 65 2d 70 mmon:low-noise-p
3ff0: 72 69 6e 74 20 31 32 30 20 22 64 62 20 73 79 6e rint 120 "db syn
4000: 63 22 29 0a 09 09 09 20 20 28 3e 20 72 75 6e 74 c").... (> runt
4010: 69 6d 65 20 35 30 30 29 29 29 29 20 3b 3b 20 6c ime 500)))) ;; l
4020: 6f 77 20 61 6e 64 20 68 69 67 68 20 73 79 6e 63 ow and high sync
4030: 20 74 69 6d 65 73 20 74 72 65 61 74 65 64 20 61 times treated a
4040: 73 20 73 65 70 61 72 61 74 65 2e 0a 20 20 20 20 s separate..
4050: 20 20 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 (for-each .
4060: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 64 61 74 (lambda (dat
4070: 29 0a 09 20 28 6c 65 74 20 28 28 74 62 6c 6e 61 ).. (let ((tblna
4080: 6d 65 20 28 63 61 72 20 64 61 74 29 29 0a 09 20 me (car dat))..
4090: 20 20 20 20 20 20 28 63 6f 75 6e 74 20 20 20 28 (count (
40a0: 63 64 72 20 64 61 74 29 29 29 0a 09 20 20 20 28 cdr dat))).. (
40b0: 73 65 74 21 20 74 6f 74 2d 63 6f 75 6e 74 20 28 set! tot-count (
40c0: 2b 20 74 6f 74 2d 63 6f 75 6e 74 20 63 6f 75 6e + tot-count coun
40d0: 74 29 29 29 29 20 0a 20 20 20 20 20 20 20 28 73 t)))) . (s
40e0: 6f 72 74 20 28 68 61 73 68 2d 74 61 62 6c 65 2d ort (hash-table-
40f0: 3e 61 6c 69 73 74 20 6e 75 6d 72 65 63 73 29 28 >alist numrecs)(
4100: 6c 61 6d 62 64 61 20 28 61 20 62 29 28 3e 20 28 lambda (a b)(> (
4110: 63 64 72 20 61 29 28 63 64 72 20 62 29 29 29 29 cdr a)(cdr b))))
4120: 29 29 0a 20 20 20 20 74 6f 74 2d 63 6f 75 6e 74 )). tot-count
4130: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 68 61 73 ))..(define (has
4140: 2d 6c 61 73 74 2d 75 70 64 61 74 65 20 64 62 68 -last-update dbh
4150: 20 74 61 62 6c 65 6e 61 6d 65 29 0a 20 20 28 6c tablename). (l
4160: 65 74 2a 20 28 28 68 61 73 2d 6c 61 73 74 20 23 et* ((has-last #
4170: 66 29 29 0a 20 20 20 20 28 73 71 6c 69 74 65 33 f)). (sqlite3
4180: 3a 66 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 :for-each-row.
4190: 20 20 20 28 6c 61 6d 62 64 61 20 28 6e 61 6d 65 (lambda (name
41a0: 29 0a 20 20 20 20 20 20 20 28 69 66 20 28 65 71 ). (if (eq
41b0: 75 61 6c 3f 20 6e 61 6d 65 20 22 6c 61 73 74 5f ual? name "last_
41c0: 75 70 64 61 74 65 22 29 0a 09 20 20 20 28 73 65 update").. (se
41d0: 74 21 20 68 61 73 2d 6c 61 73 74 20 23 74 29 29 t! has-last #t))
41e0: 29 0a 20 20 20 20 20 64 62 68 0a 20 20 20 20 20 ). dbh.
41f0: 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 6e 61 (conc "SELECT na
4200: 6d 65 20 46 52 4f 4d 20 70 72 61 67 6d 61 5f 74 me FROM pragma_t
4210: 61 62 6c 65 5f 69 6e 66 6f 28 27 22 74 61 62 6c able_info('"tabl
4220: 65 6e 61 6d 65 22 27 29 20 61 73 20 74 62 6c 49 ename"') as tblI
4230: 6e 66 6f 3b 22 29 29 0a 20 20 20 20 68 61 73 2d nfo;")). has-
4240: 6c 61 73 74 29 29 0a 0a 3b 3b 20 74 62 6c 73 20 last))..;; tbls
4250: 69 73 20 28 20 28 22 74 61 62 6c 65 6e 61 6d 65 is ( ("tablename
4260: 22 20 28 20 22 66 69 65 6c 64 31 22 20 5b 23 66 " ( "field1" [#f
4270: 7c 70 72 6f 63 31 5d 20 29 20 28 20 22 66 69 65 |proc1] ) ( "fie
4280: 6c 64 32 22 20 5b 23 66 7c 70 72 6f 63 32 5d 20 ld2" [#f|proc2]
4290: 29 20 2e 2e 2e 2e 20 29 20 29 0a 3b 3b 0a 3b 3b ) .... ) ).;;.;;
42a0: 20 64 69 72 65 63 74 69 6f 6e 20 3d 20 66 72 6f direction = fro
42b0: 6d 64 65 73 74 2c 20 74 6f 64 69 73 6b 0a 3b 3b mdest, todisk.;;
42c0: 20 6d 6f 64 65 20 3d 20 27 66 75 6c 6c 2c 20 27 mode = 'full, '
42d0: 69 6e 63 72 0a 3b 3b 0a 3b 3b 20 49 64 65 61 3a incr.;;.;; Idea:
42e0: 20 79 6f 75 6e 67 65 73 74 20 69 6e 20 64 65 73 youngest in des
42f0: 74 20 69 73 20 6c 61 73 74 5f 75 70 64 61 74 65 t is last_update
4300: 20 74 69 6d 65 0a 3b 3b 0a 28 64 65 66 69 6e 65 time.;;.(define
4310: 20 28 64 62 6d 6f 64 3a 61 74 74 61 63 68 2d 73 (dbmod:attach-s
4320: 79 6e 63 20 74 61 62 6c 65 73 20 64 62 68 20 64 ync tables dbh d
4330: 65 73 74 64 62 66 69 6c 65 20 64 69 72 65 63 74 estdbfile direct
4340: 69 6f 6e 20 23 21 6b 65 79 0a 09 09 09 20 20 20 ion #!key....
4350: 28 6d 6f 64 65 20 27 66 75 6c 6c 29 0a 09 09 09 (mode 'full)....
4360: 20 20 20 28 6e 6f 2d 75 70 64 61 74 65 20 27 28 (no-update '(
4370: 22 6b 65 79 73 22 29 29 20 3b 3b 20 64 6f 0a 09 "keys")) ;; do..
4380: 09 09 20 20 20 29 0a 20 20 28 6c 65 74 2a 20 28 .. ). (let* (
4390: 28 6e 75 6d 2d 63 68 61 6e 67 65 73 20 30 29 0a (num-changes 0).
43a0: 09 20 28 75 70 64 61 74 65 2d 63 68 61 6e 67 65 . (update-change
43b0: 64 20 28 6c 61 6d 62 64 61 20 28 6e 75 6d 2d 63 d (lambda (num-c
43c0: 68 61 6e 67 65 64 20 74 61 62 6c 65 20 71 72 79 hanged table qry
43d0: 6e 61 6d 65 29 0a 09 09 09 20 20 20 28 69 66 20 name).... (if
43e0: 28 3e 20 6e 75 6d 2d 63 68 61 6e 67 65 64 20 30 (> num-changed 0
43f0: 29 0a 09 09 09 20 20 20 20 20 20 20 28 62 65 67 ).... (beg
4400: 69 6e 0a 09 09 09 09 20 28 64 65 62 75 67 3a 70 in..... (debug:p
4410: 72 69 6e 74 2d 69 6e 66 6f 20 30 20 2a 64 65 66 rint-info 0 *def
4420: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
4430: 43 68 61 6e 67 65 64 20 22 6e 75 6d 2d 63 68 61 Changed "num-cha
4440: 6e 67 65 64 22 20 72 6f 77 73 20 66 6f 72 20 74 nged" rows for t
4450: 61 62 6c 65 20 22 74 61 62 6c 65 22 2c 20 71 72 able "table", qr
4460: 79 20 22 71 72 79 6e 61 6d 65 29 0a 09 09 09 09 y "qryname).....
4470: 20 28 73 65 74 21 20 6e 75 6d 2d 63 68 61 6e 67 (set! num-chang
4480: 65 73 20 28 2b 20 6e 75 6d 2d 63 68 61 6e 67 65 es (+ num-change
4490: 73 20 6e 75 6d 2d 63 68 61 6e 67 65 64 29 29 29 s num-changed)))
44a0: 29 29 29 29 0a 20 20 20 20 28 64 65 62 75 67 3a )))). (debug:
44b0: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
44c0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 44 6f 69 6e -log-port* "Doin
44d0: 67 20 73 79 6e 63 20 22 64 69 72 65 63 74 69 6f g sync "directio
44e0: 6e 22 20 22 64 65 73 74 64 62 66 69 6c 65 29 0a n" "destdbfile).
44f0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 73 71 (if (not (sq
4500: 6c 69 74 65 33 3a 61 75 74 6f 2d 63 6f 6d 6d 69 lite3:auto-commi
4510: 74 74 69 6e 67 3f 20 64 62 68 29 29 0a 09 28 64 tting? dbh))..(d
4520: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
4530: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
4540: 22 53 6b 69 70 70 69 6e 67 20 73 79 6e 63 20 64 "Skipping sync d
4550: 75 65 20 74 6f 20 74 72 61 6e 73 61 63 74 69 6f ue to transactio
4560: 6e 20 69 6e 20 66 6c 69 67 68 74 2e 22 29 0a 09 n in flight.")..
4570: 28 6c 65 74 2a 20 28 28 74 61 62 6c 65 2d 6e 61 (let* ((table-na
4580: 6d 65 73 20 20 28 6d 61 70 20 63 61 72 20 74 61 mes (map car ta
4590: 62 6c 65 73 29 29 0a 09 20 20 20 20 20 20 20 28 bles)).. (
45a0: 64 65 73 74 2d 65 78 69 73 74 73 20 20 28 66 69 dest-exists (fi
45b0: 6c 65 2d 65 78 69 73 74 73 3f 20 64 65 73 74 64 le-exists? destd
45c0: 62 66 69 6c 65 29 29 29 0a 09 20 20 28 61 73 73 bfile))).. (ass
45d0: 65 72 74 20 64 65 73 74 2d 65 78 69 73 74 73 20 ert dest-exists
45e0: 22 46 41 54 41 4c 3a 20 73 79 6e 63 20 63 61 6c "FATAL: sync cal
45f0: 6c 65 64 20 77 69 74 68 20 6e 6f 6e 2d 65 78 69 led with non-exi
4600: 73 74 61 6e 74 20 66 69 6c 65 2c 20 22 64 65 73 stant file, "des
4610: 74 64 62 66 69 6c 65 29 0a 09 20 20 3b 3b 20 61 tdbfile).. ;; a
4620: 74 74 61 63 68 20 74 68 65 20 64 65 73 74 64 62 ttach the destdb
4630: 66 69 6c 65 0a 09 20 20 3b 3b 20 66 6f 72 20 65 file.. ;; for e
4640: 61 63 68 20 74 61 62 6c 65 0a 09 20 20 3b 3b 20 ach table.. ;;
4650: 20 20 20 69 6e 73 65 72 74 20 69 6e 74 6f 20 64 insert into d
4660: 65 73 74 2e 3c 74 61 62 6c 65 3e 20 73 65 6c 65 est.<table> sele
4670: 63 74 20 2a 20 66 72 6f 6d 20 73 72 63 2e 3c 74 ct * from src.<t
4680: 61 62 6c 65 3e 20 77 68 65 72 65 20 6c 61 73 74 able> where last
4690: 5f 75 70 64 61 74 65 3e 6c 61 73 74 5f 75 70 64 _update>last_upd
46a0: 61 74 65 0a 09 20 20 3b 3b 20 64 6f 6e 65 0a 09 ate.. ;; done..
46b0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
46c0: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
46d0: 72 74 2a 20 22 41 74 74 61 63 68 69 6e 67 20 22 rt* "Attaching "
46e0: 64 65 73 74 64 62 66 69 6c 65 22 20 61 73 20 61 destdbfile" as a
46f0: 75 78 64 62 22 29 0a 09 20 20 28 68 61 6e 64 6c uxdb").. (handl
4700: 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 20 20 e-exceptions..
4710: 20 20 20 20 65 78 6e 0a 09 20 20 20 20 20 20 28 exn.. (
4720: 62 65 67 69 6e 0a 09 09 28 64 65 62 75 67 3a 70 begin...(debug:p
4730: 72 69 6e 74 20 30 20 22 41 54 54 41 43 48 20 66 rint 0 "ATTACH f
4740: 61 69 6c 65 64 2c 20 65 78 69 74 69 6e 67 2e 20 ailed, exiting.
4750: 65 78 6e 3d 22 28 63 6f 6e 64 69 74 69 6f 6e 2d exn="(condition-
4760: 3e 6c 69 73 74 20 65 78 6e 29 29 0a 09 09 28 65 >list exn))...(e
4770: 78 69 74 20 31 29 29 0a 09 20 20 20 20 28 73 71 xit 1)).. (sq
4780: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
4790: 68 20 28 63 6f 6e 63 20 22 41 54 54 41 43 48 20 h (conc "ATTACH
47a0: 27 22 64 65 73 74 64 62 66 69 6c 65 22 27 20 41 '"destdbfile"' A
47b0: 53 20 61 75 78 64 62 3b 22 29 29 29 0a 09 20 20 S auxdb;")))..
47c0: 28 66 6f 72 2d 65 61 63 68 0a 09 20 20 20 28 6c (for-each.. (l
47d0: 61 6d 62 64 61 20 28 74 61 62 6c 65 29 0a 09 20 ambda (table)..
47e0: 20 20 20 20 28 6c 65 74 2a 20 28 28 74 62 6c 64 (let* ((tbld
47f0: 61 74 20 28 61 6c 69 73 74 2d 72 65 66 20 74 61 at (alist-ref ta
4800: 62 6c 65 20 74 61 62 6c 65 73 20 65 71 75 61 6c ble tables equal
4810: 3f 29 29 0a 09 09 20 20 20 20 28 66 69 65 6c 64 ?))... (field
4820: 73 20 28 6d 61 70 20 63 61 72 20 74 62 6c 64 61 s (map car tblda
4830: 74 29 29 0a 09 09 20 20 20 20 28 6e 6f 2d 69 64 t))... (no-id
4840: 2d 66 69 65 6c 64 73 20 28 66 69 6c 74 65 72 20 -fields (filter
4850: 28 6c 61 6d 62 64 61 20 28 78 29 28 6e 6f 74 20 (lambda (x)(not
4860: 28 65 71 75 61 6c 3f 20 78 20 22 69 64 22 29 29 (equal? x "id"))
4870: 29 20 66 69 65 6c 64 73 29 29 0a 09 09 20 20 20 ) fields))...
4880: 20 28 66 69 65 6c 64 73 2d 73 74 72 20 28 73 74 (fields-str (st
4890: 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 ring-intersperse
48a0: 20 66 69 65 6c 64 73 20 22 2c 22 29 29 0a 09 09 fields ","))...
48b0: 20 20 20 20 28 6e 6f 2d 69 64 2d 66 69 65 6c 64 (no-id-field
48c0: 73 2d 73 74 72 20 28 73 74 72 69 6e 67 2d 69 6e s-str (string-in
48d0: 74 65 72 73 70 65 72 73 65 20 6e 6f 2d 69 64 2d tersperse no-id-
48e0: 66 69 65 6c 64 73 20 22 2c 22 29 29 0a 09 09 20 fields ","))...
48f0: 20 20 20 28 64 69 72 20 20 20 20 28 65 71 3f 20 (dir (eq?
4900: 64 69 72 65 63 74 69 6f 6e 20 27 74 6f 64 69 73 direction 'todis
4910: 6b 29 29 0a 09 09 20 20 20 20 28 66 72 6f 6d 64 k))... (fromd
4920: 62 20 28 69 66 20 64 69 72 20 22 6d 61 69 6e 2e b (if dir "main.
4930: 22 20 22 61 75 78 64 62 2e 22 29 29 0a 09 09 20 " "auxdb."))...
4940: 20 20 20 28 74 6f 64 62 20 20 20 28 69 66 20 64 (todb (if d
4950: 69 72 20 22 61 75 78 64 62 2e 22 20 22 6d 61 69 ir "auxdb." "mai
4960: 6e 2e 22 29 29 0a 09 09 20 20 20 20 28 73 65 74 n."))... (set
4970: 2d 73 74 72 20 28 73 74 72 69 6e 67 2d 69 6e 74 -str (string-int
4980: 65 72 73 70 65 72 73 65 0a 09 09 09 20 20 20 20 ersperse....
4990: 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 (map (lambda (
49a0: 66 69 65 6c 64 29 0a 09 09 09 09 20 20 20 20 20 field).....
49b0: 28 63 6f 6e 63 20 66 72 6f 6d 64 62 20 66 69 65 (conc fromdb fie
49c0: 6c 64 22 3d 22 74 6f 64 62 20 66 69 65 6c 64 29 ld"="todb field)
49d0: 29 0a 09 09 09 09 20 20 20 66 69 65 6c 64 73 29 )..... fields)
49e0: 0a 09 09 09 20 20 20 20 20 20 22 2c 22 29 29 0a .... ",")).
49f0: 09 09 20 20 20 20 28 73 74 6d 74 31 20 20 20 20 .. (stmt1
4a00: 20 20 28 63 6f 6e 63 20 22 49 4e 53 45 52 54 20 (conc "INSERT
4a10: 4f 52 20 49 47 4e 4f 52 45 20 49 4e 54 4f 20 22 OR IGNORE INTO "
4a20: 74 6f 64 62 20 74 61 62 6c 65 0a 09 09 09 09 20 todb table.....
4a30: 20 20 20 20 20 22 20 53 45 4c 45 43 54 20 2a 20 " SELECT *
4a40: 46 52 4f 4d 20 22 66 72 6f 6d 64 62 20 74 61 62 FROM "fromdb tab
4a50: 6c 65 22 3b 22 29 29 0a 09 09 20 20 20 20 28 73 le";"))... (s
4a60: 74 6d 74 32 20 20 20 20 20 20 28 63 6f 6e 63 20 tmt2 (conc
4a70: 22 49 4e 53 45 52 54 20 4f 52 20 49 47 4e 4f 52 "INSERT OR IGNOR
4a80: 45 20 49 4e 54 4f 20 22 74 6f 64 62 20 74 61 62 E INTO "todb tab
4a90: 6c 65 0a 09 09 09 09 20 20 20 20 20 20 22 20 53 le..... " S
4aa0: 45 4c 45 43 54 20 2a 20 46 52 4f 4d 20 22 66 72 ELECT * FROM "fr
4ab0: 6f 6d 64 62 20 74 61 62 6c 65 22 20 57 48 45 52 omdb table" WHER
4ac0: 45 20 22 66 72 6f 6d 64 62 20 74 61 62 6c 65 22 E "fromdb table"
4ad0: 2e 69 64 3d 3f 3b 22 29 29 0a 09 09 20 20 20 20 .id=?;"))...
4ae0: 28 73 74 6d 74 38 20 20 20 20 20 20 28 63 6f 6e (stmt8 (con
4af0: 63 20 22 55 50 44 41 54 45 20 22 74 6f 64 62 20 c "UPDATE "todb
4b00: 74 61 62 6c 65 22 20 53 45 54 20 28 22 6e 6f 2d table" SET ("no-
4b10: 69 64 2d 66 69 65 6c 64 73 2d 73 74 72 22 29 20 id-fields-str")
4b20: 3d 20 28 53 45 4c 45 43 54 20 22 6e 6f 2d 69 64 = (SELECT "no-id
4b30: 2d 66 69 65 6c 64 73 2d 73 74 72 22 20 46 52 4f -fields-str" FRO
4b40: 4d 20 22 66 72 6f 6d 64 62 20 74 61 62 6c 65 22 M "fromdb table"
4b50: 20 57 48 45 52 45 20 22 74 6f 64 62 20 74 61 62 WHERE "todb tab
4b60: 6c 65 22 2e 69 64 3d 22 66 72 6f 6d 64 62 20 74 le".id="fromdb t
4b70: 61 62 6c 65 22 2e 69 64 22 0a 09 09 09 09 20 20 able".id".....
4b80: 20 20 20 20 28 63 6f 6e 63 20 22 20 41 4e 44 20 (conc " AND
4b90: 22 66 72 6f 6d 64 62 20 74 61 62 6c 65 22 2e 6c "fromdb table".l
4ba0: 61 73 74 5f 75 70 64 61 74 65 20 3e 20 22 74 6f ast_update > "to
4bb0: 64 62 20 74 61 62 6c 65 22 2e 6c 61 73 74 5f 75 db table".last_u
4bc0: 70 64 61 74 65 29 3b 22 29 0a 09 09 09 09 20 20 pdate);").....
4bd0: 20 20 20 20 22 29 3b 22 29 29 0a 09 09 20 20 20 ");"))...
4be0: 20 28 73 74 6d 74 39 20 20 20 20 20 20 28 63 6f (stmt9 (co
4bf0: 6e 63 20 22 55 50 44 41 54 45 20 22 74 6f 64 62 nc "UPDATE "todb
4c00: 20 74 61 62 6c 65 22 20 53 45 54 20 28 22 6e 6f table" SET ("no
4c10: 2d 69 64 2d 66 69 65 6c 64 73 2d 73 74 72 22 29 -id-fields-str")
4c20: 20 3d 20 22 0a 09 09 09 09 20 20 20 20 20 20 22 = "..... "
4c30: 28 53 45 4c 45 43 54 20 22 6e 6f 2d 69 64 2d 66 (SELECT "no-id-f
4c40: 69 65 6c 64 73 2d 73 74 72 22 20 46 52 4f 4d 20 ields-str" FROM
4c50: 22 66 72 6f 6d 64 62 20 74 61 62 6c 65 22 20 57 "fromdb table" W
4c60: 48 45 52 45 20 22 66 72 6f 6d 64 62 20 74 61 62 HERE "fromdb tab
4c70: 6c 65 22 2e 69 64 3d 3f 29 22 0a 09 09 09 09 20 le".id=?)".....
4c80: 20 20 20 20 20 22 20 57 48 45 52 45 20 22 74 6f " WHERE "to
4c90: 64 62 20 74 61 62 6c 65 22 2e 69 64 3d 3f 22 29 db table".id=?")
4ca0: 29 0a 09 09 20 20 20 20 28 6e 65 77 72 65 63 20 )... (newrec
4cb0: 20 20 20 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 (conc "SELEC
4cc0: 54 20 69 64 20 46 52 4f 4d 20 22 66 72 6f 6d 64 T id FROM "fromd
4cd0: 62 20 74 61 62 6c 65 22 20 57 48 45 52 45 20 69 b table" WHERE i
4ce0: 64 20 4e 4f 54 20 49 4e 20 28 53 45 4c 45 43 54 d NOT IN (SELECT
4cf0: 20 69 64 20 46 52 4f 4d 20 22 74 6f 64 62 20 74 id FROM "todb t
4d00: 61 62 6c 65 22 29 3b 22 29 29 0a 09 09 20 20 20 able");"))...
4d10: 20 23 3b 28 63 68 61 6e 67 65 64 72 65 63 20 28 #;(changedrec (
4d20: 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 69 64 20 conc "SELECT id
4d30: 46 52 4f 4d 20 22 66 72 6f 6d 64 62 20 74 61 62 FROM "fromdb tab
4d40: 6c 65 22 20 57 48 45 52 45 20 22 66 72 6f 6d 64 le" WHERE "fromd
4d50: 62 20 74 61 62 6c 65 22 2e 6c 61 73 74 5f 75 70 b table".last_up
4d60: 64 61 74 65 20 3e 20 22 74 6f 64 62 20 74 61 62 date > "todb tab
4d70: 6c 65 22 2e 6c 61 73 74 5f 75 70 64 61 74 65 20 le".last_update
4d80: 41 4e 44 20 22 0a 09 09 20 20 20 20 66 72 6f 6d AND "... from
4d90: 64 62 20 74 61 62 6c 65 22 2e 69 64 3d 22 74 6f db table".id="to
4da0: 64 62 20 74 61 62 6c 65 22 2e 69 64 3b 22 29 29 db table".id;"))
4db0: 20 3b 3b 20 6d 61 69 6e 20 3d 20 66 72 6f 6d 64 ;; main = fromd
4dc0: 62 0a 09 09 20 20 20 20 28 63 68 61 6e 67 65 64 b... (changed
4dd0: 72 65 63 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 rec (conc "SELEC
4de0: 54 20 22 66 72 6f 6d 64 62 20 74 61 62 6c 65 22 T "fromdb table"
4df0: 2e 69 64 20 46 52 4f 4d 20 22 66 72 6f 6d 64 62 .id FROM "fromdb
4e00: 20 74 61 62 6c 65 22 20 6a 6f 69 6e 20 22 74 6f table" join "to
4e10: 64 62 20 74 61 62 6c 65 22 20 6f 6e 20 22 66 72 db table" on "fr
4e20: 6f 6d 64 62 20 74 61 62 6c 65 22 2e 69 64 3d 22 omdb table".id="
4e30: 74 6f 64 62 20 74 61 62 6c 65 22 2e 69 64 20 57 todb table".id W
4e40: 48 45 52 45 20 22 66 72 6f 6d 64 62 20 74 61 62 HERE "fromdb tab
4e50: 6c 65 22 2e 6c 61 73 74 5f 75 70 64 61 74 65 20 le".last_update
4e60: 3e 20 22 74 6f 64 62 20 74 61 62 6c 65 22 2e 6c > "todb table".l
4e70: 61 73 74 5f 75 70 64 61 74 65 3b 22 29 29 0a 20 ast_update;")).
4e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ea0: 20 20 20 3b 3b 20 53 45 4c 45 43 54 20 6d 61 69 ;; SELECT mai
4eb0: 6e 2e 74 65 73 74 73 2e 69 64 20 46 52 4f 4d 20 n.tests.id FROM
4ec0: 6d 61 69 6e 2e 74 65 73 74 73 20 6a 6f 69 6e 20 main.tests join
4ed0: 61 75 78 64 62 2e 74 65 73 74 73 20 6f 6e 20 6d auxdb.tests on m
4ee0: 61 69 6e 2e 74 65 73 74 73 2e 69 64 3d 61 75 78 ain.tests.id=aux
4ef0: 64 62 2e 74 65 73 74 73 2e 69 64 20 57 48 45 52 db.tests.id WHER
4f00: 45 20 6d 61 69 6e 2e 74 65 73 74 73 2e 6c 61 73 E main.tests.las
4f10: 74 5f 75 70 64 61 74 65 20 3e 20 61 75 78 64 62 t_update > auxdb
4f20: 2e 74 65 73 74 73 2e 6c 61 73 74 5f 75 70 64 61 .tests.last_upda
4f30: 74 65 3b 22 0a 09 09 20 20 20 20 28 73 74 61 72 te;"... (star
4f40: 74 2d 6d 73 20 20 20 28 63 75 72 72 65 6e 74 2d t-ms (current-
4f50: 6d 69 6c 6c 69 73 65 63 6f 6e 64 73 29 29 0a 09 milliseconds))..
4f60: 09 20 20 20 20 28 6e 65 77 2d 69 64 73 20 20 20 . (new-ids
4f70: 20 28 73 71 6c 69 74 65 33 3a 66 6f 6c 64 2d 72 (sqlite3:fold-r
4f80: 6f 77 20 28 6c 61 6d 62 64 61 20 28 72 65 73 20 ow (lambda (res
4f90: 69 64 29 28 63 6f 6e 73 20 69 64 20 72 65 73 29 id)(cons id res)
4fa0: 29 20 27 28 29 20 64 62 68 20 6e 65 77 72 65 63 ) '() dbh newrec
4fb0: 29 29 29 0a 09 20 20 20 20 20 20 20 3b 3b 20 28 ))).. ;; (
4fc0: 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 debug:print 0 *d
4fd0: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
4fe0: 20 22 47 6f 74 20 22 28 6c 65 6e 67 74 68 20 61 "Got "(length a
4ff0: 75 78 2d 69 64 73 29 22 20 69 6e 20 61 75 78 2d ux-ids)" in aux-
5000: 69 64 73 20 61 6e 64 20 22 28 6c 65 6e 67 74 68 ids and "(length
5010: 20 6d 61 69 6e 2d 69 64 73 29 22 20 69 6e 20 6d main-ids)" in m
5020: 61 69 6e 2d 69 64 73 22 29 0a 09 20 20 20 20 20 ain-ids")..
5030: 20 20 28 75 70 64 61 74 65 2d 63 68 61 6e 67 65 (update-change
5040: 64 20 28 6c 65 6e 67 74 68 20 6e 65 77 2d 69 64 d (length new-id
5050: 73 29 20 74 61 62 6c 65 20 22 6e 65 77 20 72 65 s) table "new re
5060: 63 6f 72 64 73 22 29 0a 09 20 20 20 20 20 20 20 cords")..
5070: 28 6d 75 74 65 78 2d 6c 6f 63 6b 21 20 2a 64 62 (mutex-lock! *db
5080: 2d 74 72 61 6e 73 61 63 74 69 6f 6e 2d 6d 75 74 -transaction-mut
5090: 65 78 2a 29 0a 09 20 20 20 20 20 20 20 28 68 61 ex*).. (ha
50a0: 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a ndle-exceptions.
50b0: 09 09 20 20 20 65 78 6e 0a 09 09 20 20 20 28 64 .. exn... (d
50c0: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
50d0: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
50e0: 22 54 72 61 6e 73 61 63 74 69 6f 6e 20 75 70 64 "Transaction upd
50f0: 61 74 65 20 6f 66 20 22 74 61 62 6c 65 22 20 66 ate of "table" f
5100: 61 69 6c 65 64 2e 20 22 28 63 6f 6e 64 69 74 69 ailed. "(conditi
5110: 6f 6e 2d 3e 6c 69 73 74 20 65 78 6e 29 29 0a 09 on->list exn))..
5120: 09 20 28 73 71 6c 69 74 65 33 3a 77 69 74 68 2d . (sqlite3:with-
5130: 74 72 61 6e 73 61 63 74 69 6f 6e 0a 09 09 20 20 transaction...
5140: 64 62 68 0a 09 09 20 20 28 6c 61 6d 62 64 61 20 dbh... (lambda
5150: 28 29 0a 09 09 20 20 20 20 28 66 6f 72 2d 65 61 ()... (for-ea
5160: 63 68 20 28 6c 61 6d 62 64 61 20 28 69 64 29 0a ch (lambda (id).
5170: 09 09 09 09 28 73 71 6c 69 74 65 33 3a 65 78 65 ....(sqlite3:exe
5180: 63 75 74 65 20 64 62 68 20 73 74 6d 74 32 20 69 cute dbh stmt2 i
5190: 64 29 29 0a 09 09 09 20 20 20 20 20 20 6e 65 77 d)).... new
51a0: 2d 69 64 73 29 29 29 29 0a 09 20 20 20 20 20 20 -ids))))..
51b0: 20 0a 09 20 20 20 20 20 20 20 28 69 66 20 28 6d .. (if (m
51c0: 65 6d 62 65 72 20 22 6c 61 73 74 5f 75 70 64 61 ember "last_upda
51d0: 74 65 22 20 66 69 65 6c 64 73 29 0a 09 09 20 20 te" fields)...
51e0: 20 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 (handle-excepti
51f0: 6f 6e 73 0a 09 09 20 20 20 20 20 20 20 65 78 6e ons... exn
5200: 0a 09 09 20 20 20 20 20 20 20 28 64 65 62 75 67 ... (debug
5210: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
5220: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 54 72 61 t-log-port* "Tra
5230: 6e 73 61 63 74 69 6f 6e 20 75 70 64 61 74 65 20 nsaction update
5240: 6f 66 20 22 74 61 62 6c 65 22 20 66 61 69 6c 65 of "table" faile
5250: 64 2e 20 22 28 63 6f 6e 64 69 74 69 6f 6e 2d 3e d. "(condition->
5260: 6c 69 73 74 20 65 78 6e 29 29 0a 09 09 20 20 20 list exn))...
5270: 20 20 28 73 71 6c 69 74 65 33 3a 77 69 74 68 2d (sqlite3:with-
5280: 74 72 61 6e 73 61 63 74 69 6f 6e 0a 09 09 20 20 transaction...
5290: 20 20 20 20 64 62 68 0a 09 09 20 20 20 20 20 20 dbh...
52a0: 28 6c 61 6d 62 64 61 20 28 29 0a 09 09 09 28 6c (lambda ()....(l
52b0: 65 74 2a 20 28 28 63 68 61 6e 67 65 64 2d 69 64 et* ((changed-id
52c0: 73 20 20 28 73 71 6c 69 74 65 33 3a 66 6f 6c 64 s (sqlite3:fold
52d0: 2d 72 6f 77 20 28 6c 61 6d 62 64 61 20 28 72 65 -row (lambda (re
52e0: 73 20 69 64 29 28 63 6f 6e 73 20 69 64 20 72 65 s id)(cons id re
52f0: 73 29 29 20 27 28 29 20 64 62 68 20 63 68 61 6e s)) '() dbh chan
5300: 67 65 64 72 65 63 29 29 29 0a 09 09 09 20 20 28 gedrec))).... (
5310: 75 70 64 61 74 65 2d 63 68 61 6e 67 65 64 20 28 update-changed (
5320: 6c 65 6e 67 74 68 20 63 68 61 6e 67 65 64 2d 69 length changed-i
5330: 64 73 29 20 74 61 62 6c 65 20 22 63 68 61 6e 67 ds) table "chang
5340: 65 64 20 72 65 63 6f 72 64 73 22 29 0a 09 09 09 ed records")....
5350: 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
5360: 62 64 61 20 28 69 64 29 0a 09 09 09 09 20 20 20 bda (id).....
5370: 20 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 (sqlite3:exec
5380: 75 74 65 20 64 62 68 20 73 74 6d 74 39 20 69 64 ute dbh stmt9 id
5390: 20 69 64 29 29 0a 09 09 09 09 20 20 20 20 63 68 id))..... ch
53a0: 61 6e 67 65 64 2d 69 64 73 29 29 29 29 29 29 0a anged-ids)))))).
53b0: 09 09 20 20 20 0a 09 20 20 20 20 20 20 20 28 6d .. .. (m
53c0: 75 74 65 78 2d 75 6e 6c 6f 63 6b 21 20 2a 64 62 utex-unlock! *db
53d0: 2d 74 72 61 6e 73 61 63 74 69 6f 6e 2d 6d 75 74 -transaction-mut
53e0: 65 78 2a 29 0a 09 20 20 20 20 20 20 20 0a 09 20 ex*).. ..
53f0: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
5400: 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f nt 0 *default-lo
5410: 67 2d 70 6f 72 74 2a 20 22 53 79 6e 63 65 64 20 g-port* "Synced
5420: 74 61 62 6c 65 20 22 74 61 62 6c 65 0a 09 20 20 table "table..
5430: 20 20 20 20 20 20 09 20 20 20 20 22 20 69 6e 20 . " in
5440: 22 28 2d 20 28 63 75 72 72 65 6e 74 2d 6d 69 6c "(- (current-mil
5450: 6c 69 73 65 63 6f 6e 64 73 29 20 73 74 61 72 74 liseconds) start
5460: 2d 6d 73 29 22 6d 73 22 29 0a 09 20 20 20 20 20 -ms)"ms")..
5470: 20 20 0a 09 20 20 20 20 20 20 20 29 29 0a 09 20 .. ))..
5480: 20 20 74 61 62 6c 65 2d 6e 61 6d 65 73 29 0a 09 table-names)..
5490: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
54a0: 74 65 20 64 62 68 20 22 44 45 54 41 43 48 20 61 te dbh "DETACH a
54b0: 75 78 64 62 3b 22 29 29 29 0a 20 20 20 20 6e 75 uxdb;"))). nu
54c0: 6d 2d 63 68 61 6e 67 65 73 29 29 0a 0a 3b 3b 20 m-changes))..;;
54d0: 70 72 65 66 69 78 20 69 73 20 22 22 20 6f 72 20 prefix is "" or
54e0: 22 61 75 78 64 62 2e 22 0a 3b 3b 0a 3b 3b 20 28 "auxdb.".;;.;; (
54f0: 64 65 66 69 6e 65 20 28 64 62 6d 6f 64 3a 6c 61 define (dbmod:la
5500: 73 74 2d 75 70 64 61 74 65 2d 70 61 74 63 68 20 st-update-patch
5510: 64 62 68 20 70 72 65 66 69 78 29 0a 3b 3b 20 20 dbh prefix).;;
5520: 20 28 6c 65 74 20 28 28 0a 20 20 0a 3b 3b 20 74 (let ((. .;; t
5530: 62 6c 73 20 69 73 20 28 20 28 22 74 61 62 6c 65 bls is ( ("table
5540: 6e 61 6d 65 22 20 28 20 22 66 69 65 6c 64 31 22 name" ( "field1"
5550: 20 5b 23 66 7c 70 72 6f 63 31 5d 20 29 20 28 20 [#f|proc1] ) (
5560: 22 66 69 65 6c 64 32 22 20 5b 23 66 7c 70 72 6f "field2" [#f|pro
5570: 63 32 5d 20 29 20 2e 2e 2e 2e 20 29 20 29 0a 3b c2] ) .... ) ).;
5580: 3b 0a 3b 3b 20 64 69 72 65 63 74 69 6f 6e 20 3d ;.;; direction =
5590: 20 66 72 6f 6d 64 65 73 74 2c 20 74 6f 64 65 73 fromdest, todes
55a0: 74 0a 3b 3b 20 6d 6f 64 65 20 3d 20 27 66 75 6c t.;; mode = 'ful
55b0: 6c 2c 20 27 69 6e 63 72 0a 3b 3b 0a 3b 3b 20 49 l, 'incr.;;.;; I
55c0: 64 65 61 3a 20 79 6f 75 6e 67 65 73 74 20 69 6e dea: youngest in
55d0: 20 64 65 73 74 20 69 73 20 6c 61 73 74 5f 75 70 dest is last_up
55e0: 64 61 74 65 20 74 69 6d 65 0a 3b 3b 0a 28 64 65 date time.;;.(de
55f0: 66 69 6e 65 20 28 64 62 6d 6f 64 3a 6e 65 77 2d fine (dbmod:new-
5600: 73 79 6e 63 20 74 61 62 6c 65 73 20 64 62 68 31 sync tables dbh1
5610: 20 64 62 68 32 20 64 65 73 74 64 62 66 69 6c 65 dbh2 destdbfile
5620: 20 64 69 72 65 63 74 69 6f 6e 20 23 21 6b 65 79 direction #!key
5630: 0a 09 09 09 20 20 20 28 6d 6f 64 65 20 27 66 75 .... (mode 'fu
5640: 6c 6c 29 29 0a 20 20 28 64 65 62 75 67 3a 70 72 ll)). (debug:pr
5650: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
5660: 6f 67 2d 70 6f 72 74 2a 20 22 44 6f 69 6e 67 20 og-port* "Doing
5670: 6e 65 77 2d 73 79 6e 63 20 22 64 69 72 65 63 74 new-sync "direct
5680: 69 6f 6e 22 20 22 64 65 73 74 64 62 66 69 6c 65 ion" "destdbfile
5690: 29 0a 20 20 28 69 66 20 28 6e 6f 74 20 28 73 71 ). (if (not (sq
56a0: 6c 69 74 65 33 3a 61 75 74 6f 2d 63 6f 6d 6d 69 lite3:auto-commi
56b0: 74 74 69 6e 67 3f 20 64 62 68 31 29 29 0a 20 20 tting? dbh1)).
56c0: 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 (debug:print
56d0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
56e0: 70 6f 72 74 2a 20 22 53 6b 69 70 70 69 6e 67 20 port* "Skipping
56f0: 73 79 6e 63 20 64 75 65 20 74 6f 20 74 72 61 6e sync due to tran
5700: 73 61 63 74 69 6f 6e 20 69 6e 20 66 6c 69 67 68 saction in fligh
5710: 74 2e 22 29 0a 20 20 20 20 20 20 28 6c 65 74 2a t."). (let*
5720: 20 28 28 74 61 62 6c 65 2d 6e 61 6d 65 73 20 20 ((table-names
5730: 28 6d 61 70 20 63 61 72 20 74 61 62 6c 65 73 29 (map car tables)
5740: 29 0a 09 20 20 20 20 20 28 64 65 73 74 2d 65 78 ).. (dest-ex
5750: 69 73 74 73 20 20 28 66 69 6c 65 2d 65 78 69 73 ists (file-exis
5760: 74 73 3f 20 64 65 73 74 64 62 66 69 6c 65 29 29 ts? destdbfile))
5770: 29 0a 09 28 61 73 73 65 72 74 20 64 65 73 74 2d )..(assert dest-
5780: 65 78 69 73 74 73 20 22 46 41 54 41 4c 3a 20 73 exists "FATAL: s
5790: 79 6e 63 20 63 61 6c 6c 65 64 20 77 69 74 68 20 ync called with
57a0: 6e 6f 6e 2d 65 78 69 73 74 61 6e 74 20 66 69 6c non-existant fil
57b0: 65 2c 20 22 64 65 73 74 64 62 66 69 6c 65 29 0a e, "destdbfile).
57c0: 09 28 66 6f 72 2d 65 61 63 68 0a 09 20 28 6c 61 .(for-each.. (la
57d0: 6d 62 64 61 20 28 74 61 62 6c 65 29 0a 09 20 20 mbda (table)..
57e0: 20 28 6c 65 74 2a 20 28 28 74 62 6c 64 61 74 20 (let* ((tbldat
57f0: 28 61 6c 69 73 74 2d 72 65 66 20 74 61 62 6c 65 (alist-ref table
5800: 20 74 61 62 6c 65 73 20 65 71 75 61 6c 3f 29 29 tables equal?))
5810: 0a 09 09 20 20 28 66 69 65 6c 64 73 20 28 6d 61 ... (fields (ma
5820: 70 20 63 61 72 20 74 62 6c 64 61 74 29 29 0a 09 p car tbldat))..
5830: 09 20 20 28 6e 6f 2d 69 64 2d 66 69 65 6c 64 73 . (no-id-fields
5840: 20 28 66 69 6c 74 65 72 20 28 6c 61 6d 62 64 61 (filter (lambda
5850: 20 28 78 29 28 6e 6f 74 20 28 65 71 75 61 6c 3f (x)(not (equal?
5860: 20 78 20 22 69 64 22 29 29 29 20 66 69 65 6c 64 x "id"))) field
5870: 73 29 29 0a 09 09 20 20 28 71 75 65 73 74 69 6f s))... (questio
5880: 6e 6d 61 72 6b 73 20 20 20 20 28 73 74 72 69 6e nmarks (strin
5890: 67 2d 69 6e 74 65 72 73 70 65 72 73 65 20 28 6d g-intersperse (m
58a0: 61 6b 65 2d 6c 69 73 74 20 28 6c 65 6e 67 74 68 ake-list (length
58b0: 20 6e 6f 2d 69 64 2d 66 69 65 6c 64 73 29 20 22 no-id-fields) "
58c0: 3f 22 29 20 22 2c 22 29 29 0a 09 09 20 20 28 66 ?") ","))... (f
58d0: 69 65 6c 64 73 2d 73 74 72 20 20 20 20 20 20 20 ields-str
58e0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
58f0: 72 73 65 20 66 69 65 6c 64 73 20 22 2c 22 29 29 rse fields ","))
5900: 0a 09 09 20 20 28 6e 6f 2d 69 64 2d 66 69 65 6c ... (no-id-fiel
5910: 64 73 2d 73 74 72 20 28 73 74 72 69 6e 67 2d 69 ds-str (string-i
5920: 6e 74 65 72 73 70 65 72 73 65 20 6e 6f 2d 69 64 ntersperse no-id
5930: 2d 66 69 65 6c 64 73 20 22 2c 22 29 29 0a 09 09 -fields ","))...
5940: 20 20 28 64 69 72 20 20 20 20 28 65 71 3f 20 64 (dir (eq? d
5950: 69 72 65 63 74 69 6f 6e 20 27 74 6f 64 65 73 74 irection 'todest
5960: 29 29 0a 09 09 20 20 28 66 72 6f 6d 64 62 20 28 ))... (fromdb (
5970: 69 66 20 64 69 72 20 64 62 68 31 20 64 62 68 32 if dir dbh1 dbh2
5980: 29 29 0a 09 09 20 20 28 74 6f 64 62 20 20 20 28 ))... (todb (
5990: 69 66 20 64 69 72 20 64 62 68 32 20 64 62 68 31 if dir dbh2 dbh1
59a0: 29 29 0a 09 09 20 20 28 73 65 74 2d 73 74 72 20 ))... (set-str
59b0: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
59c0: 72 73 65 0a 09 09 09 20 20 20 20 28 6d 61 70 20 rse.... (map
59d0: 28 6c 61 6d 62 64 61 20 28 66 69 65 6c 64 29 0a (lambda (field).
59e0: 09 09 09 09 20 20 20 28 63 6f 6e 63 20 66 72 6f .... (conc fro
59f0: 6d 64 62 20 66 69 65 6c 64 22 3d 22 74 6f 64 62 mdb field"="todb
5a00: 20 66 69 65 6c 64 29 29 0a 09 09 09 09 20 66 69 field))..... fi
5a10: 65 6c 64 73 29 0a 09 09 09 20 20 20 20 22 2c 22 elds).... ","
5a20: 29 29 0a 09 09 20 20 3b 3b 20 28 73 74 6d 74 31 ))... ;; (stmt1
5a30: 20 28 63 6f 6e 63 20 22 49 4e 53 45 52 54 20 4f (conc "INSERT O
5a40: 52 20 49 47 4e 4f 52 45 20 49 4e 54 4f 20 22 74 R IGNORE INTO "t
5a50: 6f 64 62 20 74 61 62 6c 65 0a 09 09 20 20 3b 3b odb table... ;;
5a60: 20 09 20 20 20 20 20 20 20 22 20 53 45 4c 45 43 . " SELEC
5a70: 54 20 2a 20 46 52 4f 4d 20 22 66 72 6f 6d 64 62 T * FROM "fromdb
5a80: 20 74 61 62 6c 65 22 3b 22 29 29 0a 09 09 20 20 table";"))...
5a90: 3b 3b 20 28 73 74 6d 74 38 20 28 63 6f 6e 63 20 ;; (stmt8 (conc
5aa0: 22 55 50 44 41 54 45 20 22 74 6f 64 62 20 74 61 "UPDATE "todb ta
5ab0: 62 6c 65 22 20 53 45 54 20 28 22 6e 6f 2d 69 64 ble" SET ("no-id
5ac0: 2d 66 69 65 6c 64 73 2d 73 74 72 22 29 20 3d 20 -fields-str") =
5ad0: 28 53 45 4c 45 43 54 20 22 6e 6f 2d 69 64 2d 66 (SELECT "no-id-f
5ae0: 69 65 6c 64 73 2d 73 74 72 22 20 46 52 4f 4d 20 ields-str" FROM
5af0: 22 66 72 6f 6d 64 62 20 74 61 62 6c 65 20 22 20 "fromdb table "
5b00: 57 48 45 52 45 20 22 74 6f 64 62 20 74 61 62 6c WHERE "todb tabl
5b10: 65 22 2e 69 64 3d 22 66 72 6f 6d 64 62 20 74 61 e".id="fromdb ta
5b20: 62 6c 65 22 2e 69 64 22 0a 09 09 20 20 3b 3b 20 ble".id"... ;;
5b30: 09 20 20 20 20 20 20 20 28 69 66 20 28 6d 65 6d . (if (mem
5b40: 62 65 72 20 22 6c 61 73 74 5f 75 70 64 61 74 65 ber "last_update
5b50: 22 20 66 69 65 6c 64 73 29 0a 09 09 20 20 3b 3b " fields)... ;;
5b60: 20 09 09 20 20 20 28 63 6f 6e 63 20 22 20 41 4e .. (conc " AN
5b70: 44 20 22 66 72 6f 6d 64 62 20 74 61 62 6c 65 22 D "fromdb table"
5b80: 2e 6c 61 73 74 5f 75 70 64 61 74 65 20 3e 20 22 .last_update > "
5b90: 74 6f 64 62 20 74 61 62 6c 65 22 2e 6c 61 73 74 todb table".last
5ba0: 5f 75 70 64 61 74 65 29 3b 22 29 0a 09 09 20 20 _update);")...
5bb0: 3b 3b 20 09 09 20 20 20 22 29 3b 22 29 29 29 0a ;; .. ");"))).
5bc0: 09 09 20 20 28 73 74 6d 74 31 20 20 20 20 28 63 .. (stmt1 (c
5bd0: 6f 6e 63 20 22 53 45 4c 45 43 54 20 4d 41 58 28 onc "SELECT MAX(
5be0: 6c 61 73 74 5f 75 70 64 61 74 65 29 20 46 52 4f last_update) FRO
5bf0: 4d 20 22 74 61 62 6c 65 22 3b 22 29 29 20 3b 3b M "table";")) ;;
5c00: 20 75 73 65 20 74 68 65 20 68 69 67 68 65 73 74 use the highest
5c10: 20 6c 61 73 74 5f 75 70 64 61 74 65 20 61 73 20 last_update as
5c20: 79 6f 75 72 20 74 69 6d 65 20 72 65 66 65 72 65 your time refere
5c30: 6e 63 65 0a 09 09 20 20 28 73 74 6d 74 32 20 20 nce... (stmt2
5c40: 20 20 28 63 6f 6e 63 20 22 53 45 4c 45 43 54 20 (conc "SELECT
5c50: 6e 6f 2d 69 64 2d 66 69 65 6c 64 73 2d 73 74 72 no-id-fields-str
5c60: 20 46 52 4f 4d 20 22 74 61 62 6c 65 22 20 57 48 FROM "table" WH
5c70: 45 52 45 20 6c 61 73 74 5f 75 70 64 61 74 65 3e ERE last_update>
5c80: 3f 3b 22 29 29 0a 09 09 20 20 28 73 74 6d 74 33 ?;"))... (stmt3
5c90: 20 20 20 20 28 63 6f 6e 63 20 22 55 50 44 41 54 (conc "UPDAT
5ca0: 45 20 22 74 61 62 6c 65 22 20 53 45 54 20 28 22 E "table" SET ("
5cb0: 6e 6f 2d 69 64 2d 66 69 65 6c 64 73 2d 73 74 72 no-id-fields-str
5cc0: 22 29 20 3d 20 28 22 71 75 65 73 74 69 6f 6e 6d ") = ("questionm
5cd0: 61 72 6b 73 22 29 20 57 48 45 52 45 20 69 64 3d arks") WHERE id=
5ce0: 3f 3b 22 29 29 0a 09 09 20 20 28 73 74 61 72 74 ?;"))... (start
5cf0: 2d 6d 73 20 28 63 75 72 72 65 6e 74 2d 6d 69 6c -ms (current-mil
5d00: 6c 69 73 65 63 6f 6e 64 73 29 29 29 0a 09 20 20 liseconds)))..
5d10: 20 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 (debug:print
5d20: 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 0 *default-log-p
5d30: 6f 72 74 2a 20 22 73 74 6d 74 33 3d 22 73 74 6d ort* "stmt3="stm
5d40: 74 33 29 0a 09 20 20 20 20 20 28 69 66 20 28 73 t3).. (if (s
5d50: 71 6c 69 74 65 33 3a 61 75 74 6f 2d 63 6f 6d 6d qlite3:auto-comm
5d60: 69 74 74 69 6e 67 3f 20 64 62 68 31 29 0a 09 09 itting? dbh1)...
5d70: 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 20 09 (begin. .
5d80: 20 20 20 20 20 20 20 20 20 20 20 28 68 61 6e 64 (hand
5d90: 6c 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 le-exceptions...
5da0: 20 20 20 20 20 65 78 6e 0a 09 09 20 20 20 20 20 exn...
5db0: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a (debug:print 0 *
5dc0: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
5dd0: 2a 20 22 54 72 61 6e 73 61 63 74 69 6f 6e 20 75 * "Transaction u
5de0: 70 64 61 74 65 20 6f 66 20 22 74 61 62 6c 65 22 pdate of "table"
5df0: 20 66 61 69 6c 65 64 2e 20 22 28 63 6f 6e 64 69 failed. "(condi
5e00: 74 69 6f 6e 2d 3e 6c 69 73 74 20 65 78 6e 29 29 tion->list exn))
5e10: 0a 09 09 20 20 20 20 20 28 73 71 6c 69 74 65 33 ... (sqlite3
5e20: 3a 77 69 74 68 2d 74 72 61 6e 73 61 63 74 69 6f :with-transactio
5e30: 6e 0a 09 09 20 20 20 20 20 20 64 62 68 31 0a 09 n... dbh1..
5e40: 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda (
5e50: 29 0a 09 09 20 20 20 20 20 20 20 20 28 73 71 6c )... (sql
5e60: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 68 ite3:execute dbh
5e70: 31 20 73 74 6d 74 31 29 20 20 20 20 3b 3b 20 67 1 stmt1) ;; g
5e80: 65 74 20 61 6c 6c 20 6e 65 77 20 72 6f 77 73 0a et all new rows.
5e90: 0a 09 09 20 20 20 20 20 20 23 3b 28 69 66 20 28 ... #;(if (
5ea0: 6d 65 6d 62 65 72 20 22 6c 61 73 74 5f 75 70 64 member "last_upd
5eb0: 61 74 65 22 20 66 69 65 6c 64 73 29 0a 09 09 09 ate" fields)....
5ec0: 20 20 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 (sqlite3:execu
5ed0: 74 65 20 64 62 68 31 20 73 74 6d 74 38 29 29 20 te dbh1 stmt8))
5ee0: 20 20 20 3b 3b 20 67 65 74 20 61 6c 6c 20 75 70 ;; get all up
5ef0: 64 61 74 65 64 20 72 6f 77 73 0a 09 09 20 20 20 dated rows...
5f00: 20 20 20 3b 3b 20 28 73 71 6c 69 74 65 33 3a 65 ;; (sqlite3:e
5f10: 78 65 63 75 74 65 20 64 62 68 20 73 74 6d 74 35 xecute dbh stmt5
5f20: 29 0a 09 09 20 20 20 20 20 20 3b 3b 20 28 73 71 )... ;; (sq
5f30: 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 lite3:execute db
5f40: 68 20 73 74 6d 74 34 29 20 3b 3b 20 69 66 20 69 h stmt4) ;; if i
5f50: 74 20 77 6f 72 6b 65 64 20 74 68 69 73 20 77 6f t worked this wo
5f60: 75 6c 64 20 62 65 20 62 65 74 74 65 72 20 66 6f uld be better fo
5f70: 72 20 69 6e 63 72 65 6d 65 6e 74 61 6c 20 75 70 r incremental up
5f80: 0a 09 09 20 20 20 20 20 20 3b 3b 20 28 73 71 6c ... ;; (sql
5f90: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 68 ite3:execute dbh
5fa0: 20 73 74 6d 74 36 29 0a 09 09 20 20 20 20 20 20 stmt6)...
5fb0: 29 29 29 0a 09 09 20 20 20 28 64 65 62 75 67 3a )))... (debug:
5fc0: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
5fd0: 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 53 79 6e 63 -log-port* "Sync
5fe0: 65 64 20 74 61 62 6c 65 20 22 74 61 62 6c 65 0a ed table "table.
5ff0: 09 09 09 09 22 20 69 6e 20 22 28 2d 20 28 63 75 ...." in "(- (cu
6000: 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 6f 6e rrent-millisecon
6010: 64 73 29 20 73 74 61 72 74 2d 6d 73 29 22 6d 73 ds) start-ms)"ms
6020: 22 29 29 0a 09 09 20 28 64 65 62 75 67 3a 70 72 "))... (debug:pr
6030: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
6040: 6f 67 2d 70 6f 72 74 2a 20 22 53 6b 69 70 70 69 og-port* "Skippi
6050: 6e 67 20 73 79 6e 63 20 6f 66 20 74 61 62 6c 65 ng sync of table
6060: 20 22 74 61 62 6c 65 22 20 64 75 65 20 74 6f 20 "table" due to
6070: 74 72 61 6e 73 61 63 74 69 6f 6e 20 69 6e 20 66 transaction in f
6080: 6c 69 67 68 74 2e 22 29 29 29 29 0a 09 20 74 61 light.")))).. ta
6090: 62 6c 65 2d 6e 61 6d 65 73 29 0a 09 28 73 71 6c ble-names)..(sql
60a0: 69 74 65 33 3a 65 78 65 63 75 74 65 20 64 62 68 ite3:execute dbh
60b0: 31 20 22 44 45 54 41 43 48 20 61 75 78 64 62 3b 1 "DETACH auxdb;
60c0: 22 29 29 29 29 0a 0a 0a 0a 0a 3b 3b 3d 3d 3d 3d ")))).....;;====
60d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
60e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
60f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6100: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6110: 3d 3d 0a 3b 3b 20 4d 6f 76 65 64 20 66 72 6f 6d ==.;; Moved from
6120: 20 64 62 66 69 6c 65 0a 3b 3b 3d 3d 3d 3d 3d 3d dbfile.;;======
6130: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6140: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6150: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6160: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6170: 0a 0a 3b 3b 20 77 61 69 74 20 75 70 20 74 6f 20 ..;; wait up to
6180: 61 70 72 6f 78 20 6e 20 73 65 63 6f 6e 64 73 20 aprox n seconds
6190: 66 6f 72 20 61 20 6a 6f 75 72 6e 61 6c 20 74 6f for a journal to
61a0: 20 67 6f 20 61 77 61 79 0a 3b 3b 0a 28 64 65 66 go away.;;.(def
61b0: 69 6e 65 20 28 74 61 73 6b 73 3a 77 61 69 74 2d ine (tasks:wait-
61c0: 6f 6e 2d 6a 6f 75 72 6e 61 6c 20 70 61 74 68 20 on-journal path
61d0: 6e 20 23 21 6b 65 79 20 28 72 65 6d 6f 76 65 20 n #!key (remove
61e0: 23 66 29 28 77 61 69 74 69 6e 67 2d 6d 73 67 20 #f)(waiting-msg
61f0: 23 66 29 29 0a 20 20 28 69 66 20 28 6e 6f 74 20 #f)). (if (not
6200: 28 73 74 72 69 6e 67 3f 20 70 61 74 68 29 29 0a (string? path)).
6210: 20 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 69 (debug:pri
6220: 6e 74 2d 65 72 72 6f 72 20 30 20 2a 64 65 66 61 nt-error 0 *defa
6230: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 43 ult-log-port* "C
6240: 61 6c 6c 65 64 20 74 61 73 6b 73 3a 77 61 69 74 alled tasks:wait
6250: 2d 6f 6e 2d 6a 6f 75 72 6e 61 6c 20 77 69 74 68 -on-journal with
6260: 20 70 61 74 68 3d 22 20 70 61 74 68 20 22 20 28 path=" path " (
6270: 6e 6f 74 20 61 20 73 74 72 69 6e 67 29 22 29 0a not a string)").
6280: 20 20 20 20 20 20 28 6c 65 74 20 28 28 66 75 6c (let ((ful
6290: 6c 70 61 74 68 20 28 63 6f 6e 63 20 70 61 74 68 lpath (conc path
62a0: 20 22 2d 6a 6f 75 72 6e 61 6c 22 29 29 29 0a 09 "-journal")))..
62b0: 28 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f (handle-exceptio
62c0: 6e 73 0a 09 20 65 78 6e 0a 09 20 28 62 65 67 69 ns.. exn.. (begi
62d0: 6e 0a 09 20 20 20 28 70 72 69 6e 74 2d 63 61 6c n.. (print-cal
62e0: 6c 2d 63 68 61 69 6e 20 28 63 75 72 72 65 6e 74 l-chain (current
62f0: 2d 65 72 72 6f 72 2d 70 6f 72 74 29 29 0a 09 20 -error-port))..
6300: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 20 30 (debug:print 0
6310: 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f *default-log-po
6320: 72 74 2a 20 22 20 6d 65 73 73 61 67 65 3a 20 22 rt* " message: "
6330: 20 28 28 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f ((condition-pro
6340: 70 65 72 74 79 2d 61 63 63 65 73 73 6f 72 20 27 perty-accessor '
6350: 65 78 6e 20 27 6d 65 73 73 61 67 65 29 20 65 78 exn 'message) ex
6360: 6e 29 29 0a 09 20 20 20 28 64 65 62 75 67 3a 70 n)).. (debug:p
6370: 72 69 6e 74 20 35 20 2a 64 65 66 61 75 6c 74 2d rint 5 *default-
6380: 6c 6f 67 2d 70 6f 72 74 2a 20 22 20 65 78 6e 3d log-port* " exn=
6390: 22 20 28 63 6f 6e 64 69 74 69 6f 6e 2d 3e 6c 69 " (condition->li
63a0: 73 74 20 65 78 6e 29 29 0a 09 20 20 20 28 64 65 st exn)).. (de
63b0: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
63c0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
63d0: 74 61 73 6b 73 3a 77 61 69 74 2d 6f 6e 2d 6a 6f tasks:wait-on-jo
63e0: 75 72 6e 61 6c 20 66 61 69 6c 65 64 2e 20 43 6f urnal failed. Co
63f0: 6e 74 69 6e 75 69 6e 67 20 6f 6e 2c 20 79 6f 75 ntinuing on, you
6400: 20 63 61 6e 20 69 67 6e 6f 72 65 20 74 68 69 73 can ignore this
6410: 20 63 61 6c 6c 2d 63 68 61 69 6e 22 29 0a 09 20 call-chain")..
6420: 20 20 23 74 29 20 3b 3b 20 69 66 20 73 74 75 66 #t) ;; if stuf
6430: 66 20 67 6f 65 73 20 77 72 6f 6e 67 20 6a 75 73 f goes wrong jus
6440: 74 20 61 6c 6c 6f 77 20 69 74 20 74 6f 20 6d 6f t allow it to mo
6450: 76 65 20 6f 6e 0a 09 20 28 6c 65 74 20 6c 6f 6f ve on.. (let loo
6460: 70 20 28 28 6a 6f 75 72 6e 61 6c 2d 65 78 69 73 p ((journal-exis
6470: 74 73 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f ts (file-exists?
6480: 20 66 75 6c 6c 70 61 74 68 29 29 0a 09 09 20 20 fullpath))...
6490: 20 20 28 63 6f 75 6e 74 20 20 20 20 20 20 20 20 (count
64a0: 20 20 6e 29 29 20 3b 3b 20 77 61 69 74 20 74 65 n)) ;; wait te
64b0: 6e 20 74 69 6d 65 73 20 2e 2e 2e 0a 09 20 20 20 n times .....
64c0: 28 69 66 20 6a 6f 75 72 6e 61 6c 2d 65 78 69 73 (if journal-exis
64d0: 74 73 0a 09 20 20 20 20 20 20 20 28 62 65 67 69 ts.. (begi
64e0: 6e 0a 09 09 20 28 69 66 20 28 61 6e 64 20 77 61 n... (if (and wa
64f0: 69 74 69 6e 67 2d 6d 73 67 0a 09 09 09 20 20 28 iting-msg.... (
6500: 65 71 3f 20 28 6d 6f 64 75 6c 6f 20 6e 20 33 30 eq? (modulo n 30
6510: 29 20 30 29 29 0a 09 09 20 20 20 20 20 28 64 65 ) 0))... (de
6520: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
6530: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 77 ault-log-port* w
6540: 61 69 74 69 6e 67 2d 6d 73 67 29 29 0a 09 09 20 aiting-msg))...
6550: 28 69 66 20 28 3e 20 63 6f 75 6e 74 20 30 29 0a (if (> count 0).
6560: 09 09 20 20 20 20 20 28 62 65 67 69 6e 0a 09 09 .. (begin...
6570: 20 20 20 20 20 20 20 28 74 68 72 65 61 64 2d 73 (thread-s
6580: 6c 65 65 70 21 20 31 29 0a 09 09 20 20 20 20 20 leep! 1)...
6590: 20 20 28 6c 6f 6f 70 20 28 66 69 6c 65 2d 65 78 (loop (file-ex
65a0: 69 73 74 73 3f 20 66 75 6c 6c 70 61 74 68 29 0a ists? fullpath).
65b0: 09 09 09 20 20 20 20 20 28 2d 20 63 6f 75 6e 74 ... (- count
65c0: 20 31 29 29 29 0a 09 09 20 20 20 20 20 28 62 65 1)))... (be
65d0: 67 69 6e 0a 09 09 20 20 20 20 20 20 20 28 64 65 gin... (de
65e0: 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 bug:print 0 *def
65f0: 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 ault-log-port* "
6600: 45 52 52 4f 52 3a 20 72 65 6d 6f 76 69 6e 67 20 ERROR: removing
6610: 74 68 65 20 6a 6f 75 72 6e 61 6c 20 66 69 6c 65 the journal file
6620: 20 22 20 66 75 6c 6c 70 61 74 68 20 22 2c 20 74 " fullpath ", t
6630: 68 69 73 20 69 73 20 6e 6f 74 20 67 6f 6f 64 2e his is not good.
6640: 20 4c 6f 6f 6b 20 66 6f 72 20 64 69 73 6b 20 66 Look for disk f
6650: 75 6c 6c 2c 20 77 72 69 74 65 20 61 63 63 65 73 ull, write acces
6660: 73 20 61 6e 64 20 6f 74 68 65 72 20 69 73 73 75 s and other issu
6670: 65 73 2e 22 29 0a 09 09 20 20 20 20 20 20 20 28 es.")... (
6680: 69 66 20 72 65 6d 6f 76 65 20 28 73 79 73 74 65 if remove (syste
6690: 6d 20 28 63 6f 6e 63 20 22 72 6d 20 2d 72 66 20 m (conc "rm -rf
66a0: 22 20 66 75 6c 6c 70 61 74 68 29 29 29 0a 09 09 " fullpath)))...
66b0: 20 20 20 20 20 20 20 23 66 29 29 29 0a 09 20 20 #f)))..
66c0: 20 20 20 20 20 23 74 29 29 29 29 29 29 0a 0a 0a #t))))))...
66d0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
66e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
66f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6710: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 4d 20 45 20 ========.;; M E
6720: 54 20 41 20 20 20 47 20 45 20 54 20 20 20 41 20 T A G E T A
6730: 4e 20 44 20 20 20 53 20 45 20 54 20 20 20 56 20 N D S E T V
6740: 41 20 52 20 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d A R S.;;========
6750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6770: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
6780: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a ==============..
6790: 3b 3b 20 72 65 74 75 72 6e 73 20 6e 75 6d 62 65 ;; returns numbe
67a0: 72 20 69 66 20 73 74 72 69 6e 67 2d 3e 6e 75 6d r if string->num
67b0: 62 65 72 20 69 73 20 73 75 63 63 65 73 73 66 75 ber is successfu
67c0: 6c 2c 20 73 74 72 69 6e 67 20 6f 74 68 65 72 77 l, string otherw
67d0: 69 73 65 0a 3b 3b 20 61 6c 73 6f 20 75 70 64 61 ise.;; also upda
67e0: 74 65 73 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c 74 tes *global-delt
67f0: 61 2a 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 64 a*.;;.(define (d
6800: 62 3a 67 65 74 2d 76 61 72 20 64 62 73 74 72 75 b:get-var dbstru
6810: 63 74 20 76 61 72 29 0a 20 20 28 6c 65 74 2a 20 ct var). (let*
6820: 28 28 72 65 73 20 20 20 20 20 20 23 66 29 29 0a ((res #f)).
6830: 20 20 20 20 28 64 62 3a 77 69 74 68 2d 64 62 0a (db:with-db.
6840: 20 20 20 20 20 64 62 73 74 72 75 63 74 20 23 66 dbstruct #f
6850: 20 23 66 20 20 3b 3b 20 66 6f 72 20 74 68 65 20 #f ;; for the
6860: 6d 6f 6d 65 6e 74 20 76 61 72 73 20 61 72 65 20 moment vars are
6870: 6f 6e 6c 79 20 73 74 6f 72 65 64 20 69 6e 20 6d only stored in m
6880: 61 69 6e 2e 64 62 0a 20 20 20 20 20 28 6c 61 6d ain.db. (lam
6890: 62 64 61 20 28 64 62 64 61 74 20 64 62 29 0a 20 bda (dbdat db).
68a0: 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 3a 66 (sqlite3:f
68b0: 6f 72 2d 65 61 63 68 2d 72 6f 77 0a 20 20 20 20 or-each-row.
68c0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 76 61 6c (lambda (val
68d0: 29 0a 20 20 20 20 20 20 20 20 20 20 28 73 65 74 ). (set
68e0: 21 20 72 65 73 20 76 61 6c 29 29 0a 20 20 20 20 ! res val)).
68f0: 20 20 20 20 64 62 0a 20 20 20 20 20 20 20 20 22 db. "
6900: 53 45 4c 45 43 54 20 76 61 6c 20 46 52 4f 4d 20 SELECT val FROM
6910: 6d 65 74 61 64 61 74 20 57 48 45 52 45 20 76 61 metadat WHERE va
6920: 72 3d 3f 3b 22 20 76 61 72 29 0a 20 20 20 20 20 r=?;" var).
6930: 20 20 3b 3b 20 63 6f 6e 76 65 72 74 20 74 6f 20 ;; convert to
6940: 6e 75 6d 62 65 72 20 69 66 20 63 61 6e 0a 20 20 number if can.
6950: 20 20 20 20 20 28 69 66 20 28 73 74 72 69 6e 67 (if (string
6960: 3f 20 72 65 73 29 0a 20 20 20 20 20 20 20 20 20 ? res).
6970: 20 20 28 6c 65 74 20 28 28 76 61 6c 6e 75 6d 20 (let ((valnum
6980: 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 (string->number
6990: 72 65 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 res))).
69a0: 20 20 20 20 28 69 66 20 76 61 6c 6e 75 6d 20 28 (if valnum (
69b0: 73 65 74 21 20 72 65 73 20 76 61 6c 6e 75 6d 29 set! res valnum)
69c0: 29 29 29 0a 20 20 20 20 20 20 20 72 65 73 29 29 ))). res))
69d0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a ))..(define (db:
69e0: 69 6e 63 2d 76 61 72 20 64 62 73 74 72 75 63 74 inc-var dbstruct
69f0: 20 76 61 72 29 0a 20 20 28 64 62 3a 77 69 74 68 var). (db:with
6a00: 2d 64 62 20 64 62 73 74 72 75 63 74 20 23 66 20 -db dbstruct #f
6a10: 23 74 20 0a 09 20 20 20 20 20 20 28 6c 61 6d 62 #t .. (lamb
6a20: 64 61 20 28 64 62 64 61 74 20 64 62 29 0a 09 09 da (dbdat db)...
6a30: 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 (sqlite3:execute
6a40: 20 64 62 20 22 55 50 44 41 54 45 20 6d 65 74 61 db "UPDATE meta
6a50: 64 61 74 20 53 45 54 20 76 61 6c 3d 76 61 6c 2b dat SET val=val+
6a60: 31 20 57 48 45 52 45 20 76 61 72 3d 3f 3b 22 20 1 WHERE var=?;"
6a70: 76 61 72 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 var))))..(define
6a80: 20 28 64 62 3a 64 65 63 2d 76 61 72 20 64 62 73 (db:dec-var dbs
6a90: 74 72 75 63 74 20 76 61 72 29 0a 20 20 28 64 62 truct var). (db
6aa0: 3a 77 69 74 68 2d 64 62 20 64 62 73 74 72 75 63 :with-db dbstruc
6ab0: 74 20 23 66 20 23 74 20 0a 09 20 20 20 20 20 20 t #f #t ..
6ac0: 28 6c 61 6d 62 64 61 20 28 64 62 64 61 74 20 64 (lambda (dbdat d
6ad0: 62 29 0a 09 09 28 73 71 6c 69 74 65 33 3a 65 78 b)...(sqlite3:ex
6ae0: 65 63 75 74 65 20 64 62 20 22 55 50 44 41 54 45 ecute db "UPDATE
6af0: 20 6d 65 74 61 64 61 74 20 53 45 54 20 76 61 6c metadat SET val
6b00: 3d 76 61 6c 2d 31 20 57 48 45 52 45 20 76 61 72 =val-1 WHERE var
6b10: 3d 3f 3b 22 20 76 61 72 29 29 29 29 0a 0a 3b 3b =?;" var))))..;;
6b20: 20 54 68 69 73 20 77 61 73 20 70 61 72 74 20 6f This was part o
6b30: 66 20 64 62 3a 67 65 74 2d 76 61 72 2e 20 49 74 f db:get-var. It
6b40: 20 77 61 73 20 75 73 65 64 20 74 6f 20 65 73 74 was used to est
6b50: 69 6d 61 74 65 20 74 68 65 20 6c 6f 61 64 20 6f imate the load o
6b60: 6e 0a 3b 3b 20 74 68 65 20 64 61 74 61 62 61 73 n.;; the databas
6b70: 65 20 66 69 6c 65 73 2e 0a 3b 3b 0a 3b 3b 20 73 e files..;;.;; s
6b80: 63 61 6c 65 20 62 79 20 31 30 2c 20 61 76 65 72 cale by 10, aver
6b90: 61 67 65 20 77 69 74 68 20 63 75 72 72 65 6e 74 age with current
6ba0: 20 76 61 6c 75 65 2e 0a 3b 3b 20 20 20 20 20 28 value..;; (
6bb0: 73 65 74 21 20 2a 67 6c 6f 62 61 6c 2d 64 65 6c set! *global-del
6bc0: 74 61 2a 20 28 2f 20 28 2b 20 2a 67 6c 6f 62 61 ta* (/ (+ *globa
6bd0: 6c 2d 64 65 6c 74 61 2a 20 28 2a 20 28 2d 20 28 l-delta* (* (- (
6be0: 63 75 72 72 65 6e 74 2d 6d 69 6c 6c 69 73 65 63 current-millisec
6bf0: 6f 6e 64 73 29 20 73 74 61 72 74 2d 6d 73 29 0a onds) start-ms).
6c00: 3b 3b 20 09 09 09 09 09 09 20 28 69 66 20 74 68 ;; ...... (if th
6c10: 72 6f 74 74 6c 65 20 74 68 72 6f 74 74 6c 65 20 rottle throttle
6c20: 30 2e 30 31 29 29 29 0a 3b 3b 20 09 09 09 20 20 0.01))).;; ...
6c30: 20 20 32 29 29 0a 3b 3b 20 20 20 20 20 28 69 66 2)).;; (if
6c40: 20 28 3e 20 28 61 62 73 20 28 2d 20 2a 6c 61 73 (> (abs (- *las
6c50: 74 2d 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2d 70 t-global-delta-p
6c60: 72 69 6e 74 65 64 2a 20 2a 67 6c 6f 62 61 6c 2d rinted* *global-
6c70: 64 65 6c 74 61 2a 29 29 20 30 2e 30 38 29 20 3b delta*)) 0.08) ;
6c80: 3b 20 64 6f 6e 27 74 20 70 72 69 6e 74 20 61 6c ; don't print al
6c90: 6c 20 74 68 65 20 74 69 6d 65 2c 20 6f 6e 6c 79 l the time, only
6ca0: 20 69 66 20 69 74 20 63 68 61 6e 67 65 73 20 61 if it changes a
6cb0: 20 62 69 74 0a 3b 3b 20 09 28 62 65 67 69 6e 0a bit.;; .(begin.
6cc0: 3b 3b 20 09 20 20 28 64 65 62 75 67 3a 70 72 69 ;; . (debug:pri
6cd0: 6e 74 2d 69 6e 66 6f 20 34 20 2a 64 65 66 61 75 nt-info 4 *defau
6ce0: 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 6c 61 lt-log-port* "la
6cf0: 75 6e 63 68 20 74 68 72 6f 74 74 6c 65 20 66 61 unch throttle fa
6d00: 63 74 6f 72 3d 22 20 2a 67 6c 6f 62 61 6c 2d 64 ctor=" *global-d
6d10: 65 6c 74 61 2a 29 0a 3b 3b 20 09 20 20 28 73 65 elta*).;; . (se
6d20: 74 21 20 2a 6c 61 73 74 2d 67 6c 6f 62 61 6c 2d t! *last-global-
6d30: 64 65 6c 74 61 2d 70 72 69 6e 74 65 64 2a 20 2a delta-printed* *
6d40: 67 6c 6f 62 61 6c 2d 64 65 6c 74 61 2a 29 29 29 global-delta*)))
6d50: 0a 0a 28 64 65 66 69 6e 65 20 28 64 62 3a 73 65 ..(define (db:se
6d60: 74 2d 76 61 72 20 64 62 73 74 72 75 63 74 20 76 t-var dbstruct v
6d70: 61 72 20 76 61 6c 29 0a 20 20 28 64 62 3a 77 69 ar val). (db:wi
6d80: 74 68 2d 64 62 20 64 62 73 74 72 75 63 74 20 23 th-db dbstruct #
6d90: 66 20 23 74 20 0a 09 20 20 20 20 20 20 28 6c 61 f #t .. (la
6da0: 6d 62 64 61 20 28 64 62 64 61 74 20 64 62 29 0a mbda (dbdat db).
6db0: 09 09 28 73 71 6c 69 74 65 33 3a 65 78 65 63 75 ..(sqlite3:execu
6dc0: 74 65 20 20 28 64 62 3a 67 65 74 2d 63 61 63 68 te (db:get-cach
6dd0: 65 2d 73 74 6d 74 68 20 64 62 64 61 74 20 64 62 e-stmth dbdat db
6de0: 20 22 49 4e 53 45 52 54 20 4f 52 20 52 45 50 4c "INSERT OR REPL
6df0: 41 43 45 20 49 4e 54 4f 20 6d 65 74 61 64 61 74 ACE INTO metadat
6e00: 20 28 76 61 72 2c 76 61 6c 29 20 56 41 4c 55 45 (var,val) VALUE
6e10: 53 20 28 3f 2c 3f 29 3b 22 29 0a 09 09 09 09 20 S (?,?);").....
6e20: 20 76 61 72 20 76 61 6c 29 29 29 29 0a 0a 28 64 var val))))..(d
6e30: 65 66 69 6e 65 20 28 64 62 3a 61 64 64 2d 76 61 efine (db:add-va
6e40: 72 20 64 62 73 74 72 75 63 74 20 76 61 72 20 76 r dbstruct var v
6e50: 61 6c 29 0a 20 20 28 64 62 3a 77 69 74 68 2d 64 al). (db:with-d
6e60: 62 20 64 62 73 74 72 75 63 74 20 23 66 20 23 74 b dbstruct #f #t
6e70: 20 0a 09 20 20 20 20 20 20 28 6c 61 6d 62 64 61 .. (lambda
6e80: 20 28 64 62 64 61 74 20 64 62 29 0a 09 09 28 73 (dbdat db)...(s
6e90: 71 6c 69 74 65 33 3a 65 78 65 63 75 74 65 20 20 qlite3:execute
6ea0: 28 64 62 3a 67 65 74 2d 63 61 63 68 65 2d 73 74 (db:get-cache-st
6eb0: 6d 74 68 20 64 62 64 61 74 20 64 62 20 22 55 50 mth dbdat db "UP
6ec0: 44 41 54 45 20 6d 65 74 61 64 61 74 20 53 45 54 DATE metadat SET
6ed0: 20 76 61 6c 3d 76 61 6c 2b 3f 20 57 48 45 52 45 val=val+? WHERE
6ee0: 20 76 61 72 3d 3f 3b 22 29 20 76 61 6c 20 76 61 var=?;") val va
6ef0: 72 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 r))))..(define (
6f00: 64 62 3a 64 65 6c 2d 76 61 72 20 64 62 73 74 72 db:del-var dbstr
6f10: 75 63 74 20 76 61 72 29 0a 20 20 28 64 62 3a 77 uct var). (db:w
6f20: 69 74 68 2d 64 62 20 64 62 73 74 72 75 63 74 20 ith-db dbstruct
6f30: 23 66 20 23 74 20 0a 09 20 20 20 20 20 20 28 6c #f #t .. (l
6f40: 61 6d 62 64 61 20 28 64 62 64 61 74 20 64 62 29 ambda (dbdat db)
6f50: 0a 09 09 28 73 71 6c 69 74 65 33 3a 65 78 65 63 ...(sqlite3:exec
6f60: 75 74 65 20 20 28 64 62 3a 67 65 74 2d 63 61 63 ute (db:get-cac
6f70: 68 65 2d 73 74 6d 74 68 20 64 62 64 61 74 20 64 he-stmth dbdat d
6f80: 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 6d b "DELETE FROM m
6f90: 65 74 61 64 61 74 20 57 48 45 52 45 20 76 61 72 etadat WHERE var
6fa0: 3d 3f 3b 22 29 20 76 61 72 29 29 29 29 0a 0a 28 =?;") var))))..(
6fb0: 64 65 66 69 6e 65 20 28 64 62 3a 67 65 74 2d 74 define (db:get-t
6fc0: 6f 70 6c 65 76 65 6c 73 2d 61 6e 64 2d 69 6e 63 oplevels-and-inc
6fd0: 6f 6d 70 6c 65 74 65 73 20 64 62 73 74 72 75 63 ompletes dbstruc
6fe0: 74 20 72 75 6e 2d 69 64 20 72 75 6e 6e 69 6e 67 t run-id running
6ff0: 2d 64 65 61 64 74 69 6d 65 20 72 65 6d 6f 74 65 -deadtime remote
7000: 68 6f 73 74 73 74 61 72 74 2d 64 65 61 64 74 69 hoststart-deadti
7010: 6d 65 29 0a 20 20 28 6c 65 74 2a 20 28 28 74 6f me). (let* ((to
7020: 70 6c 65 76 65 6c 73 20 20 20 27 28 29 29 0a 09 plevels '())..
7030: 20 28 6f 6c 64 6c 61 75 6e 63 68 65 64 20 27 28 (oldlaunched '(
7040: 29 29 0a 09 20 28 69 6e 63 6f 6d 70 6c 65 74 65 )).. (incomplete
7050: 64 20 27 28 29 29 29 0a 20 20 20 20 28 64 62 3a d '())). (db:
7060: 77 69 74 68 2d 64 62 20 0a 20 20 20 20 20 64 62 with-db . db
7070: 73 74 72 75 63 74 20 72 75 6e 2d 69 64 20 23 74 struct run-id #t
7080: 20 3b 3b 20 6e 6f 74 20 61 20 77 72 69 74 65 20 ;; not a write
7090: 62 75 74 20 70 72 6f 62 6c 65 6d 74 69 63 0a 20 but problemtic.
70a0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 64 62 64 (lambda (dbd
70b0: 61 74 20 64 62 29 0a 20 20 20 20 20 20 20 28 6c at db). (l
70c0: 65 74 2a 20 28 28 73 74 6d 74 68 31 20 28 64 62 et* ((stmth1 (db
70d0: 3a 67 65 74 2d 63 61 63 68 65 2d 73 74 6d 74 68 :get-cache-stmth
70e0: 0a 09 09 20 20 20 20 20 20 20 64 62 64 61 74 20 ... dbdat
70f0: 64 62 0a 09 09 20 20 20 20 20 20 20 22 53 45 4c db... "SEL
7100: 45 43 54 20 69 64 2c 72 75 6e 64 69 72 2c 75 6e ECT id,rundir,un
7110: 61 6d 65 2c 74 65 73 74 6e 61 6d 65 2c 69 74 65 ame,testname,ite
7120: 6d 5f 70 61 74 68 2c 65 76 65 6e 74 5f 74 69 6d m_path,event_tim
7130: 65 2c 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 46 e,run_duration F
7140: 52 4f 4d 20 74 65 73 74 73 20 0a 20 20 20 20 20 ROM tests .
7150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7160: 20 20 20 20 20 20 57 48 45 52 45 20 72 75 6e 5f WHERE run_
7170: 69 64 3d 3f 20 41 4e 44 20 28 73 74 72 66 74 69 id=? AND (strfti
7180: 6d 65 28 27 25 73 27 2c 27 6e 6f 77 27 29 20 2d me('%s','now') -
7190: 20 65 76 65 6e 74 5f 74 69 6d 65 29 20 3e 20 28 event_time) > (
71a0: 72 75 6e 5f 64 75 72 61 74 69 6f 6e 20 2b 20 3f run_duration + ?
71b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
71c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
71d0: 20 20 20 20 20 20 20 20 20 20 20 20 41 4e 44 20 AND
71e0: 73 74 61 74 65 20 49 4e 20 28 27 52 55 4e 4e 49 state IN ('RUNNI
71f0: 4e 47 27 29 3b 22 29 29 0a 09 20 20 20 20 20 20 NG');"))..
7200: 28 73 74 6d 74 68 32 20 28 64 62 3a 67 65 74 2d (stmth2 (db:get-
7210: 63 61 63 68 65 2d 73 74 6d 74 68 0a 09 09 20 20 cache-stmth...
7220: 20 20 20 20 20 64 62 64 61 74 20 64 62 0a 09 09 dbdat db...
7230: 20 20 20 20 20 20 20 22 53 45 4c 45 43 54 20 69 "SELECT i
7240: 64 2c 72 75 6e 64 69 72 2c 75 6e 61 6d 65 2c 74 d,rundir,uname,t
7250: 65 73 74 6e 61 6d 65 2c 69 74 65 6d 5f 70 61 74 estname,item_pat
7260: 68 2c 65 76 65 6e 74 5f 74 69 6d 65 2c 72 75 6e h,event_time,run
7270: 5f 64 75 72 61 74 69 6f 6e 20 46 52 4f 4d 20 74 _duration FROM t
7280: 65 73 74 73 20 0a 20 20 20 20 20 20 20 20 20 20 ests .
7290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
72a0: 20 57 48 45 52 45 20 72 75 6e 5f 69 64 3d 3f 20 WHERE run_id=?
72b0: 41 4e 44 20 28 73 74 72 66 74 69 6d 65 28 27 25 AND (strftime('%
72c0: 73 27 2c 27 6e 6f 77 27 29 20 2d 20 65 76 65 6e s','now') - even
72d0: 74 5f 74 69 6d 65 29 20 3e 20 28 72 75 6e 5f 64 t_time) > (run_d
72e0: 75 72 61 74 69 6f 6e 20 2b 20 3f 29 0a 20 20 20 uration + ?).
72f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7310: 20 20 20 20 20 20 20 41 4e 44 20 73 74 61 74 65 AND state
7320: 20 49 4e 20 28 27 52 45 4d 4f 54 45 48 4f 53 54 IN ('REMOTEHOST
7330: 53 54 41 52 54 27 29 3b 22 29 29 0a 09 20 20 20 START');"))..
7340: 20 20 20 28 73 74 6d 74 68 33 20 28 64 62 3a 67 (stmth3 (db:g
7350: 65 74 2d 63 61 63 68 65 2d 73 74 6d 74 68 0a 09 et-cache-stmth..
7360: 09 20 20 20 20 20 20 20 64 62 64 61 74 20 64 62 . dbdat db
7370: 0a 09 09 20 20 20 20 20 20 20 22 53 45 4c 45 43 ... "SELEC
7380: 54 20 69 64 2c 72 75 6e 64 69 72 2c 75 6e 61 6d T id,rundir,unam
7390: 65 2c 74 65 73 74 6e 61 6d 65 2c 69 74 65 6d 5f e,testname,item_
73a0: 70 61 74 68 20 46 52 4f 4d 20 74 65 73 74 73 0a path FROM tests.
73b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
73c0: 20 20 20 20 20 20 20 20 20 20 20 57 48 45 52 45 WHERE
73d0: 20 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 28 73 run_id=? AND (s
73e0: 74 72 66 74 69 6d 65 28 27 25 73 27 2c 27 6e 6f trftime('%s','no
73f0: 77 27 29 20 2d 20 65 76 65 6e 74 5f 74 69 6d 65 w') - event_time
7400: 29 20 3e 20 38 36 34 30 30 0a 20 20 20 20 20 20 ) > 86400.
7410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7430: 20 20 20 20 41 4e 44 20 73 74 61 74 65 20 49 4e AND state IN
7440: 20 28 27 4c 41 55 4e 43 48 45 44 27 29 3b 22 29 ('LAUNCHED');")
7450: 29 29 0a 09 20 3b 3b 20 69 6e 20 52 55 4e 4e 49 )).. ;; in RUNNI
7460: 4e 47 20 6f 72 20 52 45 4d 4f 54 45 48 4f 53 54 NG or REMOTEHOST
7470: 53 54 41 52 54 20 66 6f 72 20 6d 6f 72 65 20 74 START for more t
7480: 68 61 6e 20 31 30 20 6d 69 6e 75 74 65 73 0a 09 han 10 minutes..
7490: 20 3b 3b 0a 09 20 3b 3b 20 48 4f 57 45 56 45 52 ;;.. ;; HOWEVER
74a0: 3a 20 74 68 69 73 20 63 6f 64 65 20 69 6e 20 72 : this code in r
74b0: 75 6e 3a 74 65 73 74 20 73 65 65 6d 73 20 74 6f un:test seems to
74c0: 20 77 6f 72 6b 20 66 69 6e 65 0a 09 20 3b 3b 20 work fine.. ;;
74d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 3e 20 (>
74e0: 28 2d 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f (- (current-seco
74f0: 6e 64 73 29 28 2b 20 28 64 62 3a 74 65 73 74 2d nds)(+ (db:test-
7500: 67 65 74 2d 65 76 65 6e 74 5f 74 69 6d 65 20 74 get-event_time t
7510: 65 73 74 64 61 74 29 0a 09 20 3b 3b 20 20 20 20 estdat).. ;;
7520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7530: 20 28 64 62 3a 74 65 73 74 2d 67 65 74 2d 72 75 (db:test-get-ru
7540: 6e 5f 64 75 72 61 74 69 6f 6e 20 74 65 73 74 64 n_duration testd
7550: 61 74 29 29 29 0a 09 20 3b 3b 20 20 20 20 20 20 at))).. ;;
7560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 36 30 60
7570: 30 29 20 0a 09 20 28 73 71 6c 69 74 65 33 3a 66 0) .. (sqlite3:f
7580: 6f 72 2d 65 61 63 68 2d 72 6f 77 20 0a 09 20 20 or-each-row ..
7590: 28 6c 61 6d 62 64 61 20 28 74 65 73 74 2d 69 64 (lambda (test-id
75a0: 20 72 75 6e 2d 64 69 72 20 75 6e 61 6d 65 20 74 run-dir uname t
75b0: 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 estname item-pat
75c0: 68 20 65 76 65 6e 74 2d 74 69 6d 65 20 72 75 6e h event-time run
75d0: 2d 64 75 72 61 74 69 6f 6e 29 0a 09 20 20 20 20 -duration)..
75e0: 28 69 66 20 28 61 6e 64 20 28 65 71 75 61 6c 3f (if (and (equal?
75f0: 20 75 6e 61 6d 65 20 22 6e 2f 61 22 29 0a 09 09 uname "n/a")...
7600: 20 20 20 20 20 28 65 71 75 61 6c 3f 20 69 74 65 (equal? ite
7610: 6d 2d 70 61 74 68 20 22 22 29 29 20 3b 3b 20 74 m-path "")) ;; t
7620: 68 69 73 20 69 73 20 61 20 74 6f 70 6c 65 76 65 his is a topleve
7630: 6c 20 74 65 73 74 0a 09 09 3b 3b 20 77 68 61 74 l test...;; what
7640: 20 74 6f 20 64 6f 20 77 69 74 68 20 74 6f 70 6c to do with topl
7650: 65 76 65 6c 3f 20 63 61 6c 6c 20 72 6f 6c 6c 75 evel? call rollu
7660: 70 3f 0a 09 09 28 62 65 67 69 6e 0a 09 09 20 20 p?...(begin...
7670: 28 73 65 74 21 20 74 6f 70 6c 65 76 65 6c 73 20 (set! toplevels
7680: 20 20 28 63 6f 6e 73 20 28 6c 69 73 74 20 74 65 (cons (list te
7690: 73 74 2d 69 64 20 72 75 6e 2d 64 69 72 20 75 6e st-id run-dir un
76a0: 61 6d 65 20 74 65 73 74 6e 61 6d 65 20 69 74 65 ame testname ite
76b0: 6d 2d 70 61 74 68 20 72 75 6e 2d 69 64 29 20 74 m-path run-id) t
76c0: 6f 70 6c 65 76 65 6c 73 29 29 0a 09 09 20 20 28 oplevels))... (
76d0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
76e0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
76f0: 70 6f 72 74 2a 20 22 46 6f 75 6e 64 20 6f 6c 64 port* "Found old
7700: 20 74 6f 70 6c 65 76 65 6c 20 74 65 73 74 20 69 toplevel test i
7710: 6e 20 52 55 4e 4e 49 4e 47 20 73 74 61 74 65 2c n RUNNING state,
7720: 20 74 65 73 74 2d 69 64 3d 22 20 74 65 73 74 2d test-id=" test-
7730: 69 64 29 29 0a 09 09 28 62 65 67 69 6e 0a 09 09 id))...(begin...
7740: 20 20 28 73 65 74 21 20 69 6e 63 6f 6d 70 6c 65 (set! incomple
7750: 74 65 64 20 28 63 6f 6e 73 20 28 6c 69 73 74 20 ted (cons (list
7760: 74 65 73 74 2d 69 64 20 72 75 6e 2d 64 69 72 20 test-id run-dir
7770: 75 6e 61 6d 65 20 74 65 73 74 6e 61 6d 65 20 69 uname testname i
7780: 74 65 6d 2d 70 61 74 68 20 72 75 6e 2d 69 64 29 tem-path run-id)
7790: 20 69 6e 63 6f 6d 70 6c 65 74 65 64 29 29 0a 09 incompleted))..
77a0: 09 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d . (debug:print-
77b0: 69 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d info 0 *default-
77c0: 6c 6f 67 2d 70 6f 72 74 2a 20 22 46 6f 75 6e 64 log-port* "Found
77d0: 20 6f 6c 64 20 74 65 73 74 20 69 6e 20 52 55 4e old test in RUN
77e0: 4e 49 4e 47 20 73 74 61 74 65 2c 20 74 65 73 74 NING state, test
77f0: 2d 69 64 3d 22 0a 09 09 09 09 20 20 20 20 74 65 -id="..... te
7800: 73 74 2d 69 64 22 20 65 78 63 65 65 64 65 64 20 st-id" exceeded
7810: 72 75 6e 6e 69 6e 67 2d 64 65 61 64 74 69 6d 65 running-deadtime
7820: 20 22 72 75 6e 6e 69 6e 67 2d 64 65 61 64 74 69 "running-deadti
7830: 6d 65 22 20 6e 6f 77 3d 22 28 63 75 72 72 65 6e me" now="(curren
7840: 74 2d 73 65 63 6f 6e 64 73 29 0a 09 09 09 09 20 t-seconds).....
7850: 20 20 20 22 20 65 76 65 6e 74 2d 74 69 6d 65 3d " event-time=
7860: 22 65 76 65 6e 74 2d 74 69 6d 65 22 20 72 75 6e "event-time" run
7870: 2d 64 75 72 61 74 69 6f 6e 3d 22 72 75 6e 2d 64 -duration="run-d
7880: 75 72 61 74 69 6f 6e 29 29 29 29 0a 09 20 20 73 uration)))).. s
7890: 74 6d 74 68 31 0a 09 20 20 72 75 6e 2d 69 64 20 tmth1.. run-id
78a0: 72 75 6e 6e 69 6e 67 2d 64 65 61 64 74 69 6d 65 running-deadtime
78b0: 29 20 3b 3b 20 64 65 66 61 75 6c 74 20 74 69 6d ) ;; default tim
78c0: 65 20 37 32 30 20 73 65 63 6f 6e 64 73 0a 09 20 e 720 seconds..
78d0: 0a 09 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 2d .. (sqlite3:for-
78e0: 65 61 63 68 2d 72 6f 77 20 0a 09 20 20 28 6c 61 each-row .. (la
78f0: 6d 62 64 61 20 28 74 65 73 74 2d 69 64 20 72 75 mbda (test-id ru
7900: 6e 2d 64 69 72 20 75 6e 61 6d 65 20 74 65 73 74 n-dir uname test
7910: 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 65 name item-path e
7920: 76 65 6e 74 2d 74 69 6d 65 20 72 75 6e 2d 64 75 vent-time run-du
7930: 72 61 74 69 6f 6e 29 0a 09 20 20 20 20 28 69 66 ration).. (if
7940: 20 28 61 6e 64 20 28 65 71 75 61 6c 3f 20 75 6e (and (equal? un
7950: 61 6d 65 20 22 6e 2f 61 22 29 0a 09 09 20 20 20 ame "n/a")...
7960: 20 20 28 65 71 75 61 6c 3f 20 69 74 65 6d 2d 70 (equal? item-p
7970: 61 74 68 20 22 22 29 29 20 3b 3b 20 74 68 69 73 ath "")) ;; this
7980: 20 69 73 20 61 20 74 6f 70 6c 65 76 65 6c 20 74 is a toplevel t
7990: 65 73 74 0a 09 09 3b 3b 20 77 68 61 74 20 74 6f est...;; what to
79a0: 20 64 6f 20 77 69 74 68 20 74 6f 70 6c 65 76 65 do with topleve
79b0: 6c 3f 20 63 61 6c 6c 20 72 6f 6c 6c 75 70 3f 0a l? call rollup?.
79c0: 09 09 28 62 65 67 69 6e 0a 09 09 20 20 28 73 65 ..(begin... (se
79d0: 74 21 20 74 6f 70 6c 65 76 65 6c 73 20 20 20 28 t! toplevels (
79e0: 63 6f 6e 73 20 28 6c 69 73 74 20 74 65 73 74 2d cons (list test-
79f0: 69 64 20 72 75 6e 2d 64 69 72 20 75 6e 61 6d 65 id run-dir uname
7a00: 20 74 65 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 testname item-p
7a10: 61 74 68 20 72 75 6e 2d 69 64 29 20 74 6f 70 6c ath run-id) topl
7a20: 65 76 65 6c 73 29 29 0a 09 09 20 20 28 64 65 62 evels))... (deb
7a30: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 30 20 ug:print-info 0
7a40: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
7a50: 74 2a 20 22 46 6f 75 6e 64 20 6f 6c 64 20 74 6f t* "Found old to
7a60: 70 6c 65 76 65 6c 20 74 65 73 74 20 69 6e 20 52 plevel test in R
7a70: 55 4e 4e 49 4e 47 20 73 74 61 74 65 2c 20 74 65 UNNING state, te
7a80: 73 74 2d 69 64 3d 22 20 74 65 73 74 2d 69 64 29 st-id=" test-id)
7a90: 29 0a 09 09 28 62 65 67 69 6e 0a 09 09 20 20 28 )...(begin... (
7aa0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
7ab0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
7ac0: 70 6f 72 74 2a 20 22 46 6f 75 6e 64 20 6f 6c 64 port* "Found old
7ad0: 20 74 65 73 74 20 69 6e 20 52 45 4d 4f 54 45 48 test in REMOTEH
7ae0: 4f 53 54 53 54 41 52 54 20 73 74 61 74 65 2c 20 OSTSTART state,
7af0: 74 65 73 74 2d 69 64 3d 22 20 74 65 73 74 2d 69 test-id=" test-i
7b00: 64 0a 09 09 09 09 20 20 20 20 22 20 65 78 63 65 d..... " exce
7b10: 65 64 65 64 20 72 75 6e 6e 69 6e 67 2d 64 65 61 eded running-dea
7b20: 64 74 69 6d 65 20 22 72 75 6e 6e 69 6e 67 2d 64 dtime "running-d
7b30: 65 61 64 74 69 6d 65 22 20 6e 6f 77 3d 22 28 63 eadtime" now="(c
7b40: 75 72 72 65 6e 74 2d 73 65 63 6f 6e 64 73 29 22 urrent-seconds)"
7b50: 20 65 76 65 6e 74 2d 74 69 6d 65 3d 22 65 76 65 event-time="eve
7b60: 6e 74 2d 74 69 6d 65 0a 09 09 09 09 20 20 20 20 nt-time.....
7b70: 22 20 72 75 6e 2d 64 75 72 61 74 69 6f 6e 3d 22 " run-duration="
7b80: 72 75 6e 2d 64 75 72 61 74 69 6f 6e 29 0a 09 09 run-duration)...
7b90: 20 20 28 73 65 74 21 20 69 6e 63 6f 6d 70 6c 65 (set! incomple
7ba0: 74 65 64 20 28 63 6f 6e 73 20 28 6c 69 73 74 20 ted (cons (list
7bb0: 74 65 73 74 2d 69 64 20 72 75 6e 2d 64 69 72 20 test-id run-dir
7bc0: 75 6e 61 6d 65 20 74 65 73 74 6e 61 6d 65 20 69 uname testname i
7bd0: 74 65 6d 2d 70 61 74 68 20 72 75 6e 2d 69 64 29 tem-path run-id)
7be0: 20 69 6e 63 6f 6d 70 6c 65 74 65 64 29 29 29 29 incompleted))))
7bf0: 29 0a 09 20 20 73 74 6d 74 68 32 0a 09 20 20 72 ).. stmth2.. r
7c00: 75 6e 2d 69 64 20 72 65 6d 6f 74 65 68 6f 73 74 un-id remotehost
7c10: 73 74 61 72 74 2d 64 65 61 64 74 69 6d 65 29 20 start-deadtime)
7c20: 3b 3b 20 64 65 66 61 75 6c 74 20 74 69 6d 65 20 ;; default time
7c30: 32 33 30 20 73 65 63 6f 6e 64 73 0a 09 20 0a 09 230 seconds.. ..
7c40: 20 3b 3b 20 69 6e 20 4c 41 55 4e 43 48 45 44 20 ;; in LAUNCHED
7c50: 66 6f 72 20 6d 6f 72 65 20 74 68 61 6e 20 6f 6e for more than on
7c60: 65 20 64 61 79 2e 20 43 6f 75 6c 64 20 62 65 20 e day. Could be
7c70: 6c 6f 6e 67 20 64 75 65 20 74 6f 20 6a 6f 62 20 long due to job
7c80: 71 75 65 75 65 73 20 54 4f 44 4f 2f 42 55 47 3a queues TODO/BUG:
7c90: 20 4e 65 65 64 20 6f 76 65 72 72 69 64 65 20 66 Need override f
7ca0: 6f 72 20 74 68 69 73 20 69 6e 20 63 6f 6e 66 69 or this in confi
7cb0: 67 0a 09 20 28 73 71 6c 69 74 65 33 3a 66 6f 72 g.. (sqlite3:for
7cc0: 2d 65 61 63 68 2d 72 6f 77 0a 09 20 20 28 6c 61 -each-row.. (la
7cd0: 6d 62 64 61 20 28 74 65 73 74 2d 69 64 20 72 75 mbda (test-id ru
7ce0: 6e 2d 64 69 72 20 75 6e 61 6d 65 20 74 65 73 74 n-dir uname test
7cf0: 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 29 0a name item-path).
7d00: 09 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 65 . (if (and (e
7d10: 71 75 61 6c 3f 20 75 6e 61 6d 65 20 22 6e 2f 61 qual? uname "n/a
7d20: 22 29 0a 09 09 20 20 20 20 20 28 65 71 75 61 6c ")... (equal
7d30: 3f 20 69 74 65 6d 2d 70 61 74 68 20 22 22 29 29 ? item-path ""))
7d40: 20 3b 3b 20 74 68 69 73 20 69 73 20 61 20 74 6f ;; this is a to
7d50: 70 6c 65 76 65 6c 20 74 65 73 74 0a 09 09 3b 3b plevel test...;;
7d60: 20 77 68 61 74 20 74 6f 20 64 6f 20 77 69 74 68 what to do with
7d70: 20 74 6f 70 6c 65 76 65 6c 3f 20 63 61 6c 6c 20 toplevel? call
7d80: 72 6f 6c 6c 75 70 3f 0a 09 09 28 73 65 74 21 20 rollup?...(set!
7d90: 74 6f 70 6c 65 76 65 6c 73 20 20 20 28 63 6f 6e toplevels (con
7da0: 73 20 28 6c 69 73 74 20 74 65 73 74 2d 69 64 20 s (list test-id
7db0: 72 75 6e 2d 64 69 72 20 75 6e 61 6d 65 20 74 65 run-dir uname te
7dc0: 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 stname item-path
7dd0: 20 72 75 6e 2d 69 64 29 20 74 6f 70 6c 65 76 65 run-id) topleve
7de0: 6c 73 29 29 0a 09 09 28 62 65 67 69 6e 0a 09 09 ls))...(begin...
7df0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
7e00: 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 0 *default-l
7e10: 6f 67 2d 70 6f 72 74 2a 20 22 46 6f 75 6e 64 20 og-port* "Found
7e20: 6f 6c 64 20 74 65 73 74 20 69 6e 20 4c 41 55 4e old test in LAUN
7e30: 43 48 45 44 20 73 74 61 74 65 2c 20 74 65 73 74 CHED state, test
7e40: 2d 69 64 3d 22 20 74 65 73 74 2d 69 64 0a 09 09 -id=" test-id...
7e50: 09 09 20 20 20 20 22 20 31 20 64 61 79 20 73 69 .. " 1 day si
7e60: 6e 63 65 20 65 76 65 6e 74 5f 74 69 6d 65 20 6d nce event_time m
7e70: 61 72 6b 65 64 22 29 0a 20 20 20 20 20 20 20 20 arked").
7e80: 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 (set!
7e90: 6f 6c 64 6c 61 75 6e 63 68 65 64 20 28 63 6f 6e oldlaunched (con
7ea0: 73 20 28 6c 69 73 74 20 74 65 73 74 2d 69 64 20 s (list test-id
7eb0: 72 75 6e 2d 64 69 72 20 75 6e 61 6d 65 20 74 65 run-dir uname te
7ec0: 73 74 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 stname item-path
7ed0: 20 72 75 6e 2d 69 64 29 20 6f 6c 64 6c 61 75 6e run-id) oldlaun
7ee0: 63 68 65 64 29 29 29 29 29 0a 09 20 20 73 74 6d ched))))).. stm
7ef0: 74 68 33 0a 09 20 20 72 75 6e 2d 69 64 29 29 29 th3.. run-id)))
7f00: 29 0a 20 20 20 20 28 6c 69 73 74 20 69 6e 63 6f ). (list inco
7f10: 6d 70 6c 65 74 65 64 20 6f 6c 64 6c 61 75 6e 63 mpleted oldlaunc
7f20: 68 65 64 20 74 6f 70 6c 65 76 65 6c 73 29 29 29 hed toplevels)))
7f30: 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
7f40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7f50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7f60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7f70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 64 62 ==========.;; db
7f80: 20 74 6f 20 64 62 20 73 79 6e 63 0a 3b 3b 3d 3d to db sync.;;==
7f90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7fa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7fb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7fc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
7fd0: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 20 28 64 ====..(define (d
7fe0: 62 6d 6f 64 3a 64 62 2d 74 6f 2d 64 62 2d 73 79 bmod:db-to-db-sy
7ff0: 6e 63 20 73 72 63 2d 64 62 20 64 65 73 74 2d 64 nc src-db dest-d
8000: 62 20 6c 61 73 74 2d 75 70 64 61 74 65 20 69 6e b last-update in
8010: 69 74 2d 70 72 6f 63 20 6b 65 79 73 29 0a 20 20 it-proc keys).
8020: 28 69 66 20 28 61 6e 64 20 28 66 69 6c 65 2d 65 (if (and (file-e
8030: 78 69 73 74 73 3f 20 73 72 63 2d 64 62 29 20 3b xists? src-db) ;
8040: 3b 20 63 61 6e 27 74 20 70 72 6f 63 65 65 64 20 ; can't proceed
8050: 77 69 74 68 6f 75 74 20 61 20 73 6f 75 72 63 65 without a source
8060: 0a 09 20 20 20 28 66 69 6c 65 2d 72 65 61 64 2d .. (file-read-
8070: 61 63 63 65 73 73 3f 20 73 72 63 2d 64 62 29 29 access? src-db))
8080: 0a 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 68 . (let* ((h
8090: 61 76 65 2d 64 65 73 74 20 20 20 20 20 28 66 69 ave-dest (fi
80a0: 6c 65 2d 65 78 69 73 74 73 3f 20 64 65 73 74 2d le-exists? dest-
80b0: 64 62 29 29 0a 09 20 20 20 20 20 28 64 65 73 74 db)).. (dest
80c0: 2d 66 69 6c 65 2d 77 72 20 20 28 61 6e 64 20 68 -file-wr (and h
80d0: 61 76 65 2d 64 65 73 74 0a 09 09 09 09 20 28 66 ave-dest..... (f
80e0: 69 6c 65 2d 77 72 69 74 65 2d 61 63 63 65 73 73 ile-write-access
80f0: 3f 20 64 65 73 74 2d 64 62 29 29 29 20 3b 3b 20 ? dest-db))) ;;
8100: 65 78 69 73 74 73 20 61 6e 64 20 77 72 69 74 61 exists and writa
8110: 62 6c 65 0a 09 20 20 20 20 20 28 64 65 73 74 2d ble.. (dest-
8120: 64 69 72 20 20 20 20 20 20 28 6f 72 20 28 70 61 dir (or (pa
8130: 74 68 6e 61 6d 65 2d 64 69 72 65 63 74 6f 72 79 thname-directory
8140: 20 64 65 73 74 2d 64 62 29 0a 09 09 09 09 22 2e dest-db).....".
8150: 22 29 29 0a 09 20 20 20 20 20 28 64 65 73 74 2d ")).. (dest-
8160: 64 69 72 2d 77 72 20 20 20 28 61 6e 64 20 28 66 dir-wr (and (f
8170: 69 6c 65 2d 65 78 69 73 74 73 3f 20 64 65 73 74 ile-exists? dest
8180: 2d 64 69 72 29 0a 09 09 09 09 20 28 66 69 6c 65 -dir)..... (file
8190: 2d 77 72 69 74 65 2d 61 63 63 65 73 73 3f 20 64 -write-access? d
81a0: 65 73 74 2d 64 69 72 29 29 29 0a 09 20 20 20 20 est-dir)))..
81b0: 20 28 64 2d 77 72 20 20 20 20 20 20 20 20 20 20 (d-wr
81c0: 28 6f 72 20 28 61 6e 64 20 68 61 76 65 2d 64 65 (or (and have-de
81d0: 73 74 0a 09 09 09 09 20 20 20 20 20 64 65 73 74 st..... dest
81e0: 2d 66 69 6c 65 2d 77 72 29 0a 09 09 09 09 64 65 -file-wr).....de
81f0: 73 74 2d 64 69 72 2d 77 72 29 29 0a 09 20 20 20 st-dir-wr))..
8200: 20 20 28 63 6f 70 69 65 64 20 20 20 20 20 20 20 (copied
8210: 20 28 69 66 20 28 61 6e 64 20 28 6e 6f 74 20 68 (if (and (not h
8220: 61 76 65 2d 64 65 73 74 29 0a 09 09 09 09 20 20 ave-dest).....
8230: 20 20 20 64 65 73 74 2d 64 69 72 2d 77 72 29 0a dest-dir-wr).
8240: 09 09 09 09 28 62 65 67 69 6e 0a 09 09 09 09 20 ....(begin.....
8250: 20 28 66 69 6c 65 2d 63 6f 70 79 20 73 72 63 2d (file-copy src-
8260: 64 62 20 64 65 73 74 2d 64 62 29 0a 09 09 09 09 db dest-db).....
8270: 20 20 23 74 29 0a 09 09 09 09 23 66 29 29 29 0a #t).....#f))).
8280: 09 28 69 66 20 63 6f 70 69 65 64 0a 09 20 20 20 .(if copied..
8290: 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 20 28 (begin.. (
82a0: 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f debug:print-info
82b0: 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 0 *default-log-
82c0: 70 6f 72 74 2a 20 22 64 62 2d 74 6f 2d 64 62 2d port* "db-to-db-
82d0: 73 79 6e 63 20 64 6f 6e 65 20 77 69 74 68 20 66 sync done with f
82e0: 69 6c 65 2d 63 6f 70 79 22 29 0a 09 20 20 20 20 ile-copy")..
82f0: 20 20 23 74 29 0a 09 20 20 20 20 28 6c 65 74 2a #t).. (let*
8300: 20 28 28 74 61 62 6c 65 73 20 28 64 62 3a 73 79 ((tables (db:sy
8310: 6e 63 2d 61 6c 6c 2d 74 61 62 6c 65 73 2d 6c 69 nc-all-tables-li
8320: 73 74 20 6b 65 79 73 29 29 0a 09 09 20 20 20 28 st keys))... (
8330: 73 64 62 20 20 20 20 28 64 62 6d 6f 64 3a 73 61 sdb (dbmod:sa
8340: 66 65 6c 79 2d 6f 70 65 6e 2d 64 62 20 73 72 63 fely-open-db src
8350: 2d 64 62 20 69 6e 69 74 2d 70 72 6f 63 20 23 74 -db init-proc #t
8360: 29 29 0a 09 09 20 20 20 28 64 64 62 20 20 20 20 ))... (ddb
8370: 28 64 62 6d 6f 64 3a 73 61 66 65 6c 79 2d 6f 70 (dbmod:safely-op
8380: 65 6e 2d 64 62 20 64 65 73 74 2d 64 62 20 69 6e en-db dest-db in
8390: 69 74 2d 70 72 6f 63 20 64 2d 77 72 29 29 0a 09 it-proc d-wr))..
83a0: 09 20 20 20 28 72 65 73 20 20 20 20 28 64 62 6d . (res (dbm
83b0: 6f 64 3a 73 79 6e 63 2d 67 61 73 6b 65 74 20 74 od:sync-gasket t
83c0: 61 62 6c 65 73 20 6c 61 73 74 2d 75 70 64 61 74 ables last-updat
83d0: 65 20 73 64 62 20 64 64 62 20 64 65 73 74 2d 64 e sdb ddb dest-d
83e0: 62 20 27 74 6f 64 69 73 6b 20 6b 65 79 73 29 29 b 'todisk keys))
83f0: 29 0a 09 20 20 20 20 20 20 28 73 71 6c 69 74 65 ).. (sqlite
8400: 33 3a 66 69 6e 61 6c 69 7a 65 21 20 73 64 62 29 3:finalize! sdb)
8410: 0a 09 20 20 20 20 20 20 28 73 71 6c 69 74 65 33 .. (sqlite3
8420: 3a 66 69 6e 61 6c 69 7a 65 21 20 64 64 62 29 0a :finalize! ddb).
8430: 09 20 20 20 20 20 20 72 65 73 29 29 29 0a 20 20 . res))).
8440: 20 20 20 20 23 66 29 29 0a 0a 3b 3b 20 3d 3d 3d #f))..;; ===
8450: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8460: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8470: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
8490: 3d 3d 3d 0a 3b 3b 20 64 62 73 74 61 74 73 0a 3b ===.;; dbstats.;
84a0: 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;===============
84b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
84c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
84d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
84e0: 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 20 28 64 65 66 =======..;; (def
84f0: 69 6e 65 20 2a 64 62 73 74 72 75 63 74 2d 64 62 ine *dbstruct-db
8500: 73 2a 20 20 20 20 20 20 20 20 20 23 66 29 20 3b s* #f) ;
8510: 3b 20 75 73 65 64 20 74 6f 20 63 61 63 68 65 20 ; used to cache
8520: 74 68 65 20 64 62 73 74 72 75 63 74 20 69 6e 20 the dbstruct in
8530: 64 62 3a 73 65 74 75 70 2e 20 47 6f 61 6c 20 69 db:setup. Goal i
8540: 73 20 74 6f 20 72 65 6d 6f 76 65 20 74 68 69 73 s to remove this
8550: 2e 0a 3b 3b 20 64 62 20 73 74 61 74 73 0a 28 64 ..;; db stats.(d
8560: 65 66 69 6e 65 20 2a 64 62 2d 73 74 61 74 73 2a efine *db-stats*
8570: 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b (mak
8580: 65 2d 68 61 73 68 2d 74 61 62 6c 65 29 29 20 3b e-hash-table)) ;
8590: 3b 20 68 61 73 68 20 6f 66 20 76 65 63 74 6f 72 ; hash of vector
85a0: 73 20 3c 20 63 6f 75 6e 74 20 64 75 72 61 74 69 s < count durati
85b0: 6f 6e 2d 74 6f 74 61 6c 20 3e 0a 28 64 65 66 69 on-total >.(defi
85c0: 6e 65 20 2a 64 62 2d 73 74 61 74 73 2d 6d 75 74 ne *db-stats-mut
85d0: 65 78 2a 20 20 20 20 20 20 28 6d 61 6b 65 2d 6d ex* (make-m
85e0: 75 74 65 78 29 29 0a 0a 28 64 65 66 69 6e 65 20 utex))..(define
85f0: 28 72 6d 74 3a 70 72 69 6e 74 2d 64 62 2d 73 74 (rmt:print-db-st
8600: 61 74 73 29 0a 20 20 28 6c 65 74 20 28 28 66 6d ats). (let ((fm
8610: 74 73 74 72 20 22 7e 34 30 61 7e 37 2d 64 7e 39 tstr "~40a~7-d~9
8620: 2d 64 7e 32 30 2c 32 2d 66 22 29 29 20 3b 3b 20 -d~20,2-f")) ;;
8630: 22 7e 32 30 2c 32 2d 66 22 0a 20 20 20 20 28 64 "~20,2-f". (d
8640: 65 62 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 ebug:print 0 *de
8650: 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 fault-log-port*
8660: 22 44 42 20 53 74 61 74 73 5c 6e 3d 3d 3d 3d 3d "DB Stats\n=====
8670: 3d 3d 3d 22 29 0a 20 20 20 20 28 64 65 62 75 67 ==="). (debug
8680: 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c :print 0 *defaul
8690: 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 28 66 6f 72 t-log-port* (for
86a0: 6d 61 74 20 23 66 20 22 7e 34 30 61 7e 38 61 7e mat #f "~40a~8a~
86b0: 31 30 61 7e 31 30 61 22 20 22 43 6d 64 22 20 22 10a~10a" "Cmd" "
86c0: 43 6f 75 6e 74 22 20 22 54 6f 74 54 69 6d 65 22 Count" "TotTime"
86d0: 20 22 41 76 67 22 29 29 0a 20 20 20 20 28 66 6f "Avg")). (fo
86e0: 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 20 28 r-each (lambda (
86f0: 63 6d 64 29 0a 09 09 28 6c 65 74 2a 20 28 28 64 cmd)...(let* ((d
8700: 61 74 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 at (hash-tab
8710: 6c 65 2d 72 65 66 20 2a 64 62 2d 73 74 61 74 73 le-ref *db-stats
8720: 2a 20 63 6d 64 29 29 0a 09 09 20 20 20 20 20 20 * cmd))...
8730: 20 28 63 6f 75 6e 74 20 20 20 28 64 62 73 74 61 (count (dbsta
8740: 74 2d 63 6e 74 20 64 61 74 29 29 0a 09 09 20 20 t-cnt dat))...
8750: 20 20 20 20 20 28 74 6f 74 74 69 6d 65 20 28 64 (tottime (d
8760: 62 73 74 61 74 2d 74 6f 74 74 69 6d 65 20 64 61 bstat-tottime da
8770: 74 29 29 29 0a 09 09 20 20 28 64 65 62 75 67 3a t)))... (debug:
8780: 70 72 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 print 0 *default
8790: 2d 6c 6f 67 2d 70 6f 72 74 2a 0a 09 09 09 20 20 -log-port*....
87a0: 20 20 20 20 20 28 66 6f 72 6d 61 74 20 23 66 20 (format #f
87b0: 66 6d 74 73 74 72 20 63 6d 64 20 63 6f 75 6e 74 fmtstr cmd count
87c0: 20 74 6f 74 74 69 6d 65 0a 09 09 09 09 20 20 20 tottime.....
87d0: 20 20 20 20 28 2f 20 74 6f 74 74 69 6d 65 20 63 (/ tottime c
87e0: 6f 75 6e 74 29 29 29 29 29 0a 09 20 20 20 20 20 ount)))))..
87f0: 20 28 73 6f 72 74 20 28 68 61 73 68 2d 74 61 62 (sort (hash-tab
8800: 6c 65 2d 6b 65 79 73 20 2a 64 62 2d 73 74 61 74 le-keys *db-stat
8810: 73 2a 29 0a 09 09 20 20 20 20 28 6c 61 6d 62 64 s*)... (lambd
8820: 61 20 28 61 20 62 29 0a 09 09 20 20 20 20 20 20 a (a b)...
8830: 28 3e 20 28 64 62 73 74 61 74 2d 74 6f 74 74 69 (> (dbstat-totti
8840: 6d 65 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 me (hash-table-r
8850: 65 66 20 2a 64 62 2d 73 74 61 74 73 2a 20 61 29 ef *db-stats* a)
8860: 29 0a 09 09 09 20 28 64 62 73 74 61 74 2d 74 6f ).... (dbstat-to
8870: 74 74 69 6d 65 20 28 68 61 73 68 2d 74 61 62 6c ttime (hash-tabl
8880: 65 2d 72 65 66 20 2a 64 62 2d 73 74 61 74 73 2a e-ref *db-stats*
8890: 20 62 29 29 29 29 29 29 29 29 0a 0a 28 64 65 66 b))))))))..(def
88a0: 73 74 72 75 63 74 20 64 62 73 74 61 74 0a 20 20 struct dbstat.
88b0: 28 63 6e 74 20 30 29 0a 20 20 28 74 6f 74 74 69 (cnt 0). (totti
88c0: 6d 65 20 30 29 29 0a 0a 28 64 65 66 69 6e 65 20 me 0))..(define
88d0: 28 64 62 3a 61 64 64 2d 73 74 61 74 73 20 63 6d (db:add-stats cm
88e0: 64 20 72 75 6e 2d 69 64 20 70 61 72 61 6d 73 20 d run-id params
88f0: 64 65 6c 74 61 29 0a 20 20 28 6c 65 74 2a 20 28 delta). (let* (
8900: 28 6d 6f 64 69 66 69 65 64 2d 63 6d 64 20 28 69 (modified-cmd (i
8910: 66 20 28 65 71 3f 20 63 6d 64 20 27 67 65 6e 65 f (eq? cmd 'gene
8920: 72 61 6c 2d 63 61 6c 6c 29 0a 09 09 09 20 20 20 ral-call)....
8930: 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 (string->symbol
8940: 28 63 6f 6e 63 20 22 67 65 6e 65 72 61 6c 2d 63 (conc "general-c
8950: 61 6c 6c 2d 22 20 28 63 61 72 20 70 61 72 61 6d all-" (car param
8960: 73 29 29 29 0a 09 09 09 20 20 20 63 6d 64 29 29 s))).... cmd))
8970: 0a 09 20 28 72 65 63 20 20 20 20 20 20 20 20 20 .. (rec
8980: 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 (hash-table-ref
8990: 2f 64 65 66 61 75 6c 74 20 2a 64 62 2d 73 74 61 /default *db-sta
89a0: 74 73 2a 20 6d 6f 64 69 66 69 65 64 2d 63 6d 64 ts* modified-cmd
89b0: 20 23 66 29 29 29 0a 20 20 20 20 28 69 66 20 28 #f))). (if (
89c0: 6e 6f 74 20 72 65 63 29 0a 09 28 6c 65 74 20 28 not rec)..(let (
89d0: 28 6e 65 77 2d 72 65 63 20 20 28 6d 61 6b 65 2d (new-rec (make-
89e0: 64 62 73 74 61 74 29 29 29 0a 09 20 20 28 68 61 dbstat))).. (ha
89f0: 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a 64 sh-table-set! *d
8a00: 62 2d 73 74 61 74 73 2a 20 6d 6f 64 69 66 69 65 b-stats* modifie
8a10: 64 2d 63 6d 64 20 6e 65 77 2d 72 65 63 29 0a 09 d-cmd new-rec)..
8a20: 20 20 28 73 65 74 21 20 72 65 63 20 6e 65 77 2d (set! rec new-
8a30: 72 65 63 29 29 29 0a 20 20 20 20 28 64 62 73 74 rec))). (dbst
8a40: 61 74 2d 63 6e 74 2d 73 65 74 21 20 72 65 63 20 at-cnt-set! rec
8a50: 28 2b 20 28 64 62 73 74 61 74 2d 63 6e 74 20 72 (+ (dbstat-cnt r
8a60: 65 63 29 20 31 29 29 0a 20 20 20 20 28 64 62 73 ec) 1)). (dbs
8a70: 74 61 74 2d 74 6f 74 74 69 6d 65 2d 73 65 74 21 tat-tottime-set!
8a80: 20 72 65 63 20 28 2b 20 28 64 62 73 74 61 74 2d rec (+ (dbstat-
8a90: 74 6f 74 74 69 6d 65 20 72 65 63 29 20 64 65 6c tottime rec) del
8aa0: 74 61 29 29 29 29 0a 20 20 20 20 0a 0a 0a 29 0a ta)))). ...).
8ab0: 0a 0a 3b 3b 20 41 54 54 49 43 0a 0a 09 09 09 09 ..;; ATTIC......
8ac0: 09 20 23 3b 28 6c 65 74 2a 20 28 28 73 79 6e 63 . #;(let* ((sync
8ad0: 65 72 2d 6c 6f 67 66 69 6c 65 20 20 20 20 28 63 er-logfile (c
8ae0: 6f 6e 63 20 61 72 65 61 70 61 74 68 22 2f 6c 6f onc areapath"/lo
8af0: 67 73 2f 22 64 62 66 6e 61 6d 65 22 2d 73 79 6e gs/"dbfname"-syn
8b00: 63 65 72 2e 6c 6f 67 22 29 29 0a 09 09 09 09 09 cer.log"))......
8b10: 20 20 20 20 20 20 28 73 79 6e 63 2d 63 6d 64 20 (sync-cmd
8b20: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 65 71 (if (eq
8b30: 3f 20 73 79 6e 63 64 69 72 20 27 74 6f 64 69 73 ? syncdir 'todis
8b40: 6b 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 k).........
8b50: 28 63 6f 6e 63 20 22 28 4e 42 46 41 4b 45 5f 4c (conc "(NBFAKE_L
8b60: 4f 47 3d 22 73 79 6e 63 65 72 2d 6c 6f 67 66 69 OG="syncer-logfi
8b70: 6c 65 22 20 6e 62 66 61 6b 65 20 6d 65 67 61 74 le" nbfake megat
8b80: 65 73 74 20 2d 64 62 32 64 62 20 2d 66 72 6f 6d est -db2db -from
8b90: 20 22 74 6d 70 64 62 22 20 2d 74 6f 20 22 64 62 "tmpdb" -to "db
8ba0: 66 75 6c 6c 6e 61 6d 65 22 20 2d 70 65 72 69 6f fullname" -perio
8bb0: 64 20 35 20 2d 74 69 6d 65 6f 75 74 20 31 30 20 d 5 -timeout 10
8bc0: 3e 20 2f 64 65 76 2f 6e 75 6c 6c 20 32 26 3e 31 > /dev/null 2&>1
8bd0: 29 26 22 29 0a 09 09 09 09 09 09 09 09 20 20 20 )&").........
8be0: 20 20 28 63 6f 6e 63 20 22 28 4e 42 46 41 4b 45 (conc "(NBFAKE
8bf0: 5f 4c 4f 47 3d 22 73 79 6e 63 65 72 2d 6c 6f 67 _LOG="syncer-log
8c00: 66 69 6c 65 22 20 6e 62 66 61 6b 65 20 6d 65 67 file" nbfake meg
8c10: 61 74 65 73 74 20 2d 64 62 32 64 62 20 2d 66 72 atest -db2db -fr
8c20: 6f 6d 20 22 64 62 66 75 6c 6c 6e 61 6d 65 22 20 om "dbfullname"
8c30: 2d 74 6f 20 22 74 6d 70 64 62 22 20 2d 70 65 72 -to "tmpdb" -per
8c40: 69 6f 64 20 35 20 2d 74 69 6d 65 6f 75 74 20 31 iod 5 -timeout 1
8c50: 30 20 3e 20 2f 64 65 76 2f 6e 75 6c 6c 20 32 26 0 > /dev/null 2&
8c60: 3e 31 29 26 22 29 29 29 0a 09 09 09 09 09 20 20 >1)&")))......
8c70: 20 20 20 20 28 73 79 6e 63 6c 6f 63 6b 2d 66 69 (synclock-fi
8c80: 6c 65 20 20 20 20 20 28 63 6f 6e 63 20 64 62 66 le (conc dbf
8c90: 75 6c 6c 6e 61 6d 65 22 2e 6c 6f 63 6b 22 29 29 ullname".lock"))
8ca0: 0a 09 09 09 09 09 20 20 20 20 20 20 28 73 79 6e ...... (syn
8cb0: 63 65 72 2d 72 75 6e 6e 69 6e 67 2d 66 69 6c 65 cer-running-file
8cc0: 20 28 63 6f 6e 63 20 64 62 66 75 6c 6c 6e 61 6d (conc dbfullnam
8cd0: 65 22 2d 73 79 6e 63 2d 72 75 6e 6e 69 6e 67 22 e"-sync-running"
8ce0: 29 29 0a 09 09 09 09 09 20 20 20 20 20 20 28 73 ))...... (s
8cf0: 79 6e 63 6c 6f 63 6b 2d 6d 6f 64 2d 74 69 6d 65 ynclock-mod-time
8d00: 20 28 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 (if (file-exist
8d10: 73 3f 20 73 79 6e 63 6c 6f 63 6b 2d 66 69 6c 65 s? synclock-file
8d20: 29 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 28 )......... (
8d30: 68 61 6e 64 6c 65 2d 65 78 63 65 70 74 69 6f 6e handle-exception
8d40: 73 0a 09 09 09 09 09 09 09 09 09 20 65 78 6e 0a s.......... exn.
8d50: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 23 ........ #
8d60: 66 0a 09 09 09 09 09 09 09 09 20 20 20 20 20 20 f.........
8d70: 20 28 66 69 6c 65 2d 6d 6f 64 69 66 69 63 61 74 (file-modificat
8d80: 69 6f 6e 2d 74 69 6d 65 20 73 79 6e 63 6c 6f 63 ion-time syncloc
8d90: 6b 2d 66 69 6c 65 29 29 0a 09 09 09 09 09 09 09 k-file))........
8da0: 09 20 20 20 20 20 23 66 29 29 0a 09 09 09 09 09 . #f))......
8db0: 20 20 20 20 20 20 28 74 68 65 74 68 72 65 61 64 (thethread
8dc0: 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
8dd0: 20 28 29 0a 09 09 09 09 09 09 09 09 20 20 20 28 ()......... (
8de0: 74 68 72 65 61 64 2d 73 74 61 72 74 21 0a 09 09 thread-start!...
8df0: 09 09 09 09 09 09 20 20 20 20 28 6d 61 6b 65 2d ...... (make-
8e00: 74 68 72 65 61 64 0a 09 09 09 09 09 09 09 09 20 thread.........
8e10: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 09 (lambda ()..
8e20: 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 73 ....... (s
8e30: 65 74 21 20 2a 73 79 6e 63 2d 69 6e 2d 70 72 6f et! *sync-in-pro
8e40: 67 72 65 73 73 2a 20 23 74 29 0a 09 09 09 09 09 gress* #t)......
8e50: 09 09 09 20 20 20 20 20 20 20 28 64 65 62 75 67 ... (debug
8e60: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 22 52 75 6e :print-info "Run
8e70: 6e 69 6e 67 20 22 73 79 6e 63 2d 63 6d 64 29 0a ning "sync-cmd).
8e80: 09 09 09 09 09 09 09 09 20 20 20 20 20 20 20 28 ........ (
8e90: 69 66 20 28 66 69 6c 65 2d 65 78 69 73 74 73 3f if (file-exists?
8ea0: 20 73 79 6e 63 65 72 2d 72 75 6e 6e 69 6e 67 2d syncer-running-
8eb0: 66 69 6c 65 29 0a 09 09 09 09 09 09 09 09 09 20 file)..........
8ec0: 20 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 (debug:print-i
8ed0: 6e 66 6f 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 0 *default-l
8ee0: 6f 67 2d 70 6f 72 74 2a 20 22 53 79 6e 63 65 72 og-port* "Syncer
8ef0: 20 73 74 69 6c 6c 20 72 75 6e 6e 69 6e 67 2c 20 still running,
8f00: 73 6b 69 70 70 69 6e 67 20 73 79 6e 63 65 72 20 skipping syncer
8f10: 73 74 61 72 74 2e 22 29 0a 09 09 09 09 09 09 09 start.")........
8f20: 09 09 20 20 20 28 73 79 73 74 65 6d 20 73 79 6e .. (system syn
8f30: 63 2d 63 6d 64 29 29 0a 09 09 09 09 09 09 09 09 c-cmd)).........
8f40: 20 20 20 20 20 20 20 28 73 65 74 21 20 2a 73 79 (set! *sy
8f50: 6e 63 2d 69 6e 2d 70 72 6f 67 72 65 73 73 2a 20 nc-in-progress*
8f60: 23 66 29 29 29 29 29 29 29 0a 09 09 09 09 09 20 #f)))))))......
8f70: 28 69 66 20 28 28 69 66 20 28 65 71 3f 20 73 79 (if ((if (eq? sy
8f80: 6e 63 64 69 72 20 27 74 6f 64 69 73 6b 29 20 3c ncdir 'todisk) <
8f90: 20 3e 29 20 3b 3b 20 75 73 65 20 6c 65 73 73 20 >) ;; use less
8fa0: 74 68 61 6e 20 66 6f 72 20 74 6f 64 69 73 6b 2c than for todisk,
8fb0: 20 67 72 65 61 74 65 72 20 74 68 61 6e 20 66 6f greater than fo
8fc0: 72 20 66 72 6f 6d 20 64 69 73 6b 0a 09 09 09 09 r from disk.....
8fd0: 09 20 20 20 20 20 20 28 66 69 6c 65 2d 6d 6f 64 . (file-mod
8fe0: 69 66 69 63 61 74 69 6f 6e 2d 74 69 6d 65 20 74 ification-time t
8ff0: 6d 70 64 62 29 0a 09 09 09 09 09 20 20 20 20 20 mpdb)......
9000: 20 28 66 69 6c 65 2d 6d 6f 64 69 66 69 63 61 74 (file-modificat
9010: 69 6f 6e 2d 74 69 6d 65 20 64 62 66 75 6c 6c 6e ion-time dbfulln
9020: 61 6d 65 29 29 0a 09 09 09 09 09 20 20 20 20 20 ame))......
9030: 28 64 65 62 75 67 3a 70 72 69 6e 74 20 34 20 2a (debug:print 4 *
9040: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
9050: 2a 20 22 53 6b 69 70 70 69 6e 67 20 73 79 6e 63 * "Skipping sync
9060: 2c 20 22 74 6d 70 64 62 22 20 6f 6c 64 65 72 20 , "tmpdb" older
9070: 74 68 61 6e 20 22 64 62 66 75 6c 6c 6e 61 6d 65 than "dbfullname
9080: 29 0a 09 09 09 09 09 20 20 20 20 20 28 69 66 20 )...... (if
9090: 73 79 6e 63 6c 6f 63 6b 2d 6d 6f 64 2d 74 69 6d synclock-mod-tim
90a0: 65 0a 09 09 09 09 09 09 20 28 69 66 20 28 3e 20 e....... (if (>
90b0: 28 2d 20 28 63 75 72 72 65 6e 74 2d 73 65 63 6f (- (current-seco
90c0: 6e 64 73 29 20 73 79 6e 63 6c 6f 63 6b 2d 6d 6f nds) synclock-mo
90d0: 64 2d 74 69 6d 65 29 20 32 30 29 20 3b 3b 20 73 d-time) 20) ;; s
90e0: 6f 6d 65 74 68 69 6e 67 20 77 72 6f 6e 67 20 77 omething wrong w
90f0: 69 74 68 20 73 79 6e 63 2c 20 72 65 6d 6f 76 65 ith sync, remove
9100: 20 66 69 6c 65 0a 09 09 09 09 09 09 20 20 20 20 file.......
9110: 20 28 62 65 67 69 6e 0a 09 09 09 09 09 09 20 20 (begin.......
9120: 20 20 20 20 20 28 68 61 6e 64 6c 65 2d 65 78 63 (handle-exc
9130: 65 70 74 69 6f 6e 73 0a 09 09 09 09 09 09 09 20 eptions........
9140: 20 20 65 78 6e 0a 09 09 09 09 09 09 09 20 23 66 exn........ #f
9150: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
9160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9180: 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e (begin
9190: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
91a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
91b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
91c0: 20 20 20 20 20 20 20 20 20 20 20 20 28 64 65 62 (deb
91d0: 75 67 3a 70 72 69 6e 74 20 30 20 2a 64 65 66 61 ug:print 0 *defa
91e0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 53 ult-log-port* "S
91f0: 79 6e 63 20 6c 6f 63 6b 20 66 69 6c 65 20 22 20 ync lock file "
9200: 73 79 6e 63 6c 6f 63 6b 2d 66 69 6c 65 20 22 69 synclock-file "i
9210: 73 20 6f 6c 64 65 72 20 74 68 61 6e 20 32 30 20 s older than 20
9220: 73 65 63 6f 6e 64 73 20 28 22 20 20 73 79 6e 63 seconds (" sync
9230: 6c 6f 63 6b 2d 6d 6f 64 2d 74 69 6d 65 20 22 20 lock-mod-time "
9240: 73 65 63 6f 6e 64 73 29 2e 20 52 65 6d 6f 76 69 seconds). Removi
9250: 6e 67 20 69 74 22 29 0a 09 09 09 09 09 09 09 20 ng it")........
9260: 20 20 28 64 65 6c 65 74 65 2d 66 69 6c 65 20 73 (delete-file s
9270: 79 6e 63 6c 6f 63 6b 2d 66 69 6c 65 29 0a 20 20 ynclock-file).
9280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
92a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
92b0: 20 20 20 20 20 20 20 29 0a 20 20 20 20 20 20 20 ).
92c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
92d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
92e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
92f0: 29 0a 09 09 09 09 09 09 20 20 20 20 20 20 20 28 )....... (
9300: 74 68 65 74 68 72 65 61 64 29 29 0a 09 09 09 09 thethread)).....
9310: 09 09 20 20 20 20 20 28 64 65 62 75 67 3a 70 72 .. (debug:pr
9320: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
9330: 6f 67 2d 70 6f 72 74 2a 20 22 53 6b 69 70 70 69 og-port* "Skippi
9340: 6e 67 20 73 79 6e 63 2c 20 6c 6f 63 6b 66 69 6c ng sync, lockfil
9350: 65 20 22 73 79 6e 63 6c 6f 63 6b 2d 66 69 6c 65 e "synclock-file
9360: 22 20 66 6f 75 6e 64 2e 22 29 29 0a 09 09 09 09 " found.")).....
9370: 09 09 20 28 74 68 65 74 68 72 65 61 64 29 29 29 .. (thethread)))
9380: 29 0a ).