Artifact
34ae67e2824ab38de2f9f756d24e16267c1a31d2:
0000: 28 6d 6f 64 75 6c 65 20 6d 74 2d 6e 65 77 2d 74 (module mt-new-t
0010: 6f 2d 6f 6c 64 0a 20 2a 0a 0a 28 69 6d 70 6f 72 o-old. *..(impor
0020: 74 0a 20 73 63 68 65 6d 65 0a 20 63 68 69 63 6b t. scheme. chick
0030: 65 6e 2e 66 69 6c 65 0a 20 63 68 69 63 6b 65 6e en.file. chicken
0040: 2e 62 61 73 65 0a 20 63 68 69 63 6b 65 6e 2e 73 .base. chicken.s
0050: 74 72 69 6e 67 0a 20 63 68 69 63 6b 65 6e 2e 70 tring. chicken.p
0060: 72 65 74 74 79 2d 70 72 69 6e 74 0a 20 73 71 6c retty-print. sql
0070: 69 74 65 33 29 0a 0a 28 69 66 20 28 6e 6f 74 20 ite3)..(if (not
0080: 28 66 69 6c 65 2d 65 78 69 73 74 73 3f 20 22 2e (file-exists? ".
0090: 6d 65 67 61 74 65 73 74 2f 6d 61 69 6e 2e 64 62 megatest/main.db
00a0: 22 29 29 0a 20 20 20 20 28 62 65 67 69 6e 0a 20 ")). (begin.
00b0: 20 20 20 20 28 70 72 69 6e 74 20 22 4e 6f 20 2e (print "No .
00c0: 6d 65 67 61 74 65 73 74 2f 6d 61 69 6e 2e 64 62 megatest/main.db
00d0: 20 66 6f 75 6e 64 2c 20 65 78 69 74 69 6e 67 22 found, exiting"
00e0: 29 0a 20 20 20 20 20 28 65 78 69 74 20 31 29 29 ). (exit 1))
00f0: 29 0a 0a 28 63 6f 70 79 2d 66 69 6c 65 20 22 2e )..(copy-file ".
0100: 6d 65 67 61 74 65 73 74 2f 6d 61 69 6e 2e 64 62 megatest/main.db
0110: 22 20 22 6d 65 67 61 74 65 73 74 2e 64 62 22 20 " "megatest.db"
0120: 23 74 29 0a 0a 0a 28 64 65 66 69 6e 65 20 74 65 #t)...(define te
0130: 73 74 73 5f 66 69 65 6c 64 73 20 22 72 75 6e 5f sts_fields "run_
0140: 69 64 2c 74 65 73 74 6e 61 6d 65 2c 68 6f 73 74 id,testname,host
0150: 2c 63 70 75 6c 6f 61 64 2c 64 69 73 6b 66 72 65 ,cpuload,diskfre
0160: 65 2c 75 6e 61 6d 65 2c 72 75 6e 64 69 72 2c 73 e,uname,rundir,s
0170: 68 6f 72 74 64 69 72 2c 69 74 65 6d 5f 70 61 74 hortdir,item_pat
0180: 68 2c 73 74 61 74 65 2c 73 74 61 74 75 73 2c 61 h,state,status,a
0190: 74 74 65 6d 70 74 6e 75 6d 2c 66 69 6e 61 6c 5f ttemptnum,final_
01a0: 6c 6f 67 66 2c 6c 6f 67 64 61 74 2c 72 75 6e 5f logf,logdat,run_
01b0: 64 75 72 61 74 69 6f 6e 2c 63 6f 6d 6d 65 6e 74 duration,comment
01c0: 2c 65 76 65 6e 74 5f 74 69 6d 65 2c 66 61 69 6c ,event_time,fail
01d0: 5f 63 6f 75 6e 74 2c 70 61 73 73 5f 63 6f 75 6e _count,pass_coun
01e0: 74 2c 61 72 63 68 69 76 65 64 22 29 0a 0a 28 64 t,archived")..(d
01f0: 65 66 69 6e 65 20 65 78 74 72 61 5f 66 69 65 6c efine extra_fiel
0200: 64 73 20 22 74 65 73 74 6e 61 6d 65 2c 69 74 65 ds "testname,ite
0210: 6d 5f 70 61 74 68 22 29 0a 0a 28 64 65 66 69 6e m_path")..(defin
0220: 65 20 28 69 6d 70 6f 72 74 2d 6f 6e 65 20 64 62 e (import-one db
0230: 66 69 6c 65 20 64 65 73 74 64 62 29 0a 20 20 28 file destdb). (
0240: 70 72 69 6e 74 20 22 49 6d 70 6f 72 74 69 6e 67 print "Importing
0250: 20 22 64 62 66 69 6c 65 29 0a 20 20 28 6c 65 74 "dbfile). (let
0260: 2a 20 28 28 64 62 20 20 20 28 6f 70 65 6e 2d 64 * ((db (open-d
0270: 61 74 61 62 61 73 65 20 64 62 66 69 6c 65 29 29 atabase dbfile))
0280: 0a 09 20 28 72 6f 77 73 20 28 66 6f 6c 64 2d 72 .. (rows (fold-r
0290: 6f 77 0a 09 09 28 6c 61 6d 62 64 61 20 28 72 65 ow...(lambda (re
02a0: 73 20 2e 20 72 6f 77 29 0a 09 09 20 20 28 63 6f s . row)... (co
02b0: 6e 73 20 72 6f 77 20 72 65 73 29 29 0a 09 09 27 ns row res))...'
02c0: 28 29 0a 09 09 64 62 0a 09 09 28 63 6f 6e 63 20 ()...db...(conc
02d0: 22 53 45 4c 45 43 54 20 22 65 78 74 72 61 5f 66 "SELECT "extra_f
02e0: 69 65 6c 64 73 22 2c 22 74 65 73 74 73 5f 66 69 ields","tests_fi
02f0: 65 6c 64 73 22 20 46 52 4f 4d 20 74 65 73 74 73 elds" FROM tests
0300: 3b 22 29 29 29 29 0a 20 20 20 20 28 66 69 6e 61 ;")))). (fina
0310: 6c 69 7a 65 21 20 64 62 29 0a 20 20 20 20 28 70 lize! db). (p
0320: 72 69 6e 74 20 22 46 6f 75 6e 64 20 22 28 6c 65 rint "Found "(le
0330: 6e 67 74 68 20 72 6f 77 73 29 22 20 72 65 63 6f ngth rows)" reco
0340: 72 64 73 20 74 6f 20 69 6e 73 65 72 74 2e 22 29 rds to insert.")
0350: 0a 20 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 20 . (for-each.
0360: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 72 6f 77 (lambda (row
0370: 29 0a 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 ). (let* (
0380: 28 74 65 73 74 6e 61 6d 65 20 28 63 61 72 20 72 (testname (car r
0390: 6f 77 29 29 0a 09 20 20 20 20 20 20 28 69 74 65 ow)).. (ite
03a0: 6d 70 61 74 68 20 28 63 61 64 72 20 72 6f 77 29 mpath (cadr row)
03b0: 29 0a 09 20 20 20 20 20 20 28 72 65 6d 72 6f 77 ).. (remrow
03c0: 20 20 20 28 63 64 64 72 20 72 6f 77 29 29 0a 09 (cddr row))..
03d0: 20 20 20 20 20 20 28 72 75 6e 2d 69 64 20 20 20 (run-id
03e0: 28 63 61 72 20 72 65 6d 72 6f 77 29 29 0a 09 20 (car remrow))..
03f0: 20 20 20 20 20 28 72 65 61 64 79 2d 72 6f 77 20 (ready-row
0400: 28 73 74 72 69 6e 67 2d 69 6e 74 65 72 73 70 65 (string-interspe
0410: 72 73 65 0a 09 09 09 20 20 28 6d 61 70 20 28 6c rse.... (map (l
0420: 61 6d 62 64 61 20 28 78 29 0a 09 09 09 09 20 28 ambda (x)..... (
0430: 69 66 20 28 6e 75 6d 62 65 72 3f 20 78 29 0a 09 if (number? x)..
0440: 09 09 09 20 20 20 20 20 28 63 6f 6e 63 20 78 29 ... (conc x)
0450: 0a 09 09 09 09 20 20 20 20 20 28 63 6f 6e 63 20 ..... (conc
0460: 22 27 22 78 22 27 22 29 29 29 0a 09 09 09 20 20 "'"x"'")))....
0470: 20 20 20 20 20 72 65 6d 72 6f 77 29 0a 0a 09 09 remrow)....
0480: 09 20 20 22 2c 22 29 29 29 0a 09 20 28 70 72 69 . ","))).. (pri
0490: 6e 74 20 72 75 6e 2d 69 64 22 2c 22 74 65 73 74 nt run-id","test
04a0: 6e 61 6d 65 22 2f 22 69 74 65 6d 70 61 74 68 29 name"/"itempath)
04b0: 0a 09 20 28 65 78 65 63 75 74 65 20 64 65 73 74 .. (execute dest
04c0: 64 62 20 22 44 45 4c 45 54 45 20 46 52 4f 4d 20 db "DELETE FROM
04d0: 74 65 73 74 73 20 57 48 45 52 45 20 74 65 73 74 tests WHERE test
04e0: 6e 61 6d 65 3d 3f 20 41 4e 44 20 69 74 65 6d 5f name=? AND item_
04f0: 70 61 74 68 3d 3f 20 41 4e 44 20 72 75 6e 5f 69 path=? AND run_i
0500: 64 3d 3f 3b 22 0a 09 09 20 20 28 6f 72 20 74 65 d=?;"... (or te
0510: 73 74 6e 61 6d 65 20 22 22 29 0a 09 09 20 20 28 stname "")... (
0520: 6f 72 20 69 74 65 6d 70 61 74 68 20 22 22 29 0a or itempath "").
0530: 09 09 20 20 28 6f 72 20 72 75 6e 2d 69 64 20 22 .. (or run-id "
0540: 22 29 29 0a 09 20 28 61 70 70 6c 79 20 65 78 65 ")).. (apply exe
0550: 63 75 74 65 20 64 65 73 74 64 62 20 28 63 6f 6e cute destdb (con
0560: 63 20 22 49 4e 53 45 52 54 20 49 4e 54 4f 20 74 c "INSERT INTO t
0570: 65 73 74 73 20 28 22 74 65 73 74 73 5f 66 69 65 ests ("tests_fie
0580: 6c 64 73 22 29 20 56 41 4c 55 45 53 20 28 3f 2c lds") VALUES (?,
0590: 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c ?,?,?,?,?,?,?,?,
05a0: 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c 3f 2c ?,?,?,?,?,?,?,?,
05b0: 3f 2c 3f 2c 3f 29 3b 22 29 20 72 65 6d 72 6f 77 ?,?,?);") remrow
05c0: 29 29 29 0a 20 20 20 20 20 3b 3b 20 28 22 72 65 ))). ;; ("re
05d0: 61 64 79 2d 72 6f 77 22 29 3b 22 29 29 29 29 0a ady-row");")))).
05e0: 20 20 20 20 20 72 6f 77 73 29 29 29 0a 0a 28 64 rows)))..(d
05f0: 65 66 69 6e 65 20 28 70 72 6f 63 65 73 73 2d 61 efine (process-a
0600: 6c 6c 29 0a 20 20 28 6c 65 74 2a 20 28 28 6f 75 ll). (let* ((ou
0610: 74 64 62 20 28 6f 70 65 6e 2d 64 61 74 61 62 61 tdb (open-databa
0620: 73 65 20 22 6d 65 67 61 74 65 73 74 2e 64 62 22 se "megatest.db"
0630: 29 29 0a 09 20 28 69 6e 64 62 73 20 28 67 6c 6f )).. (indbs (glo
0640: 62 20 22 2e 6d 65 67 61 74 65 73 74 2f 5b 30 2d b ".megatest/[0-
0650: 39 5d 2a 2e 64 62 22 29 29 29 0a 20 20 20 20 28 9]*.db"))). (
0660: 77 69 74 68 2d 74 72 61 6e 73 61 63 74 69 6f 6e with-transaction
0670: 0a 20 20 20 20 20 6f 75 74 64 62 0a 20 20 20 20 . outdb.
0680: 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 (lambda ().
0690: 20 20 20 28 66 6f 72 2d 65 61 63 68 0a 09 28 6c (for-each..(l
06a0: 61 6d 62 64 61 20 28 64 62 66 6e 61 6d 65 29 0a ambda (dbfname).
06b0: 09 20 20 28 69 6d 70 6f 72 74 2d 6f 6e 65 20 64 . (import-one d
06c0: 62 66 6e 61 6d 65 20 6f 75 74 64 62 29 29 0a 09 bfname outdb))..
06d0: 69 6e 64 62 73 29 29 29 0a 20 20 20 20 28 66 69 indbs))). (fi
06e0: 6e 61 6c 69 7a 65 21 20 6f 75 74 64 62 29 29 29 nalize! outdb)))
06f0: 0a 0a 29 0a 0a 28 69 6d 70 6f 72 74 20 6d 74 2d ..)..(import mt-
0700: 6e 65 77 2d 74 6f 2d 6f 6c 64 29 0a 28 70 72 6f new-to-old).(pro
0710: 63 65 73 73 2d 61 6c 6c 29 0a cess-all).