Megatest

Check-in [d0d74baabc]
Login
Overview
Comment:Mostly working
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dev
Files: files | file ages | folders
SHA1: d0d74baabcfc6cd40c982e24622ebba98f544c7a
User & Date: matt on 2013-07-14 19:30:15
Other Links: branch diff | manifest | tags
Context
2013-07-14
20:35
Basic command line working check-in: 30d2c2450a user: matt tags: dev
19:30
Mostly working check-in: d0d74baabc user: matt tags: dev
17:22
Closer check-in: a1e941a7b1 user: matt tags: dev
Changes

Modified txtdb/txtdb.scm from [0fcec95315] to [165f563641].

189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
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
	(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 (get-value-type val expressions)
  (cond 
   ((string->number val) '(ValueType "40"))

   ((equal? (substring val 0 1) "=")
    (let ((exid (hash-table-ref/default expressions val #f)))
      (if exid 
	  (list 'ExprID exid)
	  (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))
	 (row-indx (car indx))
	 (col-indx (cadr indx))


	 (exprs    (make-hash-table)))
    (list (cons 'http://www.gnumeric.org/v10.dtd:Cells 
		(map (lambda (item)
		       (let* ((row-name (car item))
			      (col-name (cadr item))
			      (row-num  (cadr (assoc row-name row-indx)))

			      (col-num  (cadr (assoc col-name col-indx)))

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







|


|
|





|







>














>
>





|
>
|
>





|







189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
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
249
250
251
252
	(inp        (open-input-file fname)))
    (let loop ((inl     (read-line inp))
	       (section #f)
	       (res     '()))
      (if (eof-object? inl)
	  (begin
	    (close-input-port inp)
	    (reverse res))
	  (regex-case
	   inl 
	   (comment-rx _          (loop (read-line inp) section res))
	   (blank-rx   _          (loop (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 k section v) res)))
	   (else                  (begin
				    (print "ERROR: Unrecognised line in input file " fname ", ignoring it")
				    (loop (read-line inp) section res))))))))

(define (get-value-type val expressions)
  (cond 
   ((string->number val) '(ValueType "40"))
   ((equal? val "")      '(ValueType "60"))
   ((equal? (substring val 0 1) "=")
    (let ((exid (hash-table-ref/default expressions val #f)))
      (if exid 
	  (list 'ExprID exid)
	  (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))
	 (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)
		       (let* ((row-name (car item))
			      (col-name (cadr item))
			      (row-num  (let ((i (assoc row-name row-indx)))
					  (if i (cadr i) 0))) ;; 0 for the title row/col
			      (col-num  (let ((i (assoc col-name col-indx)))
					  (if i (cadr i) 0)))
			      (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")))