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 37 2c right 2006-2017,
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 20 54 68 69 73 20 70 ..;; .;; This p
0080: 72 6f 67 72 61 6d 20 69 73 20 6d 61 64 65 20 61 rogram is made a
0090: 76 61 69 6c 61 62 6c 65 20 75 6e 64 65 72 20 74 vailable under t
00a0: 68 65 20 47 4e 55 20 47 50 4c 20 76 65 72 73 69 he GNU GPL versi
00b0: 6f 6e 20 32 2e 30 20 6f 72 0a 3b 3b 20 20 67 72 on 2.0 or.;; gr
00c0: 65 61 74 65 72 2e 20 53 65 65 20 74 68 65 20 61 eater. See the a
00d0: 63 63 6f 6d 70 61 6e 79 69 6e 67 20 66 69 6c 65 ccompanying file
00e0: 20 43 4f 50 59 49 4e 47 20 66 6f 72 20 64 65 74 COPYING for det
00f0: 61 69 6c 73 2e 0a 3b 3b 20 0a 3b 3b 20 20 54 68 ails..;; .;; Th
0100: 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 64 69 is program is di
0110: 73 74 72 69 62 75 74 65 64 20 57 49 54 48 4f 55 stributed WITHOU
0120: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY;
0130: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the
0140: 0a 3b 3b 20 20 69 6d 70 6c 69 65 64 20 77 61 72 .;; implied war
0150: 72 61 6e 74 79 20 6f 66 20 4d 45 52 43 48 41 4e ranty of MERCHAN
0160: 54 41 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e TABILITY or FITN
0170: 45 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 ESS FOR A PARTIC
0180: 55 4c 41 52 0a 3b 3b 20 20 50 55 52 50 4f 53 45 ULAR.;; PURPOSE
0190: 2e 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..;;============
01a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
01d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 63 ==========..(dec
01e0: 6c 61 72 65 20 28 75 6e 69 74 20 70 67 64 62 29 lare (unit pgdb)
01f0: 29 0a 28 64 65 63 6c 61 72 65 20 28 75 73 65 73 ).(declare (uses
0200: 20 63 6f 6e 66 69 67 66 29 29 0a 0a 3b 3b 20 49 configf))..;; I
0210: 20 64 6f 6e 27 74 20 6b 6e 6f 77 20 68 6f 77 20 don't know how
0220: 74 6f 20 6d 69 78 20 63 6f 6d 70 69 6c 61 74 69 to mix compilati
0230: 6f 6e 20 75 6e 69 74 73 20 61 6e 64 20 6d 6f 64 on units and mod
0240: 75 6c 65 73 2c 20 73 6f 20 6e 6f 20 6d 6f 64 75 ules, so no modu
0250: 6c 65 20 68 65 72 65 2e 0a 3b 3b 0a 3b 3b 20 28 le here..;;.;; (
0260: 6d 6f 64 75 6c 65 20 70 67 64 62 0a 3b 3b 20 20 module pgdb.;;
0270: 20 20 20 28 0a 3b 3b 20 20 20 20 20 20 6f 70 65 (.;; ope
0280: 6e 2d 70 67 64 62 0a 3b 3b 20 20 20 20 20 20 29 n-pgdb.;; )
0290: 0a 3b 3b 20 0a 3b 3b 20 28 69 6d 70 6f 72 74 20 .;; .;; (import
02a0: 73 63 68 65 6d 65 29 0a 3b 3b 20 28 69 6d 70 6f scheme).;; (impo
02b0: 72 74 20 64 61 74 61 2d 73 74 72 75 63 74 75 72 rt data-structur
02c0: 65 73 29 0a 3b 3b 20 28 69 6d 70 6f 72 74 20 63 es).;; (import c
02d0: 68 69 63 6b 65 6e 29 0a 0a 28 75 73 65 20 74 79 hicken)..(use ty
02e0: 70 65 64 2d 72 65 63 6f 72 64 73 20 28 70 72 65 ped-records (pre
02f0: 66 69 78 20 64 62 69 20 64 62 69 3a 29 29 0a 0a fix dbi dbi:))..
0300: 3b 3b 20 67 69 76 65 6e 20 61 20 63 6f 6e 66 69 ;; given a confi
0310: 67 64 61 74 20 6c 6f 6f 6b 75 70 20 74 68 65 20 gdat lookup the
0320: 63 6f 6e 6e 65 63 74 69 6f 6e 20 69 6e 66 6f 20 connection info
0330: 61 6e 64 20 6f 70 65 6e 20 74 68 65 20 64 62 0a and open the db.
0340: 3b 3b 0a 28 64 65 66 69 6e 65 20 28 70 67 64 62 ;;.(define (pgdb
0350: 3a 6f 70 65 6e 20 63 6f 6e 66 69 67 64 61 74 20 :open configdat
0360: 23 21 6b 65 79 20 28 64 62 6e 61 6d 65 20 23 66 #!key (dbname #f
0370: 29 29 20 20 0a 20 20 28 6c 65 74 20 28 28 70 67 )) . (let ((pg
0380: 63 6f 6e 66 20 28 63 6f 6e 66 69 67 66 3a 6c 6f conf (configf:lo
0390: 6f 6b 75 70 20 63 6f 6e 66 69 67 64 61 74 20 22 okup configdat "
03a0: 65 78 74 2d 73 79 6e 63 22 20 28 6f 72 20 64 62 ext-sync" (or db
03b0: 6e 61 6d 65 20 22 70 67 64 62 22 29 29 29 29 0a name "pgdb")))).
03c0: 20 20 20 20 28 69 66 20 70 67 63 6f 6e 66 0a 09 (if pgconf..
03d0: 28 6c 65 74 2a 20 28 28 63 6f 6e 66 64 61 74 20 (let* ((confdat
03e0: 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 63 6f (map (lambda (co
03f0: 6e 66 2d 69 74 65 6d 29 0a 09 09 09 20 20 20 20 nf-item)....
0400: 20 20 20 28 6c 65 74 20 28 28 70 61 72 74 73 20 (let ((parts
0410: 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 20 63 6f (string-split co
0420: 6e 66 2d 69 74 65 6d 20 22 3a 22 29 29 29 0a 09 nf-item ":")))..
0430: 09 09 09 20 28 69 66 20 28 3e 20 28 6c 65 6e 67 ... (if (> (leng
0440: 74 68 20 70 61 72 74 73 29 20 31 29 0a 09 09 09 th parts) 1)....
0450: 09 20 20 20 20 20 28 6c 65 74 20 28 28 6b 65 79 . (let ((key
0460: 20 28 63 61 72 20 70 61 72 74 73 29 29 0a 09 09 (car parts))...
0470: 09 09 09 20 20 20 28 76 61 6c 20 28 63 61 64 72 ... (val (cadr
0480: 20 70 61 72 74 73 29 29 29 0a 09 09 09 09 20 20 parts))).....
0490: 20 20 20 20 20 28 63 6f 6e 73 20 28 73 74 72 69 (cons (stri
04a0: 6e 67 2d 3e 73 79 6d 62 6f 6c 20 6b 65 79 29 20 ng->symbol key)
04b0: 76 61 6c 29 29 0a 09 09 09 09 20 20 20 20 20 28 val))..... (
04c0: 62 65 67 69 6e 0a 09 09 09 09 20 20 20 20 20 20 begin.....
04d0: 20 28 70 72 69 6e 74 20 22 45 52 52 4f 52 3a 20 (print "ERROR:
04e0: 42 61 64 20 63 6f 6e 66 69 67 20 73 65 74 74 69 Bad config setti
04f0: 6e 67 20 22 20 63 6f 6e 66 2d 69 74 65 6d 20 22 ng " conf-item "
0500: 2c 20 73 68 6f 75 6c 64 20 62 65 20 6b 65 79 3a , should be key:
0510: 76 61 6c 22 29 0a 09 09 09 09 20 20 20 20 20 20 val").....
0520: 20 60 28 2c 28 73 74 72 69 6e 67 2d 3e 73 79 6d `(,(string->sym
0530: 62 6f 6c 20 28 63 61 72 20 70 61 72 74 73 29 29 bol (car parts))
0540: 20 2e 20 23 66 29 29 29 29 29 0a 09 09 09 20 20 . #f)))))....
0550: 20 20 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 (string-split
0560: 20 70 67 63 6f 6e 66 29 29 29 0a 09 20 20 20 20 pgconf)))..
0570: 20 20 20 28 64 62 74 79 70 65 20 20 20 28 73 74 (dbtype (st
0580: 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 6f 72 ring->symbol (or
0590: 20 28 61 6c 69 73 74 2d 72 65 66 20 27 64 62 74 (alist-ref 'dbt
05a0: 79 70 65 20 63 6f 6e 66 64 61 74 29 20 22 70 67 ype confdat) "pg
05b0: 22 29 29 29 29 0a 09 20 20 28 69 66 20 28 61 6c ")))).. (if (al
05c0: 69 73 74 2d 72 65 66 20 27 64 62 74 79 70 65 20 ist-ref 'dbtype
05d0: 63 6f 6e 66 64 61 74 29 0a 09 20 20 20 20 20 20 confdat)..
05e0: 28 64 62 69 3a 6f 70 65 6e 20 64 62 74 79 70 65 (dbi:open dbtype
05f0: 20 28 61 6c 69 73 74 2d 64 65 6c 65 74 65 20 27 (alist-delete '
0600: 64 62 74 79 70 65 20 63 6f 6e 66 64 61 74 29 29 dbtype confdat))
0610: 29 29 0a 09 23 66 29 29 29 0a 0a 3b 3b 3d 3d 3d ))..#f)))..;;===
0620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0650: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0660: 3d 3d 3d 0a 3b 3b 20 20 41 20 52 20 45 20 41 20 ===.;; A R E A
0670: 53 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d S.;;============
0680: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
06b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 ==========..(def
06c0: 73 74 72 75 63 74 20 61 72 65 61 20 69 64 20 61 struct area id a
06d0: 72 65 61 2d 6e 61 6d 65 20 61 72 65 61 2d 70 61 rea-name area-pa
06e0: 74 68 20 6c 61 73 74 2d 75 70 64 61 74 65 29 0a th last-update).
06f0: 0a 28 64 65 66 69 6e 65 20 28 70 67 64 62 3a 61 .(define (pgdb:a
0700: 64 64 2d 61 72 65 61 20 64 62 68 20 61 72 65 61 dd-area dbh area
0710: 2d 6e 61 6d 65 20 61 72 65 61 2d 70 61 74 68 29 -name area-path)
0720: 0a 20 20 28 64 62 69 3a 65 78 65 63 20 64 62 68 . (dbi:exec dbh
0730: 20 22 49 4e 53 45 52 54 20 49 4e 54 4f 20 61 72 "INSERT INTO ar
0740: 65 61 73 20 28 61 72 65 61 5f 6e 61 6d 65 2c 61 eas (area_name,a
0750: 72 65 61 5f 70 61 74 68 29 20 56 41 4c 55 45 53 rea_path) VALUES
0760: 20 28 3f 2c 3f 29 22 20 61 72 65 61 2d 6e 61 6d (?,?)" area-nam
0770: 65 20 61 72 65 61 2d 70 61 74 68 29 29 0a 0a 28 e area-path))..(
0780: 64 65 66 69 6e 65 20 28 70 67 64 62 3a 67 65 74 define (pgdb:get
0790: 2d 61 72 65 61 73 20 64 62 68 29 0a 20 20 28 6d -areas dbh). (m
07a0: 61 70 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 72 ap. (lambda (r
07b0: 6f 77 29 0a 20 20 20 20 20 28 70 72 69 6e 74 20 ow). (print
07c0: 22 72 6f 77 3a 20 22 20 72 6f 77 29 29 0a 20 20 "row: " row)).
07d0: 20 28 64 62 69 3a 67 65 74 2d 72 6f 77 73 20 64 (dbi:get-rows d
07e0: 62 68 20 22 53 45 4c 45 43 54 20 69 64 2c 61 72 bh "SELECT id,ar
07f0: 65 61 5f 6e 61 6d 65 2c 61 72 65 61 5f 70 61 74 ea_name,area_pat
0800: 68 2c 6c 61 73 74 5f 73 79 6e 63 20 46 52 4f 4d h,last_sync FROM
0810: 20 61 72 65 61 73 3b 22 29 29 29 0a 0a 3b 3b 20 areas;")))..;;
0820: 67 69 76 65 6e 20 61 6e 20 61 72 65 61 5f 70 61 given an area_pa
0830: 74 68 20 67 65 74 20 74 68 65 20 61 72 65 61 20 th get the area
0840: 69 6e 66 6f 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 info.;;.(define
0850: 28 70 67 64 62 3a 67 65 74 2d 61 72 65 61 2d 62 (pgdb:get-area-b
0860: 79 2d 70 61 74 68 20 64 62 68 20 61 72 65 61 2d y-path dbh area-
0870: 70 61 74 68 29 0a 20 20 28 64 62 69 3a 67 65 74 path). (dbi:get
0880: 2d 6f 6e 65 2d 72 6f 77 20 64 62 68 20 22 53 45 -one-row dbh "SE
0890: 4c 45 43 54 20 69 64 2c 61 72 65 61 5f 6e 61 6d LECT id,area_nam
08a0: 65 2c 61 72 65 61 5f 70 61 74 68 2c 6c 61 73 74 e,area_path,last
08b0: 5f 73 79 6e 63 20 46 52 4f 4d 20 61 72 65 61 73 _sync FROM areas
08c0: 20 57 48 45 52 45 20 61 72 65 61 5f 70 61 74 68 WHERE area_path
08d0: 3d 3f 3b 22 20 61 72 65 61 2d 70 61 74 68 29 29 =?;" area-path))
08e0: 0a 0a 28 64 65 66 69 6e 65 20 28 70 67 64 62 3a ..(define (pgdb:
08f0: 77 72 69 74 65 2d 73 79 6e 63 2d 74 69 6d 65 20 write-sync-time
0900: 64 62 68 20 61 72 65 61 2d 69 6e 66 6f 20 6e 65 dbh area-info ne
0910: 77 2d 73 79 6e 63 2d 74 69 6d 65 29 0a 20 20 28 w-sync-time). (
0920: 6c 65 74 20 28 28 61 72 65 61 2d 69 64 20 28 76 let ((area-id (v
0930: 65 63 74 6f 72 2d 72 65 66 20 61 72 65 61 2d 69 ector-ref area-i
0940: 6e 66 6f 20 30 29 29 29 0a 20 20 20 20 28 64 62 nfo 0))). (db
0950: 69 3a 65 78 65 63 20 64 62 68 20 22 55 50 44 41 i:exec dbh "UPDA
0960: 54 45 20 61 72 65 61 73 20 53 45 54 20 6c 61 73 TE areas SET las
0970: 74 5f 73 79 6e 63 3d 3f 20 57 48 45 52 45 20 69 t_sync=? WHERE i
0980: 64 3d 3f 3b 22 20 6e 65 77 2d 73 79 6e 63 2d 74 d=?;" new-sync-t
0990: 69 6d 65 20 61 72 65 61 2d 69 64 29 29 29 0a 0a ime area-id)))..
09a0: 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ;;==============
09b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
09e0: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b 20 20 54 20 41 ========.;; T A
09f0: 20 52 20 47 20 45 20 54 20 53 0a 3b 3b 3d 3d 3d R G E T S.;;===
0a00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0a10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
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 0a 0a 3b 3b 20 47 69 76 65 6e 20 61 20 ===..;; Given a
0a50: 74 61 72 67 65 74 2d 73 70 65 63 2c 20 72 65 74 target-spec, ret
0a60: 75 72 6e 20 74 68 65 20 69 64 2e 20 53 68 6f 75 urn the id. Shou
0a70: 6c 64 20 70 72 6f 62 61 62 6c 79 20 68 61 6e 64 ld probably hand
0a80: 6c 65 20 74 68 69 73 20 77 69 74 68 20 61 20 6a le this with a j
0a90: 6f 69 6e 2e 2e 2e 0a 3b 3b 20 69 66 20 74 61 72 oin....;; if tar
0aa0: 67 65 74 2d 73 70 65 63 20 6e 6f 74 20 66 6f 75 get-spec not fou
0ab0: 6e 64 2c 20 63 72 65 61 74 65 20 61 20 72 65 63 nd, create a rec
0ac0: 6f 72 64 20 66 6f 72 20 69 74 2e 0a 3b 3b 0a 28 ord for it..;;.(
0ad0: 64 65 66 69 6e 65 20 28 70 67 64 62 3a 67 65 74 define (pgdb:get
0ae0: 2d 74 74 79 70 65 20 64 62 68 20 74 61 72 67 65 -ttype dbh targe
0af0: 74 2d 73 70 65 63 29 0a 20 20 28 6c 65 74 20 28 t-spec). (let (
0b00: 28 73 70 65 63 2d 69 64 20 28 64 62 69 3a 67 65 (spec-id (dbi:ge
0b10: 74 2d 6f 6e 65 20 64 62 68 20 22 53 45 4c 45 43 t-one dbh "SELEC
0b20: 54 20 69 64 20 46 52 4f 4d 20 74 74 79 70 65 20 T id FROM ttype
0b30: 57 48 45 52 45 20 74 61 72 67 65 74 5f 73 70 65 WHERE target_spe
0b40: 63 3d 3f 3b 22 20 74 61 72 67 65 74 2d 73 70 65 c=?;" target-spe
0b50: 63 29 29 29 0a 20 20 20 20 28 6f 72 20 73 70 65 c))). (or spe
0b60: 63 2d 69 64 0a 09 28 69 66 20 28 68 61 6e 64 6c c-id..(if (handl
0b70: 65 2d 65 78 63 65 70 74 69 6f 6e 73 0a 09 09 65 e-exceptions...e
0b80: 78 6e 0a 09 09 28 62 65 67 69 6e 0a 09 09 20 20 xn...(begin...
0b90: 28 70 72 69 6e 74 2d 63 61 6c 6c 2d 63 68 61 69 (print-call-chai
0ba0: 6e 29 0a 09 09 20 20 28 64 65 62 75 67 3a 70 72 n)... (debug:pr
0bb0: 69 6e 74 20 30 20 2a 64 65 66 61 75 6c 74 2d 6c int 0 *default-l
0bc0: 6f 67 2d 70 6f 72 74 2a 20 22 45 52 52 4f 52 3a og-port* "ERROR:
0bd0: 20 63 61 6e 6e 6f 74 20 63 72 65 61 74 65 20 74 cannot create t
0be0: 74 79 70 65 20 65 6e 74 72 79 2c 20 22 20 28 28 type entry, " ((
0bf0: 63 6f 6e 64 69 74 69 6f 6e 2d 70 72 6f 70 65 72 condition-proper
0c00: 74 79 2d 61 63 63 65 73 73 6f 72 20 27 65 78 6e ty-accessor 'exn
0c10: 20 27 6d 65 73 73 61 67 65 29 20 65 78 6e 29 29 'message) exn))
0c20: 0a 09 09 20 20 23 66 29 0a 09 20 20 20 20 20 20 ... #f)..
0c30: 28 64 62 69 3a 65 78 65 63 20 64 62 68 20 22 49 (dbi:exec dbh "I
0c40: 4e 53 45 52 54 20 49 4e 54 4f 20 74 74 79 70 65 NSERT INTO ttype
0c50: 20 28 74 61 72 67 65 74 5f 73 70 65 63 29 20 56 (target_spec) V
0c60: 41 4c 55 45 53 20 28 3f 29 3b 22 20 74 61 72 67 ALUES (?);" targ
0c70: 65 74 2d 73 70 65 63 29 29 0a 09 20 20 20 20 28 et-spec)).. (
0c80: 70 67 64 62 3a 67 65 74 2d 74 74 79 70 65 20 64 pgdb:get-ttype d
0c90: 62 68 20 74 61 72 67 65 74 2d 73 70 65 63 29 29 bh target-spec))
0ca0: 29 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d )))..;;=========
0cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0cd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
0cf0: 20 20 52 20 55 20 4e 20 53 0a 3b 3b 3d 3d 3d 3d R U N S.;;====
0d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0d40: 3d 3d 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 20 74 ==..;; given a t
0d50: 61 72 67 65 74 20 73 70 65 63 20 69 64 2c 20 74 arget spec id, t
0d60: 61 72 67 65 74 20 61 6e 64 20 72 75 6e 2d 6e 61 arget and run-na
0d70: 6d 65 20 72 65 74 75 72 6e 20 74 68 65 20 72 75 me return the ru
0d80: 6e 2d 69 64 0a 3b 3b 20 69 66 20 6e 6f 20 72 75 n-id.;; if no ru
0d90: 6e 20 66 6f 75 6e 64 20 72 65 74 75 72 6e 20 23 n found return #
0da0: 66 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 70 67 f.;;.(define (pg
0db0: 64 62 3a 67 65 74 2d 72 75 6e 2d 69 64 20 64 62 db:get-run-id db
0dc0: 68 20 73 70 65 63 2d 69 64 20 74 61 72 67 65 74 h spec-id target
0dd0: 20 72 75 6e 2d 6e 61 6d 65 29 0a 20 20 28 64 62 run-name). (db
0de0: 69 3a 67 65 74 2d 6f 6e 65 20 64 62 68 20 22 53 i:get-one dbh "S
0df0: 45 4c 45 43 54 20 69 64 20 46 52 4f 4d 20 72 75 ELECT id FROM ru
0e00: 6e 73 20 57 48 45 52 45 20 74 74 79 70 65 5f 69 ns WHERE ttype_i
0e10: 64 3d 3f 20 41 4e 44 20 74 61 72 67 65 74 3d 3f d=? AND target=?
0e20: 20 41 4e 44 20 72 75 6e 5f 6e 61 6d 65 3d 3f 3b AND run_name=?;
0e30: 22 0a 09 20 20 20 20 20 20 20 73 70 65 63 2d 69 ".. spec-i
0e40: 64 20 74 61 72 67 65 74 20 72 75 6e 2d 6e 61 6d d target run-nam
0e50: 65 29 29 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 20 e))..;; given a
0e60: 72 75 6e 2d 69 64 20 72 65 74 75 72 6e 20 61 6c run-id return al
0e70: 6c 20 74 68 65 20 72 75 6e 20 69 6e 66 6f 0a 3b l the run info.;
0e80: 3b 0a 28 64 65 66 69 6e 65 20 28 70 67 64 62 3a ;.(define (pgdb:
0e90: 67 65 74 2d 72 75 6e 2d 69 6e 66 6f 20 64 62 68 get-run-info dbh
0ea0: 20 72 75 6e 2d 69 64 29 20 3b 3b 20 74 6f 20 6a run-id) ;; to j
0eb0: 6f 69 6e 20 74 74 79 70 65 20 6f 72 20 6e 6f 74 oin ttype or not
0ec0: 3f 0a 20 20 28 64 62 69 3a 67 65 74 2d 6f 6e 65 ?. (dbi:get-one
0ed0: 2d 72 6f 77 0a 20 20 20 64 62 68 20 20 20 3b 3b -row. dbh ;;
0ee0: 20 30 20 20 20 20 31 20 20 20 20 20 20 20 32 20 0 1 2
0ef0: 20 20 20 20 20 20 33 20 20 20 20 20 20 34 20 20 3 4
0f00: 20 20 20 35 20 20 20 20 20 20 36 20 20 20 20 20 5 6
0f10: 20 20 37 20 20 20 20 20 20 20 20 38 20 20 20 20 7 8
0f20: 20 20 20 20 20 39 20 20 20 20 20 20 20 20 20 31 9 1
0f30: 30 20 20 20 20 20 20 20 20 20 20 31 31 20 20 20 0 11
0f40: 20 20 20 20 20 20 31 32 0a 20 20 20 22 53 45 4c 12. "SEL
0f50: 45 43 54 20 69 64 2c 74 61 72 67 65 74 2c 74 74 ECT id,target,tt
0f60: 79 70 65 5f 69 64 2c 72 75 6e 5f 6e 61 6d 65 2c ype_id,run_name,
0f70: 73 74 61 74 65 2c 73 74 61 74 75 73 2c 6f 77 6e state,status,own
0f80: 65 72 2c 65 76 65 6e 74 5f 74 69 6d 65 2c 63 6f er,event_time,co
0f90: 6d 6d 65 6e 74 2c 66 61 69 6c 5f 63 6f 75 6e 74 mment,fail_count
0fa0: 2c 70 61 73 73 5f 63 6f 75 6e 74 2c 6c 61 73 74 ,pass_count,last
0fb0: 5f 75 70 64 61 74 65 2c 61 72 65 61 5f 69 64 0a _update,area_id.
0fc0: 20 20 20 20 20 20 20 46 52 4f 4d 20 72 75 6e 73 FROM runs
0fd0: 20 57 48 45 52 45 20 69 64 3d 3f 3b 22 20 72 75 WHERE id=?;" ru
0fe0: 6e 2d 69 64 29 29 0a 0a 3b 3b 20 72 65 66 72 65 n-id))..;; refre
0ff0: 73 68 20 74 68 65 20 64 61 74 61 20 69 6e 20 61 sh the data in a
1000: 20 72 75 6e 20 72 65 63 6f 72 64 0a 3b 3b 0a 28 run record.;;.(
1010: 64 65 66 69 6e 65 20 28 70 67 64 62 3a 72 65 66 define (pgdb:ref
1020: 72 65 73 68 2d 72 75 6e 2d 69 6e 66 6f 20 64 62 resh-run-info db
1030: 68 20 72 75 6e 2d 69 64 20 73 74 61 74 65 20 73 h run-id state s
1040: 74 61 74 75 73 20 6f 77 6e 65 72 20 65 76 65 6e tatus owner even
1050: 74 2d 74 69 6d 65 20 63 6f 6d 6d 65 6e 74 20 66 t-time comment f
1060: 61 69 6c 2d 63 6f 75 6e 74 20 70 61 73 73 2d 63 ail-count pass-c
1070: 6f 75 6e 74 29 20 3b 3b 20 61 72 65 61 2d 69 64 ount) ;; area-id
1080: 29 0a 20 20 28 64 62 69 3a 65 78 65 63 0a 20 20 ). (dbi:exec.
1090: 20 64 62 68 0a 20 20 20 22 55 50 44 41 54 45 20 dbh. "UPDATE
10a0: 72 75 6e 73 20 53 45 54 0a 20 20 20 20 20 20 73 runs SET. s
10b0: 74 61 74 65 3d 3f 2c 73 74 61 74 75 73 3d 3f 2c tate=?,status=?,
10c0: 6f 77 6e 65 72 3d 3f 2c 65 76 65 6e 74 5f 74 69 owner=?,event_ti
10d0: 6d 65 3d 3f 2c 63 6f 6d 6d 65 6e 74 3d 3f 2c 66 me=?,comment=?,f
10e0: 61 69 6c 5f 63 6f 75 6e 74 3d 3f 2c 70 61 73 73 ail_count=?,pass
10f0: 5f 63 6f 75 6e 74 3d 3f 0a 20 20 20 20 20 57 48 _count=?. WH
1100: 45 52 45 20 69 64 3d 3f 3b 22 0a 20 20 20 73 74 ERE id=?;". st
1110: 61 74 65 20 73 74 61 74 75 73 20 6f 77 6e 65 72 ate status owner
1120: 20 65 76 65 6e 74 2d 74 69 6d 65 20 63 6f 6d 6d event-time comm
1130: 65 6e 74 20 66 61 69 6c 2d 63 6f 75 6e 74 20 70 ent fail-count p
1140: 61 73 73 2d 63 6f 75 6e 74 20 72 75 6e 2d 69 64 ass-count run-id
1150: 29 29 0a 0a 3b 3b 20 67 69 76 65 6e 20 61 6c 6c ))..;; given all
1160: 20 6e 65 65 64 65 64 20 69 6e 66 6f 20 63 72 65 needed info cre
1170: 61 74 65 20 72 75 6e 20 72 65 63 6f 72 64 0a 3b ate run record.;
1180: 3b 0a 28 64 65 66 69 6e 65 20 28 70 67 64 62 3a ;.(define (pgdb:
1190: 69 6e 73 65 72 74 2d 72 75 6e 20 64 62 68 20 74 insert-run dbh t
11a0: 74 79 70 65 2d 69 64 20 74 61 72 67 65 74 20 72 type-id target r
11b0: 75 6e 2d 6e 61 6d 65 20 73 74 61 74 65 20 73 74 un-name state st
11c0: 61 74 75 73 20 6f 77 6e 65 72 20 65 76 65 6e 74 atus owner event
11d0: 2d 74 69 6d 65 20 63 6f 6d 6d 65 6e 74 20 66 61 -time comment fa
11e0: 69 6c 2d 63 6f 75 6e 74 20 70 61 73 73 2d 63 6f il-count pass-co
11f0: 75 6e 74 29 0a 20 20 28 64 62 69 3a 65 78 65 63 unt). (dbi:exec
1200: 0a 20 20 20 64 62 68 0a 20 20 20 22 49 4e 53 45 . dbh. "INSE
1210: 52 54 20 49 4e 54 4f 20 72 75 6e 73 20 28 74 74 RT INTO runs (tt
1220: 79 70 65 5f 69 64 2c 74 61 72 67 65 74 2c 72 75 ype_id,target,ru
1230: 6e 5f 6e 61 6d 65 2c 73 74 61 74 65 2c 73 74 61 n_name,state,sta
1240: 74 75 73 2c 6f 77 6e 65 72 2c 65 76 65 6e 74 5f tus,owner,event_
1250: 74 69 6d 65 2c 63 6f 6d 6d 65 6e 74 2c 66 61 69 time,comment,fai
1260: 6c 5f 63 6f 75 6e 74 2c 70 61 73 73 5f 63 6f 75 l_count,pass_cou
1270: 6e 74 29 0a 20 20 20 20 20 20 56 41 4c 55 45 53 nt). VALUES
1280: 20 28 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c (?,?,?,?,?,?,?,
1290: 3f 2c 3f 2c 3f 29 3b 22 0a 20 20 20 20 74 74 79 ?,?,?);". tty
12a0: 70 65 2d 69 64 20 74 61 72 67 65 74 20 72 75 6e pe-id target run
12b0: 2d 6e 61 6d 65 20 73 74 61 74 65 20 73 74 61 74 -name state stat
12c0: 75 73 20 6f 77 6e 65 72 20 65 76 65 6e 74 2d 74 us owner event-t
12d0: 69 6d 65 20 63 6f 6d 6d 65 6e 74 20 66 61 69 6c ime comment fail
12e0: 2d 63 6f 75 6e 74 20 70 61 73 73 2d 63 6f 75 6e -count pass-coun
12f0: 74 29 29 0a 0a 3b 3b 3d 3d 3d 3d 3d 3d 3d 3d 3d t))..;;=========
1300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 3b =============.;;
1340: 20 20 54 20 45 20 53 20 54 20 53 0a 3b 3b 3d 3d T E S T S.;;==
1350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
1390: 3d 3d 3d 3d 0a 0a 3b 3b 20 67 69 76 65 6e 20 72 ====..;; given r
13a0: 75 6e 2d 69 64 2c 20 74 65 73 74 5f 6e 61 6d 65 un-id, test_name
13b0: 20 61 6e 64 20 69 74 65 6d 5f 70 61 74 68 20 72 and item_path r
13c0: 65 74 75 72 6e 20 74 65 73 74 2d 69 64 0a 3b 3b eturn test-id.;;
13d0: 0a 28 64 65 66 69 6e 65 20 28 70 67 64 62 3a 67 .(define (pgdb:g
13e0: 65 74 2d 74 65 73 74 2d 69 64 20 64 62 68 20 72 et-test-id dbh r
13f0: 75 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 un-id test-name
1400: 69 74 65 6d 2d 70 61 74 68 29 0a 20 20 28 64 62 item-path). (db
1410: 69 3a 67 65 74 2d 6f 6e 65 0a 20 20 20 64 62 68 i:get-one. dbh
1420: 0a 20 20 20 22 53 45 4c 45 43 54 20 69 64 20 46 . "SELECT id F
1430: 52 4f 4d 20 74 65 73 74 73 20 57 48 45 52 45 20 ROM tests WHERE
1440: 72 75 6e 5f 69 64 3d 3f 20 41 4e 44 20 74 65 73 run_id=? AND tes
1450: 74 5f 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 t_name=? AND ite
1460: 6d 5f 70 61 74 68 3d 3f 3b 22 0a 20 20 20 72 75 m_path=?;". ru
1470: 6e 2d 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 n-id test-name i
1480: 74 65 6d 2d 70 61 74 68 29 29 0a 0a 3b 3b 20 63 tem-path))..;; c
1490: 72 65 61 74 65 20 6e 65 77 20 74 65 73 74 20 72 reate new test r
14a0: 65 63 6f 72 64 0a 3b 3b 0a 28 64 65 66 69 6e 65 ecord.;;.(define
14b0: 20 28 70 67 64 62 3a 69 6e 73 65 72 74 2d 74 65 (pgdb:insert-te
14c0: 73 74 20 64 62 68 20 72 75 6e 2d 69 64 20 74 65 st dbh run-id te
14d0: 73 74 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 st-name item-pat
14e0: 68 20 73 74 61 74 65 20 73 74 61 74 75 73 20 68 h state status h
14f0: 6f 73 74 20 63 70 75 6c 6f 61 64 20 64 69 73 6b ost cpuload disk
1500: 66 72 65 65 20 75 6e 61 6d 65 20 72 75 6e 2d 64 free uname run-d
1510: 69 72 20 6c 6f 67 2d 66 69 6c 65 20 72 75 6e 2d ir log-file run-
1520: 64 75 72 61 74 69 6f 6e 20 63 6f 6d 6d 65 6e 74 duration comment
1530: 20 65 76 65 6e 74 2d 74 69 6d 65 20 61 72 63 68 event-time arch
1540: 69 76 65 64 29 0a 20 20 28 64 62 69 3a 65 78 65 ived). (dbi:exe
1550: 63 0a 20 20 20 64 62 68 0a 20 20 20 22 49 4e 53 c. dbh. "INS
1560: 45 52 54 20 49 4e 54 4f 20 74 65 73 74 73 20 28 ERT INTO tests (
1570: 72 75 6e 5f 69 64 2c 74 65 73 74 5f 6e 61 6d 65 run_id,test_name
1580: 2c 69 74 65 6d 5f 70 61 74 68 2c 73 74 61 74 65 ,item_path,state
1590: 2c 73 74 61 74 75 73 2c 68 6f 73 74 2c 63 70 75 ,status,host,cpu
15a0: 6c 6f 61 64 2c 64 69 73 6b 66 72 65 65 2c 75 6e load,diskfree,un
15b0: 61 6d 65 2c 72 75 6e 64 69 72 2c 66 69 6e 61 6c ame,rundir,final
15c0: 5f 6c 6f 67 66 2c 72 75 6e 5f 64 75 72 61 74 69 _logf,run_durati
15d0: 6f 6e 2c 63 6f 6d 6d 65 6e 74 2c 65 76 65 6e 74 on,comment,event
15e0: 5f 74 69 6d 65 2c 61 72 63 68 69 76 65 64 29 0a _time,archived).
15f0: 20 20 20 20 20 20 20 56 41 4c 55 45 53 20 28 3f VALUES (?
1600: 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f ,?,?,?,?,?,?,?,?
1610: 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 29 3b 22 0a ,?,?,?,?,?,?);".
1620: 0a 20 20 20 72 75 6e 2d 69 64 20 20 74 65 73 74 . run-id test
1630: 2d 6e 61 6d 65 20 69 74 65 6d 2d 70 61 74 68 20 -name item-path
1640: 20 20 20 73 74 61 74 65 20 20 20 73 74 61 74 75 state statu
1650: 73 20 20 20 20 20 68 6f 73 74 20 20 63 70 75 6c s host cpul
1660: 6f 61 64 20 64 69 73 6b 66 72 65 65 20 75 6e 61 oad diskfree una
1670: 6d 65 0a 20 20 20 72 75 6e 2d 64 69 72 20 6c 6f me. run-dir lo
1680: 67 2d 66 69 6c 65 20 20 72 75 6e 2d 64 75 72 61 g-file run-dura
1690: 74 69 6f 6e 20 63 6f 6d 6d 65 6e 74 20 65 76 65 tion comment eve
16a0: 6e 74 2d 74 69 6d 65 20 61 72 63 68 69 76 65 64 nt-time archived
16b0: 29 29 0a 0a 3b 3b 20 75 70 64 61 74 65 20 65 78 ))..;; update ex
16c0: 69 73 74 69 6e 67 20 74 65 73 74 20 72 65 63 6f isting test reco
16d0: 72 64 0a 3b 3b 0a 28 64 65 66 69 6e 65 20 28 70 rd.;;.(define (p
16e0: 67 64 62 3a 75 70 64 61 74 65 2d 74 65 73 74 20 gdb:update-test
16f0: 64 62 68 20 74 65 73 74 2d 69 64 20 72 75 6e 2d dbh test-id run-
1700: 69 64 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 id test-name ite
1710: 6d 2d 70 61 74 68 20 73 74 61 74 65 20 73 74 61 m-path state sta
1720: 74 75 73 20 68 6f 73 74 20 63 70 75 6c 6f 61 64 tus host cpuload
1730: 20 64 69 73 6b 66 72 65 65 20 75 6e 61 6d 65 20 diskfree uname
1740: 72 75 6e 2d 64 69 72 20 6c 6f 67 2d 66 69 6c 65 run-dir log-file
1750: 20 72 75 6e 2d 64 75 72 61 74 69 6f 6e 20 63 6f run-duration co
1760: 6d 6d 65 6e 74 20 65 76 65 6e 74 2d 74 69 6d 65 mment event-time
1770: 20 61 72 63 68 69 76 65 64 29 0a 20 20 28 64 62 archived). (db
1780: 69 3a 65 78 65 63 0a 20 20 20 64 62 68 0a 20 20 i:exec. dbh.
1790: 20 22 55 50 44 41 54 45 20 74 65 73 74 73 20 53 "UPDATE tests S
17a0: 45 54 0a 20 20 20 20 20 20 72 75 6e 5f 69 64 3d ET. run_id=
17b0: 3f 2c 74 65 73 74 5f 6e 61 6d 65 3d 3f 2c 69 74 ?,test_name=?,it
17c0: 65 6d 5f 70 61 74 68 3d 3f 2c 73 74 61 74 65 3d em_path=?,state=
17d0: 3f 2c 73 74 61 74 75 73 3d 3f 2c 68 6f 73 74 3d ?,status=?,host=
17e0: 3f 2c 63 70 75 6c 6f 61 64 3d 3f 2c 64 69 73 6b ?,cpuload=?,disk
17f0: 66 72 65 65 3d 3f 2c 75 6e 61 6d 65 3d 3f 2c 72 free=?,uname=?,r
1800: 75 6e 64 69 72 3d 3f 2c 66 69 6e 61 6c 5f 6c 6f undir=?,final_lo
1810: 67 66 3d 3f 2c 72 75 6e 5f 64 75 72 61 74 69 6f gf=?,run_duratio
1820: 6e 3d 3f 2c 63 6f 6d 6d 65 6e 74 3d 3f 2c 65 76 n=?,comment=?,ev
1830: 65 6e 74 5f 74 69 6d 65 3d 3f 2c 61 72 63 68 69 ent_time=?,archi
1840: 76 65 64 3d 3f 0a 20 20 20 20 57 48 45 52 45 20 ved=?. WHERE
1850: 69 64 3d 3f 3b 22 0a 0a 20 20 20 72 75 6e 2d 69 id=?;".. run-i
1860: 64 20 20 74 65 73 74 2d 6e 61 6d 65 20 69 74 65 d test-name ite
1870: 6d 2d 70 61 74 68 20 20 20 20 73 74 61 74 65 20 m-path state
1880: 20 20 73 74 61 74 75 73 20 20 20 20 20 68 6f 73 status hos
1890: 74 20 20 63 70 75 6c 6f 61 64 20 64 69 73 6b 66 t cpuload diskf
18a0: 72 65 65 20 75 6e 61 6d 65 0a 20 20 20 72 75 6e ree uname. run
18b0: 2d 64 69 72 20 6c 6f 67 2d 66 69 6c 65 20 20 72 -dir log-file r
18c0: 75 6e 2d 64 75 72 61 74 69 6f 6e 20 63 6f 6d 6d un-duration comm
18d0: 65 6e 74 20 65 76 65 6e 74 2d 74 69 6d 65 20 61 ent event-time a
18e0: 72 63 68 69 76 65 64 20 74 65 73 74 2d 69 64 29 rchived test-id)
18f0: 29 0a ).