Megatest

Check-in [1d18479410]
Login
Overview
Comment:Added incremental save when using refdb edit
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.55
Files: files | file ages | folders
SHA1: 1d184794100e964503d17d83be216c3e5cf4ffee
User & Date: matt on 2014-05-01 22:38:45
Other Links: branch diff | manifest | tags
Context
2014-05-01
23:00
Added ability to have row keys containing spaces in refdb check-in: 14e26aaf81 user: matt tags: v1.55
22:38
Added incremental save when using refdb edit check-in: 1d18479410 user: matt tags: v1.55
2014-04-24
17:39
Fixed silly bug in -list-db-targets check-in: b71a9aadc7 user: mrwellan tags: v1.55
Changes

Modified txtdb/txtdb.scm from [cf8a5ae239] to [8d9f4328c7].

13
14
15
16
17
18
19

20
21
22
23
24
25
26
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27







+







(use sxml-modifications)
(use regex)
(use srfi-69)
(use regex-case)
(use posix)
(use json)
(use csv)
(use srfi-18)

(include "../megatest-fossil-hash.scm")

;; Read a non-compressed gnumeric file
(define (refdb:read-gnumeric-xml fname)
  (with-input-from-file fname
    (lambda ()
452
453
454
455
456
457
458
459
460
461



















462
463
464
465
466
467
468
453
454
455
456
457
458
459



460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485







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







	(print)
	(print "Don't forget to remove the old files from your revision control system and add the new.")
	(exit)))
  (let* ((dbname  (pathname-strip-directory path))
	 (tmpf    (conc (create-temporary-file dbname) ".gnumeric")))
    (if (file-exists? (conc path "/sheet-names.cfg"))
	(refdb-export path tmpf))
    (let ((pid (process-run "gnumeric" (list tmpf))))
      (process-wait pid)
      (import-gnumeric-file tmpf path))))
    (let* ((pid (process-run "gnumeric" (list tmpf))))
      (let loop ((last-mod-time (current-seconds)))
	(let-values (((pid-code exit-status exit-signal)(process-wait pid #t)))
           (if (eq? pid-code 0) ;; still going
	       (if (file-exists? tmpf)
		   (let ((mod-time (file-modification-time tmpf)))
		     (if (> mod-time last-mod-time)
			 (begin
			   (print "saved data to " path)
			   (import-gnumeric-file tmpf path)))
		     (thread-sleep! 0.5)
		     (loop mod-time))
		   (begin
		     (thread-sleep! 0.5)
		     (loop last-mod-time))))))
      ;; all done
      (print "all done, writing new data to " path)
      (import-gnumeric-file tmpf path)
      (print "data written, exiting refdb edit."))))

;;======================================================================
;; This routine dispaches or executes most of the commands for refdb
;;======================================================================
;;
(define (process-action action-str . param)
  (let ((num-params (length param))