Megatest

Diff
Login

Differences From Artifact [351701514f]:

To Artifact [8c09a0af38]:


1053
1054
1055
1056
1057
1058
1059

1060




1061
1062
1063
1064
1065
1066
1067
1053
1054
1055
1056
1057
1058
1059
1060

1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071







+
-
+
+
+
+







	(all-stmts   '())              ;; ( ( stmt1 value1 ) ( stml2 value2 ))
	(numrecs     (make-hash-table))
	(start-time  (current-milliseconds))
	(tot-count   0))

    (for-each ;; table
     (lambda (tabledat)
       (condition-case
       (db:sync-one-table fromdb todb tabledat last-update numrecs))
	   (db:sync-one-table fromdb todb tabledat last-update numrecs)
	 ;; if db is busy, take a break and try one more time
	 (exn (busy)(thread-sleep! 0.5)
	      (db:sync-one-table fromdb todb tabledat last-update numrecs))))
     tbls)

    (let* ((runtime      (- (current-milliseconds) start-time))
	   (should-print (or (debug:debug-mode 12)
			     (common:low-noise-print 120 "db sync" (> runtime 500))))) ;; low and high sync times treated as separate.
      (if should-print (debug:print 3 *default-log-port* "INFO: db sync, total run time " runtime " ms"))
      (for-each 
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421




2422
2423
2424
2425



2426
2427
2428
2429
2430
2431
2432
2433
2416
2417
2418
2419
2420
2421
2422



2423
2424
2425
2426




2427
2428
2429

2430
2431
2432
2433
2434
2435
2436







-
-
-
+
+
+
+
-
-
-
-
+
+
+
-







;; look up values in a header/data structure
(define (db:get-value-by-header row header field)
  (if (or (null? header) (not row))
      #f
      (let loop ((hed (car header))
                 (tal (cdr header))
                 (n   0))
        (if (equal? hed field)
            (handle-exceptions
             exn
        (if (equal? hed field);;(condition-case (vector-ref #(1 2 3) 3)(exn (bounds)(print "out of bounds")))
            (condition-case
		(vector-ref row n)
	      (exn (bounds)
             (begin
               (debug:print 0 *default-log-port* "WARNING: attempt to read non-existant field, row="
			    row " header=" header " field=" field ", exn=" exn)
               #f)
		   (debug:print 0 *default-log-port* "WARNING: attempt to read non-existant field, row="
				row " header=" header " field=" field ", exn=" exn)
		   #f))
             (vector-ref row n))
	    (if (null? tal) #f (loop (car tal)(cdr tal)(+ n 1)))))))

;; Accessors for the header/data structure
;; get rows and header from 
(define (db:get-header vec)(vector-ref vec 0))
(define (db:get-rows   vec)(vector-ref vec 1))

4845
4846
4847
4848
4849
4850
4851
4852

4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4848
4849
4850
4851
4852
4853
4854

4855



4856
4857
4858
4859
4860
4861
4862







-
+
-
-
-







			    (begin
                              (handle-exceptions
                               exn
                               (begin
                                  (debug:print 0 *default-log-port*
                                  "WARNING: itemmap has problem \"" itemmap "\", patt: " patt ", repl: " repl ", exn=" exn)
                                 res)
                              (string-substitute patt repl res))
                              (string-substitute patt repl res)))


                              )
			    (begin
                              (debug:print 0 *default-log-port*
                               "WARNING: itemmap has problem \"" itemmap "\", patt: " patt ", repl: " repl)
			      res))))
	    (if (null? tal)
		newr
		(loop (car tal)(cdr tal) newr)))))))