Overview
| Comment: | Begingings of code in place for editing Megatest area using refdb |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | dev |
| Files: | files | file ages | folders |
| SHA1: |
76df0976498ced807f5218028942df79 |
| User & Date: | matt on 2013-07-26 00:34:55 |
| Other Links: | branch diff | manifest | tags |
Context
|
2013-07-26
| ||
| 09:24 | Added vars with no value, proper creation of sheets index and dotfile loading to txtdb check-in: 46eb920500 user: matt tags: dev | |
| 00:34 | Begingings of code in place for editing Megatest area using refdb check-in: 76df097649 user: matt tags: dev | |
|
2013-07-25
| ||
| 23:57 | Added create on edit for refdb check-in: 7571d597a5 user: matt tags: dev | |
Changes
Modified txtdb/txtdb.scm from [84fe7eb4b4] to [1bdd1d89fa].
| ︙ | |||
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 | 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 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + |
(define (main)
(let* ((args (argv))
(prog (car args))
(rema (cdr args)))
(cond
((null? rema)(print help))
((eq? (length rema) 1)
(case (string->symbol (car rema))
((mtedit) ;; Edit a Megatest area
(megatest->refdb))))
((>= (length rema) 2)
(apply process-action (car rema)(cdr rema)))
(else (print help)))))
;;======================================================================
;; C R E A T E N E W D B S
;;======================================================================
(include "metadat.scm")
;; Creates a new db at path with one sheet
(define (create-new-db path)
(extract-refdb minimal-sxml path))
;;======================================================================
;; M E G A T E S T S U P P O R T
;;======================================================================
;; Construct a temporary refdb area from the files in a Megatest area
;;
;; .refdb
;; megatest.dat (from megatest.config)
;; runconfigs.dat (from runconfigs.config)
;; tests_test1.dat (from tests/test1/testconfig)
;; etc.
;;
(define (make-sheet-meta-if-needed fname)
(if (not (file-exists? fname))
(sxml->file sheet-meta fname)))
(define (megatest->refdb)
(if (not (file-exists? "megatest.config")) ;; must be at top of Megatest area
(begin
(print "ERROR: Must be at top of Megatest area to edit")
(exit)))
(create-directory ".refdb/sxml" #t)
(if (not (file-exists? ".refdb/sxml/_workbook.sxml"))
(sxml->file workbook-meta ".refdb/sxml/_workbook.sxml"))
(if (not (file-exists? ".refdb/sxml/_sheets.sxml"))
(sxml->file sheets-meta ".refdb/sxml/_sheets.sxml"))
(file-copy "megatest.config" ".refdb/megatest.dat" #t)
(make-sheet-meta-if-needed ".refdb/sxml/megatest.sxml")
(file-copy "runconfigs.config" ".refdb/runconfigs.dat" #t)
(make-sheet-meta-if-needed ".refdb/sxml/runconfigs.sxml")
(let ((testnames '()))
(for-each (lambda (tdir)
(let* ((testname (pathname-strip-directory tdir))
(tconfig (conc tdir "/testconfig"))
(metafile (conc ".refdb/sxml/" testname ".sxml")))
(if (file-exists? tconfig)
(begin
(set! testnames (append testnames (list testname)))
(file-copy tconfig (conc ".refdb/" testname ".dat") #t)
(make-sheet-meta-if-needed metafile)))))
(glob "tests/*"))
(with-output-to-file ".refdb/sheet-names.cfg"
(lambda ()
(map print (append (list "megatest" "runconfigs") testnames))))))
(main)
#|
(define x (refdb:read-gnumeric-xml "testdata-stripped.xml"))
|
| ︙ |