| ︙ | | |
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
|
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
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
|
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
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
|
| ︙ | | |
| ︙ | | |
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
|
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)
(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
|
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)
(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
|
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.
;; Write an sxml gnumeric workbook to a refdb directory structure.
;;
(define (extract-txtdb dat targdir)
(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->txtdb sheet targdir))
(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 (txtdb:read-gnumeric-xml tmpf)))
(let ((res (refdb:read-gnumeric-xml tmpf)))
(delete-file tmpf)
res))))
(define (import-gnumeric-file fname targdir)
(extract-txtdb (read-gnumeric-file fname) targdir))
(extract-refdb (read-gnumeric-file fname) targdir))
;; Write a gnumeric compressed xml spreadsheet from a txtdb directory structure.
;; Write a gnumeric compressed xml spreadsheet from a refdb directory structure.
;;
(define (txtdb-export dbdir fname)
(let* ((sxml-dat (txtdb->sxml dbdir))
(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
|
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)
(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
|
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: txtdb action params ...
(conc "Usage: refdb action params ...
Note: txtdbdir is a path to the directory containg sheet-names.cfg
Note: refdbdir 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
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-txtdb path)
(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"))
(txtdb-export path tmpf))
(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-txtdb (car param)))))
(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
|
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 (txtdb:read-gnumeric-xml "testdata-stripped.xml"))
(define x (refdb:read-gnumeric-xml "testdata-stripped.xml"))
;; Write out sxml
(with-output-to-file "testdata.sxml" (lambda()(pp x)))
|
| ︙ | | |