Megatest

Check-in [184bfa2327]
Login
Overview
Comment:Renamed txtdb to refdb. Added to Makefile install target. Added ls
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dev
Files: files | file ages | folders
SHA1: 184bfa2327d215880e962f37820eab20d8ceebb4
User & Date: matt on 2013-07-14 23:56:00
Other Links: branch diff | manifest | tags
Context
2013-07-15
23:35
Added first pass on Makefile for install of chicken, iup etc. check-in: 5179d54733 user: matt tags: dev
12:30
Merged development into v1.55 for release as bump of v1.5508 check-in: e6fef4b651 user: mrwellan tags: v1.55, v1.5508
2013-07-14
23:56
Renamed txtdb to refdb. Added to Makefile install target. Added ls check-in: 184bfa2327 user: matt tags: dev
23:28
Added lookup to txtdb check-in: cf4ae67410 user: matt tags: dev
Changes

Modified Makefile from [546faeb533] to [9930e702df].

19
20
21
22
23
24
25
26



27
28
29
30
31
32
33
HELPERS=$(addprefix $(PREFIX)/bin/,$(ADTLSCR))
DEPLOYHELPERS=$(addprefix deploytarg/,$(ADTLSCR))
MTESTHASH=$(shell fossil info|grep checkout:| awk '{print $$2}')

CSIPATH=$(shell which csi)
CKPATH=$(shell dirname $(shell dirname $(CSIPATH)))

all : mtest dboard newdboard




mtest: $(OFILES) megatest.o
	csc $(CSCOPTS) $(OFILES) megatest.o -o mtest

dboard : $(OFILES) $(GOFILES) dashboard.scm
	csc $(OFILES) dashboard.scm $(GOFILES) -o dboard








|
>
>
>







19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
HELPERS=$(addprefix $(PREFIX)/bin/,$(ADTLSCR))
DEPLOYHELPERS=$(addprefix deploytarg/,$(ADTLSCR))
MTESTHASH=$(shell fossil info|grep checkout:| awk '{print $$2}')

CSIPATH=$(shell which csi)
CKPATH=$(shell dirname $(shell dirname $(CSIPATH)))

all : mtest dboard newdboard txtdb

refdb : txtdb/txtdb.scm
	csc txtdb/txtdb.scm -o refdb

mtest: $(OFILES) megatest.o
	csc $(CSCOPTS) $(OFILES) megatest.o -o mtest

dboard : $(OFILES) $(GOFILES) dashboard.scm
	csc $(OFILES) dashboard.scm $(GOFILES) -o dboard

92
93
94
95
96
97
98




99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
$(PREFIX)/bin/nbfake : utils/nbfake
	$(INSTALL) $< $@
	chmod a+x $@

$(PREFIX)/bin/nbfind : utils/nbfind
	$(INSTALL) $< $@
	chmod a+x $@





deploytarg/nbfake : utils/nbfake
	$(INSTALL) $< $@
	chmod a+x $@

deploytarg/nbfind : utils/nbfind
	$(INSTALL) $< $@
	chmod a+x $@


# install dashboard as dboard so wrapper script can be called dashboard
$(PREFIX)/bin/dboard : dboard $(FILES)
	$(INSTALL) dboard $(PREFIX)/bin/dboard
	utils/mk_wrapper $(PREFIX) dboard > $(PREFIX)/bin/dashboard
	chmod a+x $(PREFIX)/bin/dashboard

install : bin $(PREFIX)/bin/mtest $(PREFIX)/bin/megatest $(PREFIX)/bin/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake $(PREFIX)/bin/nbfind $(PREFIX)/bin/newdboard

deploytarg/apropos.so : Makefile
	for i in apropos base64 canvas-draw csv-xml directory-utils dot-locking extras fmt format hostinfo http-client intarweb json md5 message-digest posix posix-extras readline regex regex-case s11n spiffy spiffy-request-vars sqlite3 srfi-1 srfi-18 srfi-69 tcp test uri-common check-errors synch matchable sql-null tcp-server rpc blob-utils string-utils variable-item defstruct uri-generic sendfile opensll openssl lookup-table list-utils stack; do \
	chicken-install -prefix deploytarg -deploy $$i;done

