Refdb

Check-in [49adb74cc4]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added missing file
Timelines: family | ancestors | descendants | both | v1.01
Files: files | file ages | folders
SHA1:49adb74cc45a0b0ec32ee7dde17750c068c3de7d
User & Date: mrwellan 2014-08-12 16:35:58
Context
2014-08-12
20:07
Changed default format to General in metadat.scm template. check-in: 1dcb860e90 user: mrwellan tags: v1.01
16:35
Added missing file check-in: 49adb74cc4 user: mrwellan tags: v1.01
16:05
Added support for creating non-existing sheets check-in: 1da5afe233 user: mrwellan tags: v1.01
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to refdb-module.scm.

262
263
264
265
266
267
268
269
270

271
272
273
274
275
276
277
278
279

280


281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
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
  (hash-table-fold ht (lambda (k v res)(if (equal? v val) k res)) #f))

(define (transpose-dat dat)
  (map (lambda (el)(list (cadr el)(car el)(caddr el)))
       dat))

(define (create-empty-dat fname)
  (if (not (file-exists? fname))
      (if (file-write-access? (pathname-directory fname))

	  (with-output-to-file fname
	    (lambda ()
	      (print "[Refdb data file]\nfield value ...")))
	  #f)
      #f))

;; converge this with the ini-file egg and the Megatest config reader. 
;;
(define (read-dat fname #!key (record 'col)) ;; record 'col or 'row

  (if (create-empty-dat fname)


      (let ((section-rx  (regexp "^\\[(.*)\\]\\s*$"))
	    (comment-rx  (regexp "^#.*"))          ;; This means a cell name cannot start with #
	    (quoted-cell-rx (regexp "^\"([^\"]*)\" (.*)$"))
	    (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))
	    (first-section "")) ;; used for zeroth title
	(let loop ((inl     (read-line inp))
		   (section ".............")
		   (res     '()))
	  (if (eof-object? inl)
	      (begin
		(close-input-port inp)
		(let ((newres (cons (list first-section first-section first-section)
				    (reverse res))))
		  (if (eq? record 'col)
		      newres
		      (transpose-dat newres))))
	      (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)  (begin
					(if (not first-section)
					    (set! first-section sname))
					(loop (read-line inp) 
					      sname 
					      res)))
	       (quoted-cell-rx (x k v)(loop (read-line inp)
					    section
					    (cons (list k section v) 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
					(print "ERROR: Unrecognised line in input file " fname ", ignoring it")
					(loop (read-line inp) section res)))))))
      '(("" "" ""))))


(define (dat-lookup dat section var)
  (let ((res (assoc section (map cdr (filter (lambda (x)(equal? (car x) var)) dat)))))
    (if res
	(cadr res)
	#f)))








<
|
>
|
|
|
|





>
|
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<
>







262
263
264
265
266
267
268

269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
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
  (hash-table-fold ht (lambda (k v res)(if (equal? v val) k res)) #f))

(define (transpose-dat dat)
  (map (lambda (el)(list (cadr el)(car el)(caddr el)))
       dat))

(define (create-empty-dat fname)

  (if (file-write-access? (pathname-directory fname))
      (begin
	(with-output-to-file fname
	  (lambda ()
	    (print "[Refdb data file]\nfield value ...")))
	#t)
      #f))

;; converge this with the ini-file egg and the Megatest config reader. 
;;
(define (read-dat fname #!key (record 'col)) ;; record 'col or 'row
    (if (not (file-exists? fname))
	(if (create-empty-dat fname)
	    (read-dat fname record: record)
	    '(("" "" "")))	
	(let ((section-rx  (regexp "^\\[(.*)\\]\\s*$"))
	      (comment-rx  (regexp "^#.*"))          ;; This means a cell name cannot start with #
	      (quoted-cell-rx (regexp "^\"([^\"]*)\" (.*)$"))
	      (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))
	      (first-section "")) ;; used for zeroth title
	  (let loop ((inl     (read-line inp))
		     (section ".............")
		     (res     '()))
	    (if (eof-object? inl)
		(begin
		  (close-input-port inp)
		  (let ((newres (cons (list first-section first-section first-section)
				      (reverse res))))
		    (if (eq? record 'col)
			newres
			(transpose-dat newres))))
		(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)  (begin
					  (if (not first-section)
					      (set! first-section sname))
					  (loop (read-line inp) 
						sname 
						res)))
		 (quoted-cell-rx (x k v)(loop (read-line inp)
					      section
					      (cons (list k section v) 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
					  (print "ERROR: Unrecognised line in input file " fname ", ignoring it")
					  (loop (read-line inp) section res)))))))))



(define (dat-lookup dat section var)
  (let ((res (assoc section (map cdr (filter (lambda (x)(equal? (car x) var)) dat)))))
    (if res
	(cadr res)
	#f)))

Changes to testrefdb/Sheet1.dat.



























>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
[b]
2 b2
3 b3
4 b4
5 b5
6 b6
[c]
2 c2
[d]
2 d2
[e]
2 e2
6 e6

Added testrefdb/Sheet2.dat.