Megatest

Check-in [eb02e8c328]
Login
Overview
Comment:read-dat for txtdb completed
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dev
Files: files | file ages | folders
SHA1: eb02e8c3288d266197278c2e2857a5bcae81e03d
User & Date: matt on 2013-07-14 13:31:18
Other Links: branch diff | manifest | tags
Context
2013-07-14
14:39
Oops. Went down a messy road. Snapshot this point in time. check-in: bdf18ad3a8 user: matt tags: dev
13:31
read-dat for txtdb completed check-in: eb02e8c328 user: matt tags: dev
10:58
First pass at txtdb reader check-in: f1295e0ec5 user: matt tags: dev
Changes

Modified txtdb/txtdb.scm from [2933c5fd59] to [5922499bd8].

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")))