| ︙ | | |
14
15
16
17
18
19
20
21
22
23
24
25
26
27
|
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
|
+
+
|
(use regex)
(use srfi-69)
(use regex-case)
(use posix)
(use json)
(use csv)
(include "../megatest-fossil-hash.scm")
;; 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))
|
| ︙ | | |
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
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
123
124
|
-
+
+
+
-
+
+
-
+
+
+
+
+
|
(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
(cols (make-hash-table))) ;; name -> ( (name val) ... )
(cols (make-hash-table)) ;; name -> ( (name val) ... )
(col0title ""))
(for-each (lambda (cell)
(let ((rownum (string->number (car (find-section cell 'Row))))
(colnum (string->number (car (find-section cell 'Col))))
(valtype (let ((res (find-section cell 'ValueType)))
(if res (car res) #f)))
(value (let ((res (cdr (filter (lambda (x)(not (list? x))) cell))))
(if (null? res) "" (car res)))))
;; If colnum is 0 Then this is a row name, if rownum is 0 then this is a col name
(cond
((and (not (eq? 0 rownum))
((eq? 0 colnum) ;; a blank in column zero is handled with the special name "row-N"
(eq? 0 colnum)) ;; a blank in column zero is handled with the special name "row-N"
(hash-table-set! rownums rownum (if (equal? value "")
(conc "row-" rownum)
value)))
((and (not (eq? 0 colnum))
((eq? 0 rownum)
(eq? 0 rownum))
(hash-table-set! colnums colnum (if (equal? value "")
(conc "col-" colnum)
value)))
((and (eq? 0 rownum)
(eq? 0 colnum))
(set! col0title value))
(else
(let ((colname (hash-table-ref/default colnums colnum (conc "col-" colnum)))
(rowname (hash-table-ref/default rownums rownum (conc "row-" rownum))))
(hash-table-set! cols colname (cons (list rowname value)
(hash-table-ref/default cols colname '()))))))))
cells)
(let ((ref-colnums (map (lambda (c)
(list (cdr c)(car c)))
(hash-table->alist colnums))))
(with-output-to-file (conc targdir "/" sheet-name ".dat")
(lambda ()
(print "[" col0title "]")
(for-each (lambda (colname)
(print "[" colname "]")
(for-each (lambda (row)
(let ((key (car row))
(val (cadr row)))
(if (string-search comment-rx key)
(print val)
|
| ︙ | | |
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
|
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
|
-
+
+
+
-
+
-
-
-
+
+
+
+
+
+
|
(comment-rx (regexp "^#.*")) ;; This means a cell name cannot start with #
(cell-rx (regexp "^(\\S+) (.*)$")) ;; One space only for the cellname content separator
(blank-rx (regexp "^\\s*$"))
(continue-rx (regexp ".*\\\\$"))
(var-no-val-rx (regexp "^(\\S+)\\s*$"))
(inp (open-input-file fname))
(cmnt-indx (make-hash-table))
(blnk-indx (make-hash-table)))
(blnk-indx (make-hash-table))
(first-section #f)) ;; used for zeroth title
(let loop ((inl (read-line inp))
(section ".............")
(res '()))
(if (eof-object? inl)
(begin
(close-input-port inp)
(cons (list first-section first-section first-section)
(reverse res))
(reverse res)))
(regex-case
inl
(continue-rx _ (loop (conc inl (read-line inp)) section res))
(comment-rx _ (let ((curr-indx (+ 1 (hash-table-ref/default cmnt-indx section 0))))
(hash-table-set! cmnt-indx section curr-indx)
(loop (read-line inp)
section
(cons (list (conc "#CMNT" curr-indx) section inl) res))))
(blank-rx _ (let ((curr-indx (+ 1 (hash-table-ref/default blnk-indx section 0))))
(hash-table-set! blnk-indx section curr-indx)
(loop (read-line inp)
section
(cons (list (conc "#BLNK" curr-indx) section " ") res))))
(section-rx (x sname) (loop (read-line inp)
sname
res))
(section-rx (x sname) (begin
(if (not first-section)
(set! first-section sname))
(loop (read-line inp)
sname
res)))
(cell-rx (x k v) (loop (read-line inp)
section
(cons (list k section v) res)))
(var-no-val-rx (x k) (loop (read-line inp)
section
(cons (list k section "") res)))
(else (begin
|
| ︙ | | |
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
|
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
|
-
+
|
(let* ((values (hash-table-keys expressions)) ;; note, values are the id numbers
(new-max (+ 1 (if (null? values) 0 (apply max values)))))
(hash-table-set! expressions val new-max)
(list 'ExprID new-max)))))
(else '(ValueType "60"))))
(define (dat->cells dat)
(let* ((indx (common:sparse-list-generate-index dat))
(let* ((indx (common:sparse-list-generate-index (cdr dat)))
(row-indx (car indx))
(col-indx (cadr indx))
(rowdat (map (lambda (row)(list (car row) " " (car row))) row-indx))
(coldat (map (lambda (col)(list " " (car col) (car col))) col-indx))
(exprs (make-hash-table)))
(list (cons 'http://www.gnumeric.org/v10.dtd:Cells
(map (lambda (item)
|
| ︙ | | |
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
|
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
|
+
-
+
+
+
+
+
+
+
+
-
+
+
+
|
))))))
(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
export refdbdir filename.gnumeric : Export a refdb to a gnumeric file
edit refdbdir : Edit a refdbdir using gnumeric.
ls refdbdir : List the keys for specified level
lookup refdbdir sheetname row col : Look up a value in the text db
getrownames refdb sheetname : Get a list of row titles
getcolnames refdb sheetname : Get a list of column titles
getcolnames refdb sheetname : Get a list of column titles
To export to other formats; first export to gnumeric then use ssconvert.
e.g.
refdb export mydata mydata.gnumeric
ssconvert -T Gnumeric_html:html40 mydata.gnumeric mydata.html
Part of the Megatest tool suite. Learn more at http://www.kiatoa.com/fossils/megatest"))
Part of the Megatest tool suite. Learn more at http://www.kiatoa.com/fossils/megatest
Version: " megatest-fossil-hash))
(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)
'()))
|
| ︙ | | |
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
|
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
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
486
487
488
489
490
491
492
|
-
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
-
-
+
|
;; #f
;; (map cadr dat))))))
(define (edit-refdb path)
;; TEMPORARY, REMOVE IN 2014
(if (not (file-exists? path)) ;; Create new
(begin
(print "INFO: Creating new txtdb at " path)
(print "\nINFO: Creating new txtdb at " path "\n")
(create-new-db path)))
(if (not (file-exists? (conc path "/sxml/_sheets.sxml")))
(begin
(print "ERROR: You appear to have the old file structure for txtdb. Please do the following and try again.")
(print)
(print "mv " path "/sxml/sheets.sxml " path "/sxml/_sheets.sxml")
(print "mv " path "/sxml/workbook.sxml " path "/sxml/_workbook.sxml")
(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))))
;;======================================================================
;; This routine dispaches or executes most of the commands for refdb
;;======================================================================
;;
(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)
(let ((param1 (car param))
(param2 (cadr param)))
(case action
((getrownames)(print (string-intersperse (get-rowcol-names (car param)(cadr param) car) " ")))
((getcolnames)(print (string-intersperse (get-rowcol-names (car param)(cadr param) cadr) " ")))
((import)
(let ((fname (car param))
(targname (cadr param)))
(import-gnumeric-file fname targname)))))
|
| ︙ | | |
535
536
537
538
539
540
541
542
543
544
545
546
547
548
|
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
|
+
+
+
|
(lambda ()
(map print sheet-names))))))
(let ((dotfile (conc (get-environment-variable "HOME") "/.txtdbrc")))
(if (file-exists? dotfile)
(load dotfile)))
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.refdbrc")))
(if (file-exists? debugcontrolf)
(load debugcontrolf)))
(main)
#|
(define x (refdb:read-gnumeric-xml "testdata-stripped.xml"))
|
| ︙ | | |