deploytarg/libsqlite3.so : 
	CSC_OPTIONS="-Ideploytarg -Ldeploytarg" $CHICKEN_INSTALL -prefix deploytarg -deploy sqlite3







>
>
>
>
















|







95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
$(PREFIX)/bin/nbfake : utils/nbfake
	$(INSTALL) $< $@
	chmod a+x $@

$(PREFIX)/bin/nbfind : utils/nbfind
	$(INSTALL) $< $@
	chmod a+x $@

$(PREFIX)/bin/refdb : refdb
	$(INSTALL) $< $@
	chmod a+x $@

deploytarg/nbfake : utils/nbfake
	$(INSTALL) $< $@
	chmod a+x $@

deploytarg/nbfind : utils/nbfind
	$(INSTALL) $< $@
	chmod a+x $@


# install dashboard as dboard so wrapper script can be called dashboard
$(PREFIX)/bin/dboard : dboard $(FILES)
	$(INSTALL) dboard $(PREFIX)/bin/dboard
	utils/mk_wrapper $(PREFIX) dboard > $(PREFIX)/bin/dashboard
	chmod a+x $(PREFIX)/bin/dashboard

install : bin $(PREFIX)/bin/mtest $(PREFIX)/bin/megatest $(PREFIX)/bin/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake $(PREFIX)/bin/nbfind $(PREFIX)/bin/newdboard $(PREFIX)/bin/refdb

deploytarg/apropos.so : Makefile
	for i in apropos base64 canvas-draw csv-xml directory-utils dot-locking extras fmt format hostinfo http-client intarweb json md5 message-digest posix posix-extras readline regex regex-case s11n spiffy spiffy-request-vars sqlite3 srfi-1 srfi-18 srfi-69 tcp test uri-common check-errors synch matchable sql-null tcp-server rpc blob-utils string-utils variable-item defstruct uri-generic sendfile opensll openssl lookup-table list-utils stack; do \
	chicken-install -prefix deploytarg -deploy $$i;done

deploytarg/libsqlite3.so : 
	CSC_OPTIONS="-Ideploytarg -Ldeploytarg" $CHICKEN_INSTALL -prefix deploytarg -deploy sqlite3

Modified txtdb/txtdb.scm from [f716bafc90] to [b66f9a3d66].

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)

;; Read a non-compressed gnumeric file
(define (txtdb:read-gnumeric-xml fname)
  (with-input-from-file fname
    (lambda ()
      (ssax:xml->sxml (current-input-port) '()))))

(define (find-section dat section #!key (depth 0))
  (let loop ((hed   (car dat))
	     (tal   (cdr dat)))   







|







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)

;; Read a non-compressed gnumeric file
(define (refdb:read-gnumeric-xml fname)
  (with-input-from-file fname
    (lambda ()
      (ssax:xml->sxml (current-input-port) '()))))

(define (find-section dat section #!key (depth 0))
  (let loop ((hed   (car dat))
	     (tal   (cdr dat)))   
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
		     (car section)
		     #f))
	       dat)))

(define (string->safe-filename str)
  (string-substitute (regexp " ") "_" str #t))

(define (sheet->txtdb dat targdir)
  (let* ((sheet-name  (car (find-section dat 'http://www.gnumeric.org/v10.dtd:Name)))
	 ;; (safe-name   (string->safe-filename sheet-name))
	 (cells       (find-section dat 'http://www.gnumeric.org/v10.dtd:Cells))
	 (remaining   (remove-section (remove-section dat 'http://www.gnumeric.org/v10.dtd:Name)
				      'http://www.gnumeric.org/v10.dtd:Cells))
	 (rownums     (make-hash-table))  ;; num -> name
	 (colnums     (make-hash-table))  ;; num -> name







|







61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
		     (car section)
		     #f))
	       dat)))

(define (string->safe-filename str)
  (string-substitute (regexp " ") "_" str #t))

(define (sheet->refdb dat targdir)
  (let* ((sheet-name  (car (find-section dat 'http://www.gnumeric.org/v10.dtd:Name)))
	 ;; (safe-name   (string->safe-filename sheet-name))
	 (cells       (find-section dat 'http://www.gnumeric.org/v10.dtd:Cells))
	 (remaining   (remove-section (remove-section dat 'http://www.gnumeric.org/v10.dtd:Name)
				      'http://www.gnumeric.org/v10.dtd:Cells))
	 (rownums     (make-hash-table))  ;; num -> name
	 (colnums     (make-hash-table))  ;; num -> name
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
  (let ((res (read-file fname read)))
    (if (null? res)
	(begin
	  (print "ERROR: file " fname " is malformed for read")
	  #f)
	(car res))))

;; Write an sxml gnumeric workbook to a txtdb directory structure.
;;
(define (extract-txtdb dat targdir)
  (create-directory (conc targdir "/sxml") #t)
  (let* ((wrkbk       (find-section   dat   'http://www.gnumeric.org/v10.dtd:Workbook))
	 (wrk-rem     (remove-section dat   'http://www.gnumeric.org/v10.dtd:Workbook))
	 (sheets      (find-section   wrkbk 'http://www.gnumeric.org/v10.dtd:Sheets))
	 (sht-rem     (remove-section wrkbk 'http://www.gnumeric.org/v10.dtd:Sheets))
	 (sheet-names (map (lambda (sheet)
			     (sheet->txtdb sheet targdir))
			   sheets)))
    (sxml->file wrk-rem (conc targdir "/sxml/workbook.sxml"))
    (sxml->file sht-rem (conc targdir "/sxml/sheets.sxml"))
    (with-output-to-file (conc targdir "/sheet-names.cfg")
      (lambda ()
	(map print sheet-names)))))

(define (read-gnumeric-file fname)
  (if (not (string-match (regexp ".*.gnumeric$") fname))
      (begin
	(print "ERROR: Attempt to import gnumeric file with extention other than .gnumeric")
	(exit))
      (let ((tmpf (create-temporary-file (pathname-strip-directory fname))))
	(system (conc " gunzip > " tmpf " < " fname))
	(let ((res (txtdb:read-gnumeric-xml tmpf)))
	  (delete-file tmpf)
	  res))))

(define (import-gnumeric-file fname targdir)
  (extract-txtdb (read-gnumeric-file fname) targdir))

;; Write a gnumeric compressed xml spreadsheet from a txtdb directory structure.
;;
(define (txtdb-export dbdir fname)
  (let* ((sxml-dat (txtdb->sxml dbdir))
	 (tmpf     (create-temporary-file (pathname-strip-directory fname)))
	 (tmpgzf   (conc tmpf ".gz")))
    (with-output-to-file tmpf
      (lambda ()
	(print (sxml-serializer#serialize-sxml sxml-dat ns-prefixes: (list (cons 'gnm "http://www.gnumeric.org/v10.dtd"))))))
    (system (conc "gzip " tmpf))
    (file-copy tmpgzf fname #t)







|

|






|














|




|

|

|
|







131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
  (let ((res (read-file fname read)))
    (if (null? res)
	(begin
	  (print "ERROR: file " fname " is malformed for read")
	  #f)
	(car res))))

;; Write an sxml gnumeric workbook to a refdb directory structure.
;;
(define (extract-refdb dat targdir)
  (create-directory (conc targdir "/sxml") #t)
  (let* ((wrkbk       (find-section   dat   'http://www.gnumeric.org/v10.dtd:Workbook))
	 (wrk-rem     (remove-section dat   'http://www.gnumeric.org/v10.dtd:Workbook))
	 (sheets      (find-section   wrkbk 'http://www.gnumeric.org/v10.dtd:Sheets))
	 (sht-rem     (remove-section wrkbk 'http://www.gnumeric.org/v10.dtd:Sheets))
	 (sheet-names (map (lambda (sheet)
			     (sheet->refdb sheet targdir))
			   sheets)))
    (sxml->file wrk-rem (conc targdir "/sxml/workbook.sxml"))
    (sxml->file sht-rem (conc targdir "/sxml/sheets.sxml"))
    (with-output-to-file (conc targdir "/sheet-names.cfg")
      (lambda ()
	(map print sheet-names)))))

(define (read-gnumeric-file fname)
  (if (not (string-match (regexp ".*.gnumeric$") fname))
      (begin
	(print "ERROR: Attempt to import gnumeric file with extention other than .gnumeric")
	(exit))
      (let ((tmpf (create-temporary-file (pathname-strip-directory fname))))
	(system (conc " gunzip > " tmpf " < " fname))
	(let ((res (refdb:read-gnumeric-xml tmpf)))
	  (delete-file tmpf)
	  res))))

(define (import-gnumeric-file fname targdir)
  (extract-refdb (read-gnumeric-file fname) targdir))

;; Write a gnumeric compressed xml spreadsheet from a refdb directory structure.
;;
(define (refdb-export dbdir fname)
  (let* ((sxml-dat (refdb->sxml dbdir))
	 (tmpf     (create-temporary-file (pathname-strip-directory fname)))
	 (tmpgzf   (conc tmpf ".gz")))
    (with-output-to-file tmpf
      (lambda ()
	(print (sxml-serializer#serialize-sxml sxml-dat ns-prefixes: (list (cons 'gnm "http://www.gnumeric.org/v10.dtd"))))))
    (system (conc "gzip " tmpf))
    (file-copy tmpgzf fname #t)
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
			      (value    (caddr item))
			      (val-type (get-value-type value exprs)))
			 (list 'http://www.gnumeric.org/v10.dtd:Cell
			       (list '@ val-type (list 'Row (conc row-num)) (list 'Col (conc col-num)))
			       value)))
		     (append rowdat coldat dat))))))
    
(define (txtdb->sxml dbdir)
  (let* ((sht-names (read-file (conc dbdir "/sheet-names.cfg")  read-line))
	 (wrk-rem   (file->sxml (conc dbdir "/sxml/workbook.sxml")))
	 (sht-rem   (file->sxml (conc dbdir "/sxml/sheets.sxml")))
	 (sheets    (fold (lambda (sheetname res)
			    (let* ((sheetdat (read-dat (conc dbdir "/" sheetname ".dat")))
				   (cells    (dat->cells sheetdat))
				   (sht-meta (file->sxml (conc dbdir "/sxml/" sheetname ".sxml"))))







|







241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
			      (value    (caddr item))
			      (val-type (get-value-type value exprs)))
			 (list 'http://www.gnumeric.org/v10.dtd:Cell
			       (list '@ val-type (list 'Row (conc row-num)) (list 'Col (conc col-num)))
			       value)))
		     (append rowdat coldat dat))))))
    
(define (refdb->sxml dbdir)
  (let* ((sht-names (read-file (conc dbdir "/sheet-names.cfg")  read-line))
	 (wrk-rem   (file->sxml (conc dbdir "/sxml/workbook.sxml")))
	 (sht-rem   (file->sxml (conc dbdir "/sxml/sheets.sxml")))
	 (sheets    (fold (lambda (sheetname res)
			    (let* ((sheetdat (read-dat (conc dbdir "/" sheetname ".dat")))
				   (cells    (dat->cells sheetdat))
				   (sht-meta (file->sxml (conc dbdir "/sxml/" sheetname ".sxml"))))
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317








318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350


351
352
353
354
355
356
357
		    (cdr tal)
		    new-rownames
		    new-colnames
		    (if (> curr-rownum rownum) curr-rownum rownum)
		    (if (> curr-colnum colnum) curr-colnum colnum)
		    ))))))
(define help
  (conc "Usage: txtdb action params ...

Note: txtdbdir is a path to the directory containg sheet-names.cfg

  import filename.gnumeric txtdbdir   : Import a gnumeric file into a txt db directory
  edit   txtdbdir                     : Edit a txtdbdir using gnumeric.
  lookup txtdbdir sheetname row col   : Look up a value in the text db   
  json   txtdbdir                     : Print the db as list of lists json data

Part of the Megatest tool suite. Learn more at http://www.kiatoa.com/fossils/megatest"))









(define (lookup path sheet row col)
  (let ((fname (conc path "/" sheet ".dat")))
    (if (file-exists? fname)
	(let ((dat (read-dat fname)))
	  (if (null? dat)
	      #f
	      (let loop ((hed (car dat))
			 (tal (cdr dat)))
		(if (and (equal? row (car hed))
			 (equal? col (cadr hed)))
		    (caddr hed)
		    (if (null? tal)
			#f
			(loop (car tal)(cdr tal)))))))
	#f)))

(define (edit-txtdb path)
  (let* ((dbname  (pathname-strip-directory path))
	 (tmpf    (conc (create-temporary-file dbname) ".gnumeric")))
    (if (file-exists? (conc path "/sheet-names.cfg"))
	(txtdb-export path tmpf))
    (let ((pid (process-run "gnumeric" (list tmpf))))
      (process-wait pid)
      (import-gnumeric-file tmpf path))))

(define (process-action action-str . param)
  (let ((num-params (length param))
	(action     (string->symbol action-str)))
    (cond
     ((eq? num-params 1)
      (case action
	((edit)
	 (edit-txtdb (car param)))))


     ((eq? num-params 2)
      (case action
	((import)
	 (let ((fname     (car param))
	       (targname  (cadr param)))
	   (import-gnumeric-file fname targname)))))
     ((eq? num-params 4)







|

|

|
|
|
|



>
>
>
>
>
>
>
>
















|



|











|
>
>







300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
		    (cdr tal)
		    new-rownames
		    new-colnames
		    (if (> curr-rownum rownum) curr-rownum rownum)
		    (if (> curr-colnum colnum) curr-colnum colnum)
		    ))))))
(define help
  (conc "Usage: refdb action params ...

Note: refdbdir is a path to the directory containg sheet-names.cfg

  import filename.gnumeric refdbdir   : Import a gnumeric file into a txt db directory
  edit   refdbdir                     : Edit a refdbdir using gnumeric.
  lookup refdbdir sheetname row col   : Look up a value in the text db   
  ls refdbdir                         : List the keys for specified level 

Part of the Megatest tool suite. Learn more at http://www.kiatoa.com/fossils/megatest"))

(define (list-sheets path)
  ;; (cond
  ;;  ((and path (not sheet)(not row)(not col))
  (if (file-exists? path)
      (read-file (conc path "/sheet-names.cfg") read-line)
      '()))
;; ((and path sheet (not row)(not col))

(define (lookup path sheet row col)
  (let ((fname (conc path "/" sheet ".dat")))
    (if (file-exists? fname)
	(let ((dat (read-dat fname)))
	  (if (null? dat)
	      #f
	      (let loop ((hed (car dat))
			 (tal (cdr dat)))
		(if (and (equal? row (car hed))
			 (equal? col (cadr hed)))
		    (caddr hed)
		    (if (null? tal)
			#f
			(loop (car tal)(cdr tal)))))))
	#f)))

(define (edit-refdb path)
  (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))))

(define (process-action action-str . param)
  (let ((num-params (length param))
	(action     (string->symbol action-str)))
    (cond
     ((eq? num-params 1)
      (case action
	((edit)
	 (edit-refdb (car param)))
	((ls)
	 (map print (list-sheets (car param))))))
     ((eq? num-params 2)
      (case action
	((import)
	 (let ((fname     (car param))
	       (targname  (cadr param)))
	   (import-gnumeric-file fname targname)))))
     ((eq? num-params 4)
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
     ((>= (length rema) 2)
      (apply process-action (car rema)(cdr rema)))
     (else (print help)))))

(main)

#|  
 (define x (txtdb:read-gnumeric-xml "testdata-stripped.xml"))



;; Write out sxml
(with-output-to-file "testdata.sxml" (lambda()(pp x)))









|







383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
     ((>= (length rema) 2)
      (apply process-action (car rema)(cdr rema)))
     (else (print help)))))

(main)

#|  
 (define x (refdb:read-gnumeric-xml "testdata-stripped.xml"))



;; Write out sxml
(with-output-to-file "testdata.sxml" (lambda()(pp x)))