Commit ff0ecb6a authored by Dave Griffiths's avatar Dave Griffiths
Browse files

sync hang problem fixed

parent 91a86831
...@@ -432,6 +432,7 @@ ...@@ -432,6 +432,7 @@
"new-entities-req" "new-entities-req"
(string-append url "fn=entity-versions&table=" table) (string-append url "fn=entity-versions&table=" table)
(lambda (data) (lambda (data)
(alog "suck-new: building entity requests")
(let ((new-entity-requests (build-entity-requests db table data))) (let ((new-entity-requests (build-entity-requests db table data)))
(alog "suck-new: marking dirty") (alog "suck-new: marking dirty")
;; now doing this first!... ;; now doing this first!...
...@@ -475,8 +476,10 @@ ...@@ -475,8 +476,10 @@
;; todo - this is really slow and we're doing it all the time ;; todo - this is really slow and we're doing it all the time
;; if there are loads to do it's bad ;; if there are loads to do it's bad
(alog "unlist check start")
(msg "checking for unlisted") (msg "checking for unlisted")
(mark-unlisted-entities-dirty! db "sync" data) (mark-unlisted-entities-dirty! db "sync" data)
(alog "unlist check end")
(let ((r (append (let ((r (append
(spit db "sync" (dirty-entities db "sync")) (spit db "sync" (dirty-entities db "sync"))
......
...@@ -65,11 +65,13 @@ ...@@ -65,11 +65,13 @@
((zero? n) '()) ((zero? n) '())
(else (cons (car l) (crop (cdr l) (- n 1)))))) (else (cons (car l) (crop (cdr l) (- n 1))))))
(define (in-list? n l) ;(define (in-list? n l)
(cond ; (cond
((null? l) #f) ; ((null? l) #f)
((equal? n (car l)) #t) ; ((equal? n (car l)) #t)
(else (in-list? n (cdr l))))) ; (else (in-list? n (cdr l)))))
(define in-list? string-in-list-fast) ;; optimisation
(define (find n l) (define (find n l)
(cond (cond
......
...@@ -511,15 +511,12 @@ ...@@ -511,15 +511,12 @@
;; replace entity with names -> uids, or name of not found ;; replace entity with names -> uids, or name of not found
(define (review-validate-contents uid entity) (define (review-validate-contents uid entity)
(msg "validate....")
(foldl (foldl
(lambda (ktv r) (lambda (ktv r)
(msg ktv) (msg ktv)
(cond (cond
((string? r) r) ;; we have already found an error ((string? r) r) ;; we have already found an error
((ktv-key-is-id? ktv) ((ktv-key-is-id? ktv)
(msg "it's an id...")
(msg "is list=" (ktv-value-is-list? ktv))
(let ((replacement (let ((replacement
(if (ktv-value-is-list? ktv) (if (ktv-value-is-list? ktv)
(convert-id-list db (ktv-value ktv)) (convert-id-list db (ktv-value ktv))
...@@ -688,6 +685,7 @@ ...@@ -688,6 +685,7 @@
(get-current 'debug-text ""))) (get-current 'debug-text "")))
(define (debug-timer-cb) (define (debug-timer-cb)
(alog "debug timer callback...")
(append (append
(cond (cond
((get-current 'sync-on #f) ((get-current 'sync-on #f)
...@@ -708,7 +706,8 @@ ...@@ -708,7 +706,8 @@
(else '())) (else '()))
(list (list
(delayed "debug-timer" (+ 10000 (random 5000)) debug-timer-cb) (delayed "debug-timer" (+ 10000 (random 5000)) debug-timer-cb)
(update-debug)))) (update-debug)
)))
(define pf-length 20) ;; minutes... (define pf-length 20) ;; minutes...
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment