1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
(use ssax)
(use sxml-serializer)
(use sxml-modifications)
(use regex)
(use srfi-69)
;; Read a non-compressed gnumeric file
(define (txtdb:read-gnumeric-xml fname)
(with-input-from-file fname
(lambda ()
(ssax:xml->sxml (current-input-port) '()))))
|
|
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
|
;; Copyright 2006-2013, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
(use ssax)
(use sxml-serializer)
(use sxml-modifications)
(use regex)
(use srfi-69)
(use regex-case)
;; Read a non-compressed gnumeric file
(define (txtdb:read-gnumeric-xml fname)
(with-input-from-file fname
(lambda ()
(ssax:xml->sxml (current-input-port) '()))))
|
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
(with-output-to-file tmpf
(lambda ()
(print (sxml-serializer#serialize-sxml sxml-dat))))
(system (conc "gzip " tmpf))
(file-copy tmpf fname)
(delete-file tmpf)))
(define (read-dat fname)
(read-file fname read-line)) ;; Placeholder!
(define (txtdb->sxml dbdir)
(let* ((sht-names (read-file (conc dbdir "/sheet-names.cfg") read-line))
(wrk-rem (read-file (conc dbdir "/xml/workbook.xml") read-line))
(sht-rem (read-file (conc dbdir "/xml/sheets.xml") read-line))
(sheets (fold (lambda (sheetname res)
(let ((sheetdat (read-dat (conc dbdir "/" sheetname ".dat")))
|
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
|
(with-output-to-file tmpf
(lambda ()
(print (sxml-serializer#serialize-sxml sxml-dat))))
(system (conc "gzip " tmpf))
(file-copy tmpf fname)
(delete-file tmpf)))
(define (hash-table-reverse-lookup ht val)
(hash-table-fold ht (lambda (k v res)(if (equal? v val) k res)) #f))
(define (read-dat fname)
(let ((section-rx (regexp "^\\[(.*)\\]\\s*$"))
(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*$"))
(inp (open-input-file fname)))
(let loop ((inl (read-line inp))
(section #f)
(res '()))
(if (eof-object? inl)
(begin
(close-input-port inp)
res)
(regex-case
inl
(comment-rx _ (read-line inp) section res)
(blank-rx _ (read-line inp) section res)
(section-rx (x sname) (loop (read-line inp)
sname
res))
(cell-rx (x k v) (loop (read-line inp)
section
(cons (list section k v) res)))
(else (begin
(print "ERROR: Unrecognised line in input file " fname ", ignoring it")
(loop (read-line inp) section res))))))))
(define (txtdb->sxml dbdir)
(let* ((sht-names (read-file (conc dbdir "/sheet-names.cfg") read-line))
(wrk-rem (read-file (conc dbdir "/xml/workbook.xml") read-line))
(sht-rem (read-file (conc dbdir "/xml/sheets.xml") read-line))
(sheets (fold (lambda (sheetname res)
(let ((sheetdat (read-dat (conc dbdir "/" sheetname ".dat")))
|