Megatest

Diff
Login

Differences From Artifact [2aad81d989]:

To Artifact [b18980d578]:


419
420
421
422
423
424
425
426
427
428
429
430

431

432
433
434
435
436
437
438
439
440
(define (db:sync-inmem->disk dbstruct apath dbfile #!key (force-sync #f))
  (let* ((dbdat       (db:get-dbdat dbstruct apath dbfile))
	 (db          (dbr:dbdat-db dbdat))
	 (inmem       (dbr:dbdat-inmem dbdat))
	 (start-t     (current-seconds))
	 (last-update (dbr:dbdat-last-write dbdat))
	 (last-sync   (dbr:dbdat-last-sync dbdat)))
    (debug:print-info 0 *default-log-port* "Syncing for dbfile: " dbfile)
    (mutex-lock! *db-multi-sync-mutex*)
    (let* ((update_info (cons (if force-sync 0 last-update) "last_update"))
    	   (need-sync   (or force-sync (>= last-update last-sync))))
       (if need-sync

	  (db:sync-tables (db:sync-all-tables-list) update_info inmem db)

	  (debug:print 0 *default-log-port* "Skipping sync as nothing touched.")))
    (dbr:dbdat-last-sync-set! dbdat start-t)
    (mutex-unlock! *db-multi-sync-mutex*)))

;; TODO: Add final sync to this
;;
(define (db:safely-close-sqlite3-db db stmt-cache #!key (try-num 3))
  (if (<= try-num 0)
      #f







|




>
|
>

<







419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434

435
436
437
438
439
440
441
(define (db:sync-inmem->disk dbstruct apath dbfile #!key (force-sync #f))
  (let* ((dbdat       (db:get-dbdat dbstruct apath dbfile))
	 (db          (dbr:dbdat-db dbdat))
	 (inmem       (dbr:dbdat-inmem dbdat))
	 (start-t     (current-seconds))
	 (last-update (dbr:dbdat-last-write dbdat))
	 (last-sync   (dbr:dbdat-last-sync dbdat)))
    (debug:print-info 0 *default-log-port* "Syncing for dbfile: "dbfile", last-update: "last-update", last-sync: "last-sync)
    (mutex-lock! *db-multi-sync-mutex*)
    (let* ((update_info (cons (if force-sync 0 last-update) "last_update"))
    	   (need-sync   (or force-sync (>= last-update last-sync))))
       (if need-sync
	   (begin
	     (db:sync-tables (db:sync-all-tables-list) update_info inmem db)
	     (dbr:dbdat-last-sync-set! dbdat start-t))
	  (debug:print 0 *default-log-port* "Skipping sync as nothing touched.")))

    (mutex-unlock! *db-multi-sync-mutex*)))

;; TODO: Add final sync to this
;;
(define (db:safely-close-sqlite3-db db stmt-cache #!key (try-num 3))
  (if (<= try-num 0)
      #f
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
      (if should-print (debug:print 3 *default-log-port* "INFO: db sync, total run time " runtime " ms"))
      (for-each 
       (lambda (dat)
	 (let ((tblname (car dat))
	       (count   (cdr dat)))
	   (set! tot-count (+ tot-count count))
	   (if (> count 0)
	       (if should-print (debug:print 0 *default-log-port* (format #f "    ~10a ~5a" tblname count))))))
       (sort (hash-table->alist numrecs)(lambda (a b)(> (cdr a)(cdr b))))))
    tot-count))

(define (db:patch-schema-rundb frundb)
  ;;
  ;; remove this some time after September 2016 (added in version v1.6031
  ;;







|







797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
      (if should-print (debug:print 3 *default-log-port* "INFO: db sync, total run time " runtime " ms"))
      (for-each 
       (lambda (dat)
	 (let ((tblname (car dat))
	       (count   (cdr dat)))
	   (set! tot-count (+ tot-count count))
	   (if (> count 0)
	       (if should-print (debug:print 0 *default-log-port* "   "tblname" "count))))) ;; (format #f "    ~10a ~5a" tblname count))))))
       (sort (hash-table->alist numrecs)(lambda (a b)(> (cdr a)(cdr b))))))
    tot-count))

(define (db:patch-schema-rundb frundb)
  ;;
  ;; remove this some time after September 2016 (added in version v1.6031
  ;;
5534
5535
5536
5537
5538
5539
5540




















5541
5542
5543
5544
5545
5546
5547
	      (begin
		(debug:print-info 0 *default-log-port* "Server already running at "sinfo ", while trying to register server " host":"port)
		#f) ;; server already registered
	      (begin
		(sqlite3:execute db "INSERT INTO servers (host,port,servkey,pid,ipaddr,apath,dbname) VALUES (?,?,?,?,?,?,?);"
				 host port servkey pid ipaddr apath dbname)
		(db:get-server-info dbstruct apath dbname)))))))))




















  
(define (db:get-server-info dbstruct apath dbname)
  (db:with-db
   dbstruct
   #f #f
   (lambda (db)
     (sqlite3:fold-row







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







5535
5536
5537
5538
5539
5540
5541
5542
5543
5544
5545
5546
5547
5548
5549
5550
5551
5552
5553
5554
5555
5556
5557
5558
5559
5560
5561
5562
5563
5564
5565
5566
5567
5568
	      (begin
		(debug:print-info 0 *default-log-port* "Server already running at "sinfo ", while trying to register server " host":"port)
		#f) ;; server already registered
	      (begin
		(sqlite3:execute db "INSERT INTO servers (host,port,servkey,pid,ipaddr,apath,dbname) VALUES (?,?,?,?,?,?,?);"
				 host port servkey pid ipaddr apath dbname)
		(db:get-server-info dbstruct apath dbname)))))))))
  
;; run this one in a transaction where first check if host:port is taken
(define (db:deregister-server dbstruct host port servkey pid ipaddr apath dbname)
  (db:with-db
   dbstruct
   #f #f
   (lambda (db)
     (sqlite3:with-transaction
      db
      (lambda ()
	(let* ((sinfo      (db:get-server-info dbstruct apath dbname)))
	  (if (not sinfo)
	      (begin
		(debug:print-info 0 *default-log-port* "Server already removed for "apath", "dbname) ;; at "sinfo ", while trying to register server " host":"port)
		#f) ;; server already deregistered
	      (begin
		(sqlite3:execute db "DELETE FROM servers WHERE apath=? AND dbname=?;" ;; (host,port,servkey,pid,ipaddr,apath,dbname) VALUES (?,?,?,?,?,?,?);"
				 ;; host port servkey pid ipaddr
				 apath dbname)
		#;(db:get-server-info dbstruct apath dbname)))))))))
  
(define (db:get-server-info dbstruct apath dbname)
  (db:with-db
   dbstruct
   #f #f
   (lambda (db)
     (sqlite3:fold-row