Artifact
6d4566e942b9d6fe944e9442d4a6265283c441e5:
0000: 3b 3b 3d 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 0a 3b 3b 20 43 6f 70 79 ========.;; Copy
0050: 72 69 67 68 74 20 32 30 30 36 2d 32 30 31 32 2c right 2006-2012,
0060: 20 4d 61 74 74 68 65 77 20 57 65 6c 6c 61 6e 64 Matthew Welland
0070: 2e 0a 3b 3b 20 0a 3b 3b 20 54 68 69 73 20 66 69 ..;; .;; This fi
0080: 6c 65 20 69 73 20 70 61 72 74 20 6f 66 20 4d 65 le is part of Me
0090: 67 61 74 65 73 74 2e 0a 3b 3b 20 0a 3b 3b 20 20 gatest..;; .;;
00a0: 20 20 20 4d 65 67 61 74 65 73 74 20 69 73 20 66 Megatest is f
00b0: 72 65 65 20 73 6f 66 74 77 61 72 65 3a 20 79 6f ree software: yo
00c0: 75 20 63 61 6e 20 72 65 64 69 73 74 72 69 62 75 u can redistribu
00d0: 74 65 20 69 74 20 61 6e 64 2f 6f 72 20 6d 6f 64 te it and/or mod
00e0: 69 66 79 0a 3b 3b 20 20 20 20 20 69 74 20 75 6e ify.;; it un
00f0: 64 65 72 20 74 68 65 20 74 65 72 6d 73 20 6f 66 der the terms of
0100: 20 74 68 65 20 47 4e 55 20 47 65 6e 65 72 61 6c the GNU General
0110: 20 50 75 62 6c 69 63 20 4c 69 63 65 6e 73 65 20 Public License
0120: 61 73 20 70 75 62 6c 69 73 68 65 64 20 62 79 0a as published by.
0130: 3b 3b 20 20 20 20 20 74 68 65 20 46 72 65 65 20 ;; the Free
0140: 53 6f 66 74 77 61 72 65 20 46 6f 75 6e 64 61 74 Software Foundat
0150: 69 6f 6e 2c 20 65 69 74 68 65 72 20 76 65 72 73 ion, either vers
0160: 69 6f 6e 20 33 20 6f 66 20 74 68 65 20 4c 69 63 ion 3 of the Lic
0170: 65 6e 73 65 2c 20 6f 72 0a 3b 3b 20 20 20 20 20 ense, or.;;
0180: 28 61 74 20 79 6f 75 72 20 6f 70 74 69 6f 6e 29 (at your option)
0190: 20 61 6e 79 20 6c 61 74 65 72 20 76 65 72 73 69 any later versi
01a0: 6f 6e 2e 0a 3b 3b 20 0a 3b 3b 20 20 20 20 20 4d on..;; .;; M
01b0: 65 67 61 74 65 73 74 20 69 73 20 64 69 73 74 72 egatest is distr
01c0: 69 62 75 74 65 64 20 69 6e 20 74 68 65 20 68 6f ibuted in the ho
01d0: 70 65 20 74 68 61 74 20 69 74 20 77 69 6c 6c 20 pe that it will
01e0: 62 65 20 75 73 65 66 75 6c 2c 0a 3b 3b 20 20 20 be useful,.;;
01f0: 20 20 62 75 74 20 57 49 54 48 4f 55 54 20 41 4e but WITHOUT AN
0200: 59 20 57 41 52 52 41 4e 54 59 3b 20 77 69 74 68 Y WARRANTY; with
0210: 6f 75 74 20 65 76 65 6e 20 74 68 65 20 69 6d 70 out even the imp
0220: 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 lied warranty of
0230: 0a 3b 3b 20 20 20 20 20 4d 45 52 43 48 41 4e 54 .;; MERCHANT
0240: 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e 45 ABILITY or FITNE
0250: 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 55 SS FOR A PARTICU
0260: 4c 41 52 20 50 55 52 50 4f 53 45 2e 20 20 53 65 LAR PURPOSE. Se
0270: 65 20 74 68 65 0a 3b 3b 20 20 20 20 20 47 4e 55 e the.;; GNU
0280: 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 General Public
0290: 4c 69 63 65 6e 73 65 20 66 6f 72 20 6d 6f 72 65 License for more
02a0: 20 64 65 74 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b details..;; .;;
02b0: 20 20 20 20 20 59 6f 75 20 73 68 6f 75 6c 64 20 You should
02c0: 68 61 76 65 20 72 65 63 65 69 76 65 64 20 61 20 have received a
02d0: 63 6f 70 79 20 6f 66 20 74 68 65 20 47 4e 55 20 copy of the GNU
02e0: 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c General Public L
02f0: 69 63 65 6e 73 65 0a 3b 3b 20 20 20 20 20 61 6c icense.;; al
0300: 6f 6e 67 20 77 69 74 68 20 4d 65 67 61 74 65 73 ong with Megates
0310: 74 2e 20 20 49 66 20 6e 6f 74 2c 20 73 65 65 20 t. If not, see
0320: 3c 68 74 74 70 3a 2f 2f 77 77 77 2e 67 6e 75 2e <http://www.gnu.
0330: 6f 72 67 2f 6c 69 63 65 6e 73 65 73 2f 3e 2e 0a org/licenses/>..
0340: 3b 3b 0a 3b 3b 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 3d 3d 3d 3d 3d 3d 0a 0a 3b 3b 3d ===========..;;=
0390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
03d0: 3d 3d 3d 3d 3d 0a 3b 3b 20 41 20 68 61 73 68 20 =====.;; A hash
03e0: 6f 66 20 68 61 73 68 65 73 20 74 68 61 74 20 63 of hashes that c
03f0: 61 6e 20 62 65 20 6b 65 70 74 20 69 6e 20 73 79 an be kept in sy
0400: 6e 63 20 62 79 20 73 65 6e 64 69 6e 67 20 6d 69 nc by sending mi
0410: 6e 69 61 6c 20 64 65 6c 74 61 73 0a 3b 3b 3d 3d nial deltas.;;==
0420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0450: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0460: 3d 3d 3d 3d 0a 0a 28 75 73 65 20 66 6f 72 6d 61 ====..(use forma
0470: 74 29 0a 28 75 73 65 20 73 72 66 69 2d 31 20 73 t).(use srfi-1 s
0480: 72 66 69 2d 36 39 20 73 71 6c 69 74 65 33 29 0a rfi-69 sqlite3).
0490: 28 69 6d 70 6f 72 74 20 28 70 72 65 66 69 78 20 (import (prefix
04a0: 73 71 6c 69 74 65 33 20 73 71 6c 69 74 65 33 3a sqlite3 sqlite3:
04b0: 29 29 0a 0a 28 64 65 63 6c 61 72 65 20 28 75 6e ))..(declare (un
04c0: 69 74 20 73 79 6e 63 68 61 73 68 29 29 0a 28 64 it synchash)).(d
04d0: 65 63 6c 61 72 65 20 28 75 73 65 73 20 64 62 29 eclare (uses db)
04e0: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
04f0: 20 73 65 72 76 65 72 29 29 0a 28 69 6e 63 6c 75 server)).(inclu
0500: 64 65 20 22 64 62 5f 72 65 63 6f 72 64 73 2e 73 de "db_records.s
0510: 63 6d 22 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 cm")..(define (s
0520: 79 6e 63 68 61 73 68 3a 6d 61 6b 65 29 0a 20 20 ynchash:make).
0530: 20 28 6d 61 6b 65 2d 68 61 73 68 2d 74 61 62 6c (make-hash-tabl
0540: 65 29 29 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 6e e))..;; given an
0550: 20 61 6c 69 73 74 20 6f 66 20 6f 62 6a 65 63 74 alist of object
0560: 73 20 27 28 28 69 64 20 6f 62 6a 29 20 2e 2e 2e s '((id obj) ...
0570: 29 20 0a 3b 3b 20 20 20 31 2e 20 72 65 6d 6f 76 ) .;; 1. remov
0580: 65 20 75 6e 63 68 61 6e 67 65 64 20 6f 62 6a 65 e unchanged obje
0590: 63 74 73 20 66 72 6f 6d 20 74 68 65 20 6c 69 73 cts from the lis
05a0: 74 0a 3b 3b 20 20 20 32 2e 20 63 72 65 61 74 65 t.;; 2. create
05b0: 20 61 20 6c 69 73 74 20 6f 66 20 72 65 6d 6f 76 a list of remov
05c0: 65 64 20 6f 62 6a 65 63 74 73 20 62 79 20 69 64 ed objects by id
05d0: 0a 3b 3b 20 20 20 33 2e 20 72 65 6d 6f 76 65 20 .;; 3. remove
05e0: 72 65 6d 6f 76 65 64 20 6f 62 6a 65 63 74 73 20 removed objects
05f0: 66 72 6f 6d 20 73 79 6e 63 68 61 73 68 0a 3b 3b from synchash.;;
0600: 20 20 20 34 2e 20 72 65 70 6c 61 63 65 20 6f 72 4. replace or
0610: 20 61 64 64 20 6e 65 77 20 6f 72 20 63 68 61 6e add new or chan
0620: 67 65 64 20 6f 62 6a 65 63 74 73 20 74 6f 20 73 ged objects to s
0630: 79 6e 63 68 61 73 68 0a 3b 3b 0a 28 64 65 66 69 ynchash.;;.(defi
0640: 6e 65 20 28 73 79 6e 63 68 61 73 68 3a 67 65 74 ne (synchash:get
0650: 2d 64 65 6c 74 61 20 69 6e 64 61 74 20 73 79 6e -delta indat syn
0660: 63 68 61 73 68 29 0a 20 20 28 6c 65 74 20 28 28 chash). (let ((
0670: 64 65 6c 65 74 65 64 20 27 28 29 29 0a 09 28 63 deleted '())..(c
0680: 68 61 6e 67 65 64 20 27 28 29 29 0a 09 28 66 6f hanged '())..(fo
0690: 75 6e 64 20 20 20 27 28 29 29 0a 09 28 6f 72 69 und '())..(ori
06a0: 67 2d 6b 65 79 73 20 28 68 61 73 68 2d 74 61 62 g-keys (hash-tab
06b0: 6c 65 2d 6b 65 79 73 20 73 79 6e 63 68 61 73 68 le-keys synchash
06c0: 29 29 29 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 ))). (for-eac
06d0: 68 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 h. (lambda (
06e0: 69 74 65 6d 29 0a 20 20 20 20 20 20 20 28 6c 65 item). (le
06f0: 74 2a 20 28 28 69 64 20 20 28 63 61 72 20 20 69 t* ((id (car i
0700: 74 65 6d 29 29 0a 09 20 20 20 20 20 20 28 64 61 tem)).. (da
0710: 74 20 28 63 61 64 72 20 69 74 65 6d 29 29 0a 09 t (cadr item))..
0720: 20 20 20 20 20 20 28 72 65 66 20 28 68 61 73 68 (ref (hash
0730: 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 66 61 75 -table-ref/defau
0740: 6c 74 20 73 79 6e 63 68 61 73 68 20 69 64 20 23 lt synchash id #
0750: 66 29 29 29 0a 09 20 28 69 66 20 28 6e 6f 74 20 f))).. (if (not
0760: 28 65 71 75 61 6c 3f 20 64 61 74 20 72 65 66 29 (equal? dat ref)
0770: 29 20 3b 3b 20 69 74 65 6d 20 63 68 61 6e 67 65 ) ;; item change
0780: 64 20 6f 72 20 6e 65 77 0a 09 20 20 20 20 20 28 d or new.. (
0790: 62 65 67 69 6e 0a 09 20 20 20 20 20 20 20 28 73 begin.. (s
07a0: 65 74 21 20 63 68 61 6e 67 65 64 20 28 63 6f 6e et! changed (con
07b0: 73 20 69 74 65 6d 20 63 68 61 6e 67 65 64 29 29 s item changed))
07c0: 0a 09 20 20 20 20 20 20 20 28 68 61 73 68 2d 74 .. (hash-t
07d0: 61 62 6c 65 2d 73 65 74 21 20 73 79 6e 63 68 61 able-set! syncha
07e0: 73 68 20 69 64 20 64 61 74 29 29 29 0a 09 20 28 sh id dat))).. (
07f0: 73 65 74 21 20 66 6f 75 6e 64 20 28 63 6f 6e 73 set! found (cons
0800: 20 69 64 20 66 6f 75 6e 64 29 29 29 29 0a 20 20 id found)))).
0810: 20 20 20 69 6e 64 61 74 29 0a 20 20 20 20 28 66 indat). (f
0820: 6f 72 2d 65 61 63 68 20 0a 20 20 20 20 20 28 6c or-each . (l
0830: 61 6d 62 64 61 20 28 69 64 29 0a 20 20 20 20 20 ambda (id).
0840: 20 20 28 69 66 20 28 6e 6f 74 20 28 6d 65 6d 62 (if (not (memb
0850: 65 72 20 69 64 20 66 6f 75 6e 64 29 29 0a 09 20 er id found))..
0860: 20 20 28 62 65 67 69 6e 0a 09 20 20 20 20 20 28 (begin.. (
0870: 73 65 74 21 20 64 65 6c 65 74 65 64 20 28 63 6f set! deleted (co
0880: 6e 73 20 69 64 20 64 65 6c 65 74 65 64 29 29 0a ns id deleted)).
0890: 09 20 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c . (hash-tabl
08a0: 65 2d 64 65 6c 65 74 65 21 20 73 79 6e 63 68 61 e-delete! syncha
08b0: 73 68 20 69 64 29 29 29 29 0a 20 20 20 20 20 6f sh id)))). o
08c0: 72 69 67 2d 6b 65 79 73 29 0a 20 20 20 20 28 6c rig-keys). (l
08d0: 69 73 74 20 63 68 61 6e 67 65 64 20 64 65 6c 65 ist changed dele
08e0: 74 65 64 29 0a 20 20 20 20 3b 3b 20 28 6c 69 73 ted). ;; (lis
08f0: 74 20 69 6e 64 61 74 20 27 28 29 29 20 3b 3b 20 t indat '()) ;;
0900: 6a 75 73 74 20 66 6f 72 20 64 65 62 75 67 67 69 just for debuggi
0910: 6e 67 0a 20 20 20 20 29 29 0a 20 20 20 20 0a 3b ng. )). .;
0920: 3b 20 6b 65 79 6e 75 6d 20 3d 3e 20 74 68 65 20 ; keynum => the
0930: 66 69 65 6c 64 20 74 6f 20 75 73 65 20 61 73 20 field to use as
0940: 74 68 65 20 75 6e 69 71 75 65 20 6b 65 79 20 28 the unique key (
0950: 75 73 75 61 6c 6c 79 20 30 20 62 75 74 20 63 61 usually 0 but ca
0960: 6e 20 62 65 20 6f 74 68 65 72 20 66 69 65 6c 64 n be other field
0970: 29 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 73 79 ).;;.(define (sy
0980: 6e 63 68 61 73 68 3a 63 6c 69 65 6e 74 2d 67 65 nchash:client-ge
0990: 74 20 70 72 6f 63 20 73 79 6e 63 6b 65 79 20 6b t proc synckey k
09a0: 65 79 6e 75 6d 20 73 79 6e 63 68 61 73 68 20 72 eynum synchash r
09b0: 75 6e 2d 69 64 20 2e 20 70 61 72 61 6d 73 29 0a un-id . params).
09c0: 20 20 28 6c 65 74 2a 20 28 28 64 61 74 61 20 20 (let* ((data
09d0: 20 28 72 6d 74 3a 73 79 6e 63 68 61 73 68 2d 67 (rmt:synchash-g
09e0: 65 74 20 72 75 6e 2d 69 64 20 70 72 6f 63 20 73 et run-id proc s
09f0: 79 6e 63 6b 65 79 20 6b 65 79 6e 75 6d 20 70 61 ynckey keynum pa
0a00: 72 61 6d 73 29 29 0a 09 20 28 6e 65 77 64 61 74 rams)).. (newdat
0a10: 20 28 63 61 72 20 64 61 74 61 29 29 0a 09 20 28 (car data)).. (
0a20: 72 65 6d 6f 76 73 20 28 63 61 64 72 20 64 61 74 removs (cadr dat
0a30: 61 29 29 0a 09 20 28 6d 79 68 61 73 68 20 28 68 a)).. (myhash (h
0a40: 61 73 68 2d 74 61 62 6c 65 2d 72 65 66 2f 64 65 ash-table-ref/de
0a50: 66 61 75 6c 74 20 73 79 6e 63 68 61 73 68 20 73 fault synchash s
0a60: 79 6e 63 6b 65 79 20 23 66 29 29 29 0a 20 20 20 ynckey #f))).
0a70: 20 28 69 66 20 28 6e 6f 74 20 6d 79 68 61 73 68 (if (not myhash
0a80: 29 0a 09 28 62 65 67 69 6e 0a 09 20 20 28 73 65 )..(begin.. (se
0a90: 74 21 20 6d 79 68 61 73 68 20 28 6d 61 6b 65 2d t! myhash (make-
0aa0: 68 61 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 20 hash-table))..
0ab0: 28 68 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 (hash-table-set!
0ac0: 20 73 79 6e 63 68 61 73 68 20 73 79 6e 63 6b 65 synchash syncke
0ad0: 79 20 6d 79 68 61 73 68 29 29 29 0a 20 20 20 20 y myhash))).
0ae0: 28 66 6f 72 2d 65 61 63 68 20 0a 20 20 20 20 20 (for-each .
0af0: 28 6c 61 6d 62 64 61 20 28 69 74 65 6d 29 0a 20 (lambda (item).
0b00: 20 20 20 20 20 20 28 6c 65 74 20 28 28 69 64 20 (let ((id
0b10: 20 28 63 61 72 20 69 74 65 6d 29 29 0a 09 20 20 (car item))..
0b20: 20 20 20 28 64 61 74 20 28 63 61 64 72 20 69 74 (dat (cadr it
0b30: 65 6d 29 29 29 0a 09 20 3b 3b 20 28 64 65 62 75 em))).. ;; (debu
0b40: 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 2a g:print-info 2 *
0b50: 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 default-log-port
0b60: 2a 20 22 50 72 6f 63 65 73 73 69 6e 67 20 69 74 * "Processing it
0b70: 65 6d 3a 20 22 20 69 74 65 6d 29 0a 09 20 28 68 em: " item).. (h
0b80: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 6d ash-table-set! m
0b90: 79 68 61 73 68 20 69 64 20 64 61 74 29 29 29 0a yhash id dat))).
0ba0: 20 20 20 20 20 6e 65 77 64 61 74 29 0a 20 20 20 newdat).
0bb0: 20 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 (for-each.
0bc0: 28 6c 61 6d 62 64 61 20 28 69 64 29 0a 20 20 20 (lambda (id).
0bd0: 20 20 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d (hash-table-
0be0: 64 65 6c 65 74 65 21 20 6d 79 68 61 73 68 20 69 delete! myhash i
0bf0: 64 29 29 0a 20 20 20 20 20 72 65 6d 6f 76 73 29 d)). removs)
0c00: 0a 20 20 20 20 3b 3b 20 57 48 49 43 48 20 4f 4e . ;; WHICH ON
0c10: 45 21 3f 0a 20 20 20 20 3b 3b 20 64 61 74 61 29 E!?. ;; data)
0c20: 29 20 3b 3b 20 72 65 74 75 72 6e 20 74 68 65 20 ) ;; return the
0c30: 63 68 61 6e 67 65 64 20 61 6e 64 20 64 65 6c 65 changed and dele
0c40: 74 65 64 20 6c 69 73 74 0a 20 20 20 20 28 6c 69 ted list. (li
0c50: 73 74 20 6e 65 77 64 61 74 20 72 65 6d 6f 76 73 st newdat removs
0c60: 29 29 29 20 3b 3b 20 73 79 6e 63 68 61 73 68 29 ))) ;; synchash)
0c70: 29 0a 0a 28 64 65 66 69 6e 65 20 2a 73 79 6e 63 )..(define *sync
0c80: 68 61 73 68 65 73 2a 20 28 6d 61 6b 65 2d 68 61 hashes* (make-ha
0c90: 73 68 2d 74 61 62 6c 65 29 29 0a 0a 28 64 65 66 sh-table))..(def
0ca0: 69 6e 65 20 28 73 79 6e 63 68 61 73 68 3a 73 65 ine (synchash:se
0cb0: 72 76 65 72 2d 67 65 74 20 64 62 73 74 72 75 63 rver-get dbstruc
0cc0: 74 20 72 75 6e 2d 69 64 20 70 72 6f 63 20 73 79 t run-id proc sy
0cd0: 6e 63 6b 65 79 20 6b 65 79 6e 75 6d 20 70 61 72 nckey keynum par
0ce0: 61 6d 73 29 0a 20 20 3b 3b 20 28 64 65 62 75 67 ams). ;; (debug
0cf0: 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 2a 64 :print-info 2 *d
0d00: 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a efault-log-port*
0d10: 20 22 73 79 6e 63 6b 65 79 3a 20 22 20 73 79 6e "synckey: " syn
0d20: 63 6b 65 79 20 22 2c 20 6b 65 79 6e 75 6d 3a 20 ckey ", keynum:
0d30: 22 20 6b 65 79 6e 75 6d 20 22 2c 20 70 61 72 61 " keynum ", para
0d40: 6d 73 3a 20 22 20 70 61 72 61 6d 73 29 0a 20 20 ms: " params).
0d50: 28 6c 65 74 2a 20 28 28 64 62 64 61 74 20 20 20 (let* ((dbdat
0d60: 20 20 28 64 62 3a 67 65 74 2d 64 62 20 64 62 73 (db:get-db dbs
0d70: 74 72 75 63 74 20 72 75 6e 2d 69 64 29 29 0a 09 truct run-id))..
0d80: 20 28 64 62 20 20 20 20 20 20 20 20 28 64 62 3a (db (db:
0d90: 64 62 64 61 74 2d 67 65 74 2d 64 62 20 64 62 64 dbdat-get-db dbd
0da0: 61 74 29 29 0a 09 20 28 73 79 6e 63 68 61 73 68 at)).. (synchash
0db0: 20 20 28 68 61 73 68 2d 74 61 62 6c 65 2d 72 65 (hash-table-re
0dc0: 66 2f 64 65 66 61 75 6c 74 20 2a 73 79 6e 63 68 f/default *synch
0dd0: 61 73 68 65 73 2a 20 73 79 6e 63 6b 65 79 20 23 ashes* synckey #
0de0: 66 29 29 0a 09 20 28 6e 65 77 64 61 74 20 20 20 f)).. (newdat
0df0: 20 28 61 70 70 6c 79 20 28 63 61 73 65 20 70 72 (apply (case pr
0e00: 6f 63 0a 09 09 09 20 20 20 20 20 28 28 64 62 3a oc.... ((db:
0e10: 67 65 74 2d 72 75 6e 73 29 20 20 20 20 20 20 20 get-runs)
0e20: 20 20 20 20 20 20 20 20 20 20 20 20 64 62 3a 67 db:g
0e30: 65 74 2d 72 75 6e 73 29 0a 09 09 09 20 20 20 20 et-runs)....
0e40: 20 28 28 64 62 3a 67 65 74 2d 74 65 73 74 73 2d ((db:get-tests-
0e50: 66 6f 72 2d 72 75 6e 2d 6d 69 6e 64 61 74 61 29 for-run-mindata)
0e60: 20 20 64 62 3a 67 65 74 2d 74 65 73 74 73 2d 66 db:get-tests-f
0e70: 6f 72 2d 72 75 6e 2d 6d 69 6e 64 61 74 61 29 0a or-run-mindata).
0e80: 09 09 09 20 20 20 20 20 28 28 64 62 3a 67 65 74 ... ((db:get
0e90: 2d 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 -test-info-by-id
0ea0: 73 29 20 20 20 20 20 20 20 64 62 3a 67 65 74 2d s) db:get-
0eb0: 74 65 73 74 2d 69 6e 66 6f 2d 62 79 2d 69 64 73 test-info-by-ids
0ec0: 29 0a 09 09 09 20 20 20 20 20 28 65 6c 73 65 0a ).... (else.
0ed0: 09 09 09 20 20 20 20 20 20 28 70 72 69 6e 74 20 ... (print
0ee0: 22 45 52 52 4f 52 3a 20 73 79 6e 63 20 66 6f 72 "ERROR: sync for
0ef0: 20 68 61 73 68 20 22 20 70 72 6f 63 20 22 20 6e hash " proc " n
0f00: 6f 74 20 73 65 74 75 70 21 20 45 64 69 74 73 20 ot setup! Edits
0f10: 6e 65 65 64 65 64 20 69 6e 20 73 79 6e 63 68 61 needed in syncha
0f20: 73 68 2e 73 63 6d 22 29 0a 09 09 09 20 20 20 20 sh.scm")....
0f30: 20 20 70 72 69 6e 74 29 29 0a 09 09 09 20 20 20 print))....
0f40: 64 62 20 70 61 72 61 6d 73 29 29 0a 09 20 28 70 db params)).. (p
0f50: 6f 73 74 64 61 74 20 20 23 66 29 0a 09 20 28 6d ostdat #f).. (m
0f60: 61 6b 65 2d 69 6e 64 65 78 65 64 20 28 6c 61 6d ake-indexed (lam
0f70: 62 64 61 20 28 78 29 0a 09 09 09 20 28 6c 69 73 bda (x).... (lis
0f80: 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 t (vector-ref x
0f90: 6b 65 79 6e 75 6d 29 20 78 29 29 29 29 0a 20 20 keynum) x)))).
0fa0: 20 20 3b 3b 20 4e 6f 77 20 70 72 6f 63 65 73 73 ;; Now process
0fb0: 20 6e 65 77 64 61 74 20 62 61 73 65 64 20 6f 6e newdat based on
0fc0: 20 74 68 65 20 71 75 65 72 79 20 74 79 70 65 0a the query type.
0fd0: 20 20 20 20 28 73 65 74 21 20 70 6f 73 74 64 61 (set! postda
0fe0: 74 20 28 63 61 73 65 20 70 72 6f 63 0a 09 09 20 t (case proc...
0ff0: 20 20 20 28 28 64 62 3a 67 65 74 2d 72 75 6e 73 ((db:get-runs
1000: 29 0a 09 09 20 20 20 20 20 3b 3b 20 28 64 65 62 )... ;; (deb
1010: 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 32 20 ug:print-info 2
1020: 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 6f 72 *default-log-por
1030: 74 2a 20 22 47 65 74 20 72 75 6e 73 20 63 61 6c t* "Get runs cal
1040: 6c 22 29 0a 09 09 20 20 20 20 20 28 6c 65 74 20 l")... (let
1050: 28 28 68 65 61 64 65 72 20 28 76 65 63 74 6f 72 ((header (vector
1060: 2d 72 65 66 20 6e 65 77 64 61 74 20 30 29 29 0a -ref newdat 0)).
1070: 09 09 09 20 20 20 28 64 61 74 61 20 20 20 28 76 ... (data (v
1080: 65 63 74 6f 72 2d 72 65 66 20 6e 65 77 64 61 74 ector-ref newdat
1090: 20 31 29 29 29 0a 09 09 20 20 20 20 20 20 20 3b 1)))... ;
10a0: 3b 20 28 64 65 62 75 67 3a 70 72 69 6e 74 2d 69 ; (debug:print-i
10b0: 6e 66 6f 20 32 20 2a 64 65 66 61 75 6c 74 2d 6c nfo 2 *default-l
10c0: 6f 67 2d 70 6f 72 74 2a 20 22 68 65 61 64 65 72 og-port* "header
10d0: 3a 20 22 20 68 65 61 64 65 72 20 22 2c 20 64 61 : " header ", da
10e0: 74 61 3a 20 22 20 64 61 74 61 29 0a 09 09 20 20 ta: " data)...
10f0: 20 20 20 20 20 28 63 6f 6e 73 20 28 6c 69 73 74 (cons (list
1100: 20 22 68 65 61 64 65 72 22 20 68 65 61 64 65 72 "header" header
1110: 29 20 20 20 20 20 20 20 20 20 3b 3b 20 61 64 64 ) ;; add
1120: 20 74 68 65 20 68 65 61 64 65 72 20 6b 65 79 65 the header keye
1130: 64 20 62 79 20 74 68 65 20 77 6f 72 64 20 22 68 d by the word "h
1140: 65 61 64 65 72 22 0a 09 09 09 20 20 20 20 20 28 eader".... (
1150: 6d 61 70 20 6d 61 6b 65 2d 69 6e 64 65 78 65 64 map make-indexed
1160: 20 64 61 74 61 29 29 29 29 20 20 20 20 20 20 20 data))))
1170: 20 3b 3b 20 61 64 64 20 65 61 63 68 20 65 6c 65 ;; add each ele
1180: 6d 65 6e 74 20 6b 65 79 65 64 20 62 79 20 74 68 ment keyed by th
1190: 65 20 6b 65 79 6e 75 6d 27 74 68 20 76 61 6c 0a e keynum'th val.
11a0: 09 09 20 20 20 20 28 65 6c 73 65 20 0a 09 09 20 .. (else ...
11b0: 20 20 20 20 3b 3b 20 28 64 65 62 75 67 3a 70 72 ;; (debug:pr
11c0: 69 6e 74 2d 69 6e 66 6f 20 32 20 2a 64 65 66 61 int-info 2 *defa
11d0: 75 6c 74 2d 6c 6f 67 2d 70 6f 72 74 2a 20 22 4e ult-log-port* "N
11e0: 6f 6e 2d 67 65 74 20 72 75 6e 73 20 63 61 6c 6c on-get runs call
11f0: 22 29 0a 09 09 20 20 20 20 20 28 6d 61 70 20 6d ")... (map m
1200: 61 6b 65 2d 69 6e 64 65 78 65 64 20 6e 65 77 64 ake-indexed newd
1210: 61 74 29 29 29 29 0a 20 20 20 20 3b 3b 20 28 64 at)))). ;; (d
1220: 65 62 75 67 3a 70 72 69 6e 74 2d 69 6e 66 6f 20 ebug:print-info
1230: 32 20 2a 64 65 66 61 75 6c 74 2d 6c 6f 67 2d 70 2 *default-log-p
1240: 6f 72 74 2a 20 22 70 6f 73 74 64 61 74 3a 20 22 ort* "postdat: "
1250: 20 70 6f 73 74 64 61 74 29 0a 20 20 20 20 3b 3b postdat). ;;
1260: 20 28 69 66 20 28 6e 6f 74 20 69 6e 64 62 29 28 (if (not indb)(
1270: 73 71 6c 69 74 65 33 3a 66 69 6e 61 6c 69 7a 65 sqlite3:finalize
1280: 21 20 64 62 29 29 0a 20 20 20 20 28 69 66 20 28 ! db)). (if (
1290: 6e 6f 74 20 73 79 6e 63 68 61 73 68 29 0a 09 28 not synchash)..(
12a0: 62 65 67 69 6e 0a 09 20 20 28 73 65 74 21 20 73 begin.. (set! s
12b0: 79 6e 63 68 61 73 68 20 28 6d 61 6b 65 2d 68 61 ynchash (make-ha
12c0: 73 68 2d 74 61 62 6c 65 29 29 0a 09 20 20 28 68 sh-table)).. (h
12d0: 61 73 68 2d 74 61 62 6c 65 2d 73 65 74 21 20 2a ash-table-set! *
12e0: 73 79 6e 63 68 61 73 68 65 73 2a 20 73 79 6e 63 synchashes* sync
12f0: 6b 65 79 20 73 79 6e 63 68 61 73 68 29 29 29 0a key synchash))).
1300: 20 20 20 20 28 73 79 6e 63 68 61 73 68 3a 67 65 (synchash:ge
1310: 74 2d 64 65 6c 74 61 20 70 6f 73 74 64 61 74 20 t-delta postdat
1320: 73 79 6e 63 68 61 73 68 29 29 29 0a 0a synchash)))..