Megatest

           subrun.scm archive.scm env.scm		\
           diff-report.scm cgisetup/models/pgdb.scm

# module source files
MSRCFILES = dbfile.scm debugprint.scm mtargs.scm commonmod.scm dbmod.scm \
            tcp-transportmod.scm rmtmod.scm portlogger.scm apimod.scm \
	    configfmod.scm processmod.scm servermod.scm megatestmod.scm \
	    stml2.scm fsmod.scm cpumod.scm mtmod.scm odsmod.scm

transport-mode.scm : transport-mode.scm.template
	cp transport-mode.scm.template transport-mode.scm

dashboard-transport-mode.scm : dashboard-transport-mode.scm.template
	cp dashboard-transport-mode.scm.template dashboard-transport-mode.scm

mtest : transport-mode.scm
dboard : dashboard-transport-mode.scm

# dbmod.import.o is just a hack here

process.o            : mofiles/processmod.o
mofiles/configfmod.o : mofiles/processmod.o
mofiles/processmod.o : mofiles/commonmod.o
mofiles/servermod.o  : mofiles/commonmod.o
mofiles/rmtmod.o     : mofiles/mtmod.o
mofiles/mtmod.o      : mofiles/dbmod.o      
mofiles/mtmod.o      : mofiles/tcp-transportmod.o

mofiles/dbfile.o     : \
       mofiles/debugprint.o mofiles/commonmod.o  mofiles/configfmod.o
mofiles/apimod.o : mofiles/commonmod.o mofiles/tcp-transportmod.o mofiles/configfmod.o
mofiles/dbmod.o : mofiles/dbfile.o
mofiles/api.o : mofiles/apimod.o
mofiles/commonmod.o : mofiles/debugprint.o mofiles/stml2.o

;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================

;; (use trace)

;; (include "altdb.scm")

;; Some of these routines use:
;;
;;     http://www.cs.toronto.edu/~gfb/scheme/simple-macros.html
;;
;; Syntax for defining macros in a simple style similar to function definiton,
;;  when there is a single pattern for the argument list and there are no keywords.

      rv)))

(define home (getenv "HOME"))
(define user (getenv "USER"))

;;======================================================================
;; return a nice clean pathname made absolute
;;======================================================================

(define (common:nice-path dir)
  (let ((match (string-match "^(~[^\\/]*)(\\/.*|)$" dir)))
    (if match ;; using ~ for home?
	(common:nice-path (conc (common:read-link-f (cadr match)) "/" (caddr match)))
	(normalize-pathname (if (absolute-pathname? dir)
				dir
				(conc (current-directory) "/" dir))))))

                             message: (conc "Unable to access path: " path-string)
                             ))

;;======================================================================
;; does the directory exist and do we have write access?
;;
;;    returns the directory or #f
;;======================================================================

(define (common:directory-writable? path-string)
  (handle-exceptions
      exn
    (begin
      (debug:print 0 *default-log-port* "Failed to identify access to " path-string ", exn=" exn)
      #f)
   (if (and (directory-exists? path-string)

      exn
      #f ;; I don't really care why this failed (at least for now)
    (delete-file* fname)))

;;======================================================================
;; misc conversion, data manipulation functions
;;======================================================================

;;======================================================================
;; old stuff from keys.scm
;;======================================================================

(include "key_records.scm")
(include "common_records.scm")

(define (keys->keystr keys) ;; => key1,key2,key3,additiona1, ...
  (string-intersperse keys ","))

;; (define (args:usage . a) #f)

(define (tasks:wait-on-journal path n #!key (remove #f)(waiting-msg #f))
  (if (not (string? path))
      (debug:print-error 0 *default-log-port* "Called tasks:wait-on-journal with path=" path " (not a string)")
      (let ((fullpath (conc path "-journal")))
	(handle-exceptions
	 exn
	 (begin
	   (print-call-chain (current-error-port))
	   (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn))
	   (debug:print 5 *default-log-port* " exn=" (condition->list exn))
	   (debug:print 0 *default-log-port* "tasks:wait-on-journal failed. Continuing on, you can ignore this call-chain")
	   #t) ;; if stuff goes wrong just allow it to move on
	 (let loop ((journal-exists (file-exists? fullpath))
		    (count          n)) ;; wait ten times ...
	   (if journal-exists
	       (begin
		 (if (and waiting-msg
			  (eq? (modulo n 30) 0))
		     (debug:print 0 *default-log-port* waiting-msg))
		 (if (> count 0)
		     (begin
		       (thread-sleep! 1)
		       (loop (file-exists? fullpath)
			     (- count 1)))
		     (begin
		       (debug:print 0 *default-log-port* "ERROR: removing the journal file " fullpath ", this is not good. Look for disk full, write access and other issues.")
		       (if remove (system (conc "rm -rf " fullpath)))
		       #f)))
	       #t))))))

;;======================================================================
;; key <=> target routines
;;======================================================================

;; This invalidates using "/" in item names. Every key will be
;; available via args:get-arg as :keyfield. Since this only needs to
;; be called once let's use it to set the environment vars
;;
;; The setting of :keyfield in args should be turned off ASAP
;;
(define (keys:target-set-args keys target ht)
  (if target
      (let ((vals (string-split target "/")))
	(if (eq? (length vals)(length keys))
	    (for-each (lambda (key val)
			(setenv key val)
			(if ht (hash-table-set! ht (conc ":" key) val)))
		      keys
		      vals)
	    (debug:print-error 0 *default-log-port* "wrong number of values in " target ", should match " keys))
	vals)
      (debug:print 4 *default-log-port* "ERROR: keys:target-set-args called with no target.")))

;; given the keys (a list of vectors <key field> or a list of keys) and a target return a keyval list
;; keyval list ( (key1 val1) (key2 val2) ...)
(define (keys:target->keyval keys target)
  (let* ((targlist (string-split target "/"))
	 (numkeys  (length keys))
	 (numtarg  (length targlist))
	 (targtweaked (if (> numkeys numtarg)
			  (append targlist (make-list (- numkeys numtarg) ""))
			  targlist)))
    (map (lambda (key targ)
	   (list key targ))
	 keys targtweaked)))

;;======================================================================
;; return first command that exists, else #f
;;
(define (common:which cmds)
  (if (null? cmds)
      #f

               exn
	     (begin
	       (debug:print 0 *default-log-port* "joining threads failed. exn=" exn)
               #t) ;; just ignore it, it might have died in the meantime so joining it will throw an exception
             (thread-join! thread))
           )))
   (hash-table-keys *common:thread-punchlist*)))

;; given a list of itemmaps (testname . map), return the first match
;;
(define (tests:lookup-itemmap itemmaps testname)
  (let ((best-matches (filter (lambda (itemmap)
				(tests:match (car itemmap) testname #f))
			      itemmaps)))
    (if (null? best-matches)
	#f
	(let ((res (car best-matches)))
	  ;; (debug:print 0 *default-log-port* "res=" res)
	  (cond
	   ((string? res) res) ;;; FIX THE ROOT CAUSE HERE ....
	   ((null? res)   #f)
	   ((string? (cdr res)) (cdr res))  ;; it is a pair
	   ((string? (cadr res))(cadr res)) ;; it is a list
	   (else cadr res))))))

;; if itempath is #f then look only at the testname part
;;
(define (tests:match patterns testname itempath #!key (required '()))
  (if (string? patterns)
      (let ((patts (append (string-split patterns ",") required)))
	(if (null? patts) ;;; no pattern(s) means no match
	    #f
	    (let loop ((patt (car patts))
		       (tal  (cdr patts)))
	      ;; (print "loop: patt: " patt ", tal " tal)
	      (if (string=? patt "")
		  #f ;; nothing ever matches empty string - policy
		  (let* ((patt-parts (string-match (regexp "^([^\\/]*)(\\/(.*)|)$") patt))
			 (test-patt  (cadr patt-parts))
			 (item-patt  (cadddr patt-parts)))
		    ;; special case: test vs. test/
		    ;;   test  => "test" "%"
		    ;;   test/ => "test" ""
		    (if (and (not (substring-index "/" patt)) ;; no slash in the original
			     (or (not item-patt)
				 (equal? item-patt "")))      ;; should always be true that item-patt is ""
			(set! item-patt "%"))
		    ;; (print "tests:match => patt-parts: " patt-parts ", test-patt: " test-patt ", item-patt: " item-patt)
		    (if (and (tests:glob-like-match test-patt testname)
			     (or (not itempath)
				 (tests:glob-like-match (if item-patt item-patt "") itempath)))
			#t
			(if (null? tal)
			    #f
			    (loop (car tal)(cdr tal)))))))))))

;; if itempath is #f then look only at the testname part
;;
(define (tests:match->sqlqry patterns)
  (if (string? patterns)
      (let ((patts (string-split patterns ",")))
	(if (null? patts) ;;; no pattern(s) means no match, we will do no query
	    #f
	    (let loop ((patt (car patts))
		       (tal  (cdr patts))
		       (res  '()))
	      ;; (print "loop: patt: " patt ", tal " tal)
	      (let* ((patt-parts (string-match (regexp "^([^\\/]*)(\\/(.*)|)$") patt))
		     (test-patt  (cadr patt-parts))
		     (item-patt  (cadddr patt-parts))
		     (test-qry   (db:patt->like "testname" test-patt))
		     (item-qry   (db:patt->like "item_path" item-patt))
		     (qry        (conc "(" test-qry " AND " item-qry ")")))
		;; (print "tests:match => patt-parts: " patt-parts ", test-patt: " test-patt ", item-patt: " item-patt)
		(if (null? tal)
		    (string-intersperse (append (reverse res)(list qry)) " OR ")
		    (loop (car tal)(cdr tal)(cons qry res)))))))
      #f))

(define *glob-like-match-cache* (make-hash-table))
(define (tests:cache-regexp str-in flag)
  (let* ((key (conc str-in flag)))
    (or (hash-table-ref/default *glob-like-match-cache* key #f)
	(let* ((newrx (regexp str-in flag)))
	  (hash-table-set! *glob-like-match-cache* key newrx)
	  newrx))))

;; tests:glob-like-match 
(define (tests:glob-like-match patt str) 
  (let* ((like     (substring-index "%" patt))
	 (notpatt  (equal? (substring-index "~" patt) 0))
	 (newpatt  (if notpatt (substring patt 1) patt))
	 (finpatt  (if like
		       (string-substitute (regexp "%") ".*" newpatt #f)
		       (string-substitute (regexp "\\*") ".*" newpatt #f)))
	 (rx       (tests:cache-regexp finpatt (if like #t #f)))
	 (res      (string-match rx str)))
    (if notpatt (not res) res)))

;; keys list to key1,key2,key3 ...
(define (runs:get-std-run-fields keys remfields)
  (let* ((header    (append keys remfields))
	 (keystr    (conc (keys->keystr keys) ","
			  (string-intersperse remfields ","))))
    (list keystr header)))

;; make a query (fieldname like 'patt1' OR fieldname 
(define (db:patt->like fieldname pattstr #!key (comparator " OR "))
  (let ((patts (if (string? pattstr)
		   (string-split pattstr ",")
		   '("%"))))
    (string-intersperse (map (lambda (patt)
			       (let ((wildtype (if (substring-index "%" patt) "LIKE" "GLOB")))
				 (conc fieldname " " wildtype " '" patt "'")))
			     (if (null? patts)
				 '("")
				 patts))
			comparator)))

;;======================================================================
;; V E R S I O N
;;======================================================================

(define (common:get-full-version)
  (conc megatest-version "-" megatest-fossil-hash))

(define (common:version-signature)
  (conc megatest-version "-" (substring megatest-fossil-hash 0 4)))



)

  ;; this is one db per server
  (cachedb     #f)  ;; handle for the in memory copy
  (dbfile    #f)  ;; path to the db file on disk
  (dbfname   #f)  ;; short name of db file on disk (used to validate accessing correct db)
  (ondiskdb  #f)  ;; handle for the on-disk file
  (dbtmpname #f)  ;; path to db file in /tmp (non-imem method)
  (dbdat     #f)  ;; create a dbdat for the downstream calls such as db:with-db
grep   (last-update 0)  (sync-proc #f)

  )

;; NOTE: Need one dbr:subdb per main.db, 1.db ...
;;
(defstruct dbr:subdb
  (dbname      #f) ;; .mtdb/1.db
  (mtdbfile    #f) ;; mtrah/.mtdb/1.db
  (mtdbdat     #f) ;; only need one of these for syncing
  ;; (dbdats      (make-hash-table))  ;; id => dbdat 
  (tmpdbfile   #f) ;; /tmp/.../.mtdb/1.db
  (refndb      #f) ;; FIX THIS, IT SHOULD NOT BE REFERENCED!
  ;; (refndbfile  #f) ;; /tmp/.../.mtdb/1.db_ref
  (dbstack     (make-stack)) ;; stack for tmp dbr:dbdat,
  (homehost    #f) ;; not used yet
  (on-homehost #f) ;; not used yet
  (read-only   #f)
  (last-sync   0)
  (last-write  (current-seconds))

(declare (unit dbmod))
(declare (uses dbfile))
(declare (uses commonmod))
(declare (uses configfmod))
(declare (uses debugprint))
(declare (uses mtargs))
(declare (uses mtmod))

(module dbmod
	*
	
(import scheme)
	
(cond-expand
 (chicken-4
  (import chicken
	  data-structures
	  srfi-13
	  
	  debugprint
	  extras
	  files
	  (prefix mtargs args:)
	  posix
	  ports
	  csv-xml
	  
	  ))
 (chicken-5
  (import chicken.base
	  chicken.condition
	  chicken.file
	  chicken.pathname
	  chicken.process

  ))

(import	format
	(prefix sqlite3 sqlite3:)
	matchable
	typed-records
	regex
	s11n
	srfi-1
	srfi-18
	srfi-69
	z3
	(prefix base64 base64:)
	
	commonmod
	configfmod
	dbfile
	debugprint
	mtmod
	)

(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "run_records.scm")

(define *number-of-writes* 0)

;;======================================================================
;; Moved from dbfile
;;======================================================================

;; wait up to aprox n seconds for a journal to go away
;;































;;======================================================================
;; M E T A   G E T   A N D   S E T   V A R S
;;======================================================================

;; returns number if string->number is successful, string otherwise
;; also updates *global-delta*

       (if (and (null? incompleted)
                (null? oldlaunched)
                (null? toplevels))
           #f
           #t)))))
















































(define-inline (db:generic-error-printout exn . message)
  (print-call-chain (current-error-port))
  (apply debug:print-error 0 *default-log-port* message)
  (debug:print-error 0 *default-log-port* "   params: " params
		     ", error: "     ((condition-property-accessor 'exn 'message)   exn)
		     ", arguments: " ((condition-property-accessor 'exn 'arguments) exn)
		     ", location: "  ((condition-property-accessor 'exn 'location)  exn)

    last-update-time))


;; Open the classic megatest.db file (defaults to open in toppath)
;;
;;   NOTE: returns a dbdat not a dbstruct!
;;
(define (db:open-megatest-db dbpath #!key (launch-setup #f))
  (let* ((dbexists     (file-exists? dbpath))
	 (db           (db:lock-create-open dbpath
					    (lambda (db)
                                              (db:initialize-main-db db launch-setup: launch-setup))))
	 (write-access (file-write-access? dbpath)))
    (debug:print-info 13 *default-log-port* "db:open-megatest-db "dbpath)
    (if (and dbexists (not write-access))
	(set! *db-write-access* #f))
    ;; (cons db dbpath)))
    (make-dbr:dbdat dbfile: dbpath dbh: db read-only: (not write-access))))

      (debug:print 2 *default-log-port* "not doing cached calls right now"))
;;      (apply db:call-with-cached-db db-cmd params)
      (apply rmt-cmd params))
;;)

;; return the target db handle so it can be used
;;
(define (db:cache-for-read-only source target #!key (use-last-update #f)(launch-setup #f))
  (if (and (hash-table-ref/default *global-db-store* target #f)
	   (>= (file-modification-time target)(file-modification-time source)))
      (hash-table-ref *global-db-store* target)
      (let* ((toppath   (if *toppath*
			    *toppath*
			    (launch-setup)))
	     (targ-db-last-mod (db:get-sqlite3-mod-time target))
;;	      (if (common:file-exists? target)
;; BUG: This needs to include wal mode stuff .shm etc.
;;				   (file-modification-time target)
;;				   0))
	     (cache-db  (or (hash-table-ref/default *global-db-store* target #f)
			    (db:open-megatest-db path: target)))

;; Sync all changed db's
;;
(define (db:tmp->megatest.db-sync dbstruct run-id last-update)
  (let* ((subdbs (hash-table-values (dbr:dbstruct-subdbs dbstruct)))
	 (res    '()))
    (for-each
     (lambda (subdb)
       (let* ((mtdb   (dbr:subdb-mtdbdat subdb))
	      (tmpdb  (db:get-subdb dbstruct run-id))
	      (refndb (dbr:subdb-refndb subdb))
	      (newres (db:sync-tables (db:sync-all-tables-list (db:get-keys dbstruct)) last-update tmpdb refndb mtdb)))
	 ;; (stack-push! (dbr:subdb-dbstack subdb) tmpdb)
	 ;; BUG: verify this is really needed
	 (dbfile:add-dbdat dbstruct run-id tmpdb)
	 (set! res (cons newres res))))

      (if (common:low-noise-print 30 "sync new to old")
          (if sync-needed
              (debug:print-info 0 *default-log-port* "Sync of " res " records from newdb to olddb completed in " sync-time " seconds pid="(current-process-id))
              (debug:print-info 0 *default-log-port* "No sync needed, last updated " (- start-time last-update) " seconds ago")))
      res))


(define (db:initialize-main-db db #!key (launch-setup #f))
  (when (not *configinfo*)
    (if launch-setup
	(launch-setup) ;; added because Elena was getting stack dump because *configinfo* below was #f.
	(assert #f "db:initialize-main-db called and needs launch:setup but was not given it")))
  (let* ((configdat (car *configinfo*))  ;; tut tut, global warning...
	 (keys     (keys:config-get-fields configdat))
	 (havekeys (> (length keys) 0))
	 (keystr   (keys->keystr keys))
	 (fieldstr (keys:make-key/field-string configdat))
	 #;(db       (dbr:dbdat-dbh dbdat)))
    (for-each (lambda (key)

	(lambda (val)
	  (set! res val))
	db
	(conc "SELECT " key " FROM runs WHERE id=?;")
	run-id)
       res))))






















;; register a test run with the db, this accesses the main.db and does NOT
;; use server api
;;
(define (db:register-run dbstruct keyvals runname state status user contour-in)
  (let* ((keys      (map car keyvals))
	 (keystr    (keys->keystr keys))

	   (keystr   (string-intersperse keys ","))
	   (key?str  (string-intersperse (make-list (length targvals) "?") ","))
	   (qrystr   (conc "INSERT INTO runs (id,runname,"keystr") VALUES (?,?,"key?str")"))
	   (get-var  (lambda (db qrystr)
		       (let* ((res #f))
			 (sqlite3:for-each-row
			  (lambda row
			    (set! res (car row)))
			  db qrystr run-id runname)
			 res))))
      (if (null? runs)
        (begin
	  (db:create-initial-run-record dbstruct run-id runname target)
        )
      )

;; foo,bla,   1.2,  1.9, <
;; foo,bal,   1.2,  1.2, <   ,     ,Check for overload
;; foo,alb,   1.2,  1.2, <=  , Amps,This is the high power circuit test
;; foo,abl,   1.2,  1.3, 0.1
;; foo,bra,   1.2, pass, silly stuff
;; faz,bar,    10,  8mA,     ,     ,"this is a comment"
;; EOF

(define (tdb:get-prev-tol-for-test tdb test-id category variable)
  ;; Finish me?
  (values #f #f #f))

(define (db:csv->test-data dbstruct run-id test-id csvdata)
  (debug:print 4 *default-log-port* "test-id " test-id ", csvdata: " csvdata)
  (db:with-db
   dbstruct #f #t
   (lambda (dbdat db)
     (let* ((csvlist (csv->list (make-csv-reader

  (let* ((backcons        (lambda (lst item)(cons item lst)))
         (all_run_ids     (db:with-db dbstruct #f #f 
                            (lambda (dbdat db)
                              (sqlite3:fold-row backcons '() db "SELECT id FROM runs")))))

all_run_ids))




































































































































;;======================================================================
;; moving watch dogs here due to dependencies
;;======================================================================

;; =not-used= ;;======================================================================
;; =not-used= ;; currently the primary job of the watchdog is to run the sync back to megatest.db from the db in /tmp
;; =not-used= ;; if we are on the homehost and we are a server (by definition we are on the homehost if we are a server)
;; =not-used= ;;
;; =not-used= (define (common:readonly-watchdog dbstruct)
;; =not-used=   (thread-sleep! 0.05) ;; delay for startup
;; =not-used=   (debug:print-info 13 *default-log-port* "common:readonly-watchdog entered.")
;; =not-used=   ;; sync megatest.db to /tmp/.../megatst.db
;; =not-used=   (let* ((sync-cool-off-duration   3)
;; =not-used=         (golden-mtdb     (dbr:dbstruct-mtdb dbstruct))
;; =not-used=         (golden-mtpath   (db:dbdat-get-path golden-mtdb))
;; =not-used=         (tmp-mtdb        (dbr:dbstruct-tmpdb dbstruct))
;; =not-used=         (tmp-mtpath      (db:dbdat-get-path tmp-mtdb)))
;; =not-used=     (debug:print-info 0 *default-log-port* "Read-only periodic sync thread started.")
;; =not-used=     (let loop ((last-sync-time 0))
;; =not-used=       (debug:print-info 13 *default-log-port* "loop top tmp-mtpath="tmp-mtpath" golden-mtpath="golden-mtpath)
;; =not-used=       (let* ((duration-since-last-sync (- (current-seconds) last-sync-time)))
;; =not-used=         (debug:print-info 13 *default-log-port* "duration-since-last-sync="duration-since-last-sync)
;; =not-used=         (if (and (not *time-to-exit*)
;; =not-used=                  (< duration-since-last-sync sync-cool-off-duration))
;; =not-used=             (thread-sleep! (- sync-cool-off-duration duration-since-last-sync)))
;; =not-used=         (if (not *time-to-exit*)
;; =not-used=             (let ((golden-mtdb-mtime (file-modification-time golden-mtpath))
;; =not-used=                   (tmp-mtdb-mtime    (file-modification-time tmp-mtpath)))
;; =not-used= 	      (if (> golden-mtdb-mtime tmp-mtdb-mtime)
;; =not-used= 		  (if (< golden-mtdb-mtime (- (current-seconds) 3)) ;; file has NOT been touched in past three seconds, this way multiple servers won't fight to sync back
;; =not-used= 		      (let ((res (db:multi-db-sync dbstruct 'old2new)))
;; =not-used= 			(debug:print-info 13 *default-log-port* "rosync called, " res " records transferred."))))
;; =not-used=               (loop (current-seconds)))
;; =not-used=             #t)))
;; =not-used=     (debug:print-info 0 *default-log-port* "Exiting readonly-watchdog timer, *time-to-exit* = " *time-to-exit*" pid="(current-process-id)" mtpath="golden-mtpath)))
;; =not-used= 

;; Get a lock from the no-sync-db for the from-db, then copy the from-db to the to-db, otherwise return #f

(define (db:lock-and-sync no-sync-db from-db to-db)
  (assert (not *db-sync-in-progress*) "FATAL: db:lock-and-sync called while a sync is in progress.")
  (let* ((lockdat  (db:no-sync-get-lock no-sync-db from-db))
	 (gotlock  (car lockdat))

	       (debug:print-info 0 *default-log-port* "sync copy file: " fname", delta: " (- time1 time2) " seconds")
	       (db:lock-and-sync no-sync-db file fulln)
	       (hash-table-set! sync-durations (conc fname".db") (- (current-milliseconds) start-time)))
	     #;(debug:print-info 0 *default-log-port* "skipping sync..."))))
     dbfiles)
    (hash-table->alist sync-durations)))

;; =not-used= ;; straight forward copy based sync
;; =not-used= ;;  1. for each .db fil
;; =not-used= ;;  2. next if file changed since last sync cycle
;; =not-used= ;;  2. next if time delta /tmp file to MTRA less than 3 seconds
;; =not-used= ;;  3. get a lock for the file in nosyncdb
;; =not-used= ;;  4. copy the file
;; =not-used= ;;  5. when copy is done release the lock
;; =not-used= ;;
;; =not-used= ;;  DONE
;; =not-used= (define (server:writable-watchdog-copysync dbstruct)
;; =not-used=   (thread-sleep! 0.05) ;; delay for startup
;; =not-used=   (let ((legacy-sync        (common:run-sync?))
;; =not-used= 	(sync-stale-seconds (configf:lookup-number *configdat* "server" "sync-stale-seconds" default: 300))
;; =not-used=  	(debug-mode         (debug:debug-mode 1))
;; =not-used=  	(last-time          (current-seconds))     ;; last time through the sync loop
;; =not-used=  	(no-sync-db         (db:open-no-sync-db))
;; =not-used=  	(sync-duration      0)  ;; run time of the sync in milliseconds
;; =not-used= 	(tmp-area           (common:make-tmpdir-name *toppath* "")))
;; =not-used=     ;; Sync moved to http-transport keep-running loop
;; =not-used=     (debug:print-info 2 *default-log-port* "Periodic copy-based sync thread started. syncer is copy-sync, tmp-area is " tmp-area)
;; =not-used=     (debug:print-info 3 *default-log-port* "watchdog starting. syncer is copy-sync pid="(current-process-id));;  " this-wd-num="this-wd-num)
;; =not-used=     
;; =not-used=     (if (and legacy-sync (not *time-to-exit*))
;; =not-used=  	(begin
;; =not-used=  	  (debug:print-info 0 *default-log-port* "Server running, periodic copy-based sync started.")
;; =not-used= 	  (let loop ()
;; =not-used= 
;; =not-used= 	    ;; run the sync and print out durations
;; =not-used= 	    (debug:print-info 0 *default-log-port* "Sync durations: "(db:run-lock-and-sync no-sync-db))
;; =not-used= 	    ;; keep going unless time to exit
;; =not-used= 	    ;;
;; =not-used= 	    (if (not *time-to-exit*)
;; =not-used= 		(let delay-loop ((count 0))
;; =not-used= 		  ;;(debug:print-info 13 *default-log-port* "delay-loop top; count="count" pid="(current-process-id)" this-wd-num="this-wd-num" *time-to-exit*="*time-to-exit*)
;; =not-used= 		  
;; =not-used= 		  (if (and (not *time-to-exit*)
;; =not-used= 			   (< count 6)) ;; was 11, changing to 4. 
;; =not-used= 		      (begin
;; =not-used= 			(thread-sleep! 1)
;; =not-used= 			(delay-loop (+ count 1))))
;; =not-used= 		  (if (not *time-to-exit*) (loop))))
;; =not-used= 	    
;; =not-used= 	    ;; ==> 	       ;; time to exit, close the no-sync db here
;; =not-used= 	    ;; ==> 	       (db:no-sync-close-db no-sync-db stmt-cache)
;; =not-used= 	    (if (common:low-noise-print 30)
;; =not-used= 		(debug:print-info 0 *default-log-port* "Exiting watchdog timer, *time-to-exit* = "
;; =not-used= 				  *time-to-exit*" pid="(current-process-id) )))))))


;; =not-used= (define (server:writable-watchdog-deltasync dbstruct)
;; =not-used=   ;; This is awful complex and convoluted. Plan to redo?
;; =not-used=   ;; for now ... skip it.
;; =not-used=  
;; =not-used=   (thread-sleep! 0.05) ;; delay for startup
;; =not-used=   (let ((legacy-sync  (common:run-sync?)))
;; =not-used=        (sync-stale-seconds (configf:lookup-number *configdat* "server" "sync-stale-seconds" default: 300))
;; =not-used=  	(debug-mode   (debug:debug-mode 1))
;; =not-used=  	(last-time    (current-seconds))
;; =not-used=  	(no-sync-db   (db:open-no-sync-db))
;; =not-used=  	(stmt-cache   #f) ;; (dbr:dbstruct-stmt-cache dbstruct))
;; =not-used=  	(sync-duration 0) ;; run time of the sync in milliseconds
;; =not-used=        (subdbs       (hash-table-values (dbr:dbstruct-subdbs dbstruct))))
;; =not-used=    (debug:print-info 2 *default-log-port* "Periodic sync thread started.")
;; =not-used=    (debug:print-info 3 *default-log-port* "watchdog starting. legacy-sync is " legacy-sync" pid="(current-process-id)  );;  " this-wd-num="this-wd-num)
;; =not-used=    
;; =not-used=    (if (and legacy-sync (not *time-to-exit*))
;; =not-used=  	(begin
;; =not-used=  	  (debug:print-info 0 *default-log-port* "Server running, periodic sync started.")
;; =not-used= 	  (let loop ()
;; =not-used=  	    ;; sync for filesystem local db writes
;; =not-used=  	    ;;
;; =not-used=  	    (mutex-lock! *db-multi-sync-mutex*)
;; =not-used=  	       (let* ((start-file (conc tmp-area "/.start-sync"))
;; =not-used=  		      (end-file   (conc tmp-area "/.end-sync"))
;; =not-used=  			      
;; =not-used=  		      (need-sync        (>= *db-last-access* *db-last-sync*)) ;; no sync since last write
;; =not-used=  		      (sync-in-progress *db-sync-in-progress*)
;; =not-used=  		      (min-intersync-delay (configf:lookup-number *configdat* "server" "minimum-intersync-delay" default: 5))
;; =not-used=  		      (should-sync      (and (not *time-to-exit*)
;; =not-used=  					     (> (- (current-seconds) *db-last-sync*) min-intersync-delay))) ;; sync every five seconds minimum, deprecated logic, can probably be removed
;; =not-used=  		      (start-time       (current-seconds))
;; =not-used=  		      (cpu-load-adj     (alist-ref 'adj-proc-load (common:get-normalized-cpu-load #f)))
;; =not-used=  		      (mt-mod-time      (file-modification-time mtpath))
;; =not-used=  		      (last-sync-start  (if (common:file-exists? start-file)
;; =not-used=  					    (file-modification-time start-file)
;; =not-used=  					    0))
;; =not-used=  		      (last-sync-end    (if (common:file-exists? end-file)
;; =not-used=  					    (file-modification-time end-file)
;; =not-used=  					    10))
;; =not-used=  		      (sync-period      (+ 3 (* cpu-load-adj 30))) ;; as adjusted load increases increase the sync period
;; =not-used=  		      (recently-synced  (and (< (- start-time mt-mod-time) sync-period) ;; not useful if sync didn't modify megatest.db!
;; =not-used=  					     (< mt-mod-time last-sync-start)))
;; =not-used=  		      (sync-done        (<= last-sync-start last-sync-end))
;; =not-used=  		      (sync-stale       (> start-time (+ last-sync-start sync-stale-seconds)))
;; =not-used=  		      (will-sync        (and (not *time-to-exit*)       ;; do not start a sync if we are in the process of exiting
;; =not-used=  					     (or need-sync should-sync)
;; =not-used=  					     (or sync-done sync-stale)
;; =not-used=  					     (not sync-in-progress)
;; =not-used=  					     (not recently-synced))))
;; =not-used=  		 (debug:print-info 13 *default-log-port* "WD writable-watchdog top of loop.  need-sync="need-sync" sync-in-progress=" sync-in-progress
;; =not-used=  				   " should-sync="should-sync" start-time="start-time" mt-mod-time="mt-mod-time" recently-synced="recently-synced" will-sync="will-sync
;; =not-used=  				   " sync-done=" sync-done " sync-period=" sync-period)
;; =not-used=  		 (if (and (> sync-period 5)
;; =not-used=  			  (common:low-noise-print 30 "sync-period"))
;; =not-used=  		     (debug:print-info 0 *default-log-port* "Increased sync period due to long sync times, sync took: " sync-period " seconds."))
;; =not-used=  		 ;; (if recently-synced (debug:print-info 0 *default-log-port* "Skipping sync due to recently-synced flag=" recently-synced))
;; =not-used=  		 ;; (debug:print-info 0 *default-log-port* "need-sync: " need-sync " sync-in-progress: " sync-in-progress " should-sync: " should-sync " will-sync: " will-sync)
;; =not-used=  		 (if will-sync (set! *db-sync-in-progress* #t))
;; =not-used=  		 (mutex-unlock! *db-multi-sync-mutex*)
;; =not-used=  		 (if will-sync
;; =not-used=  		     (let (;; (max-sync-duration  (configf:lookup-number *configdat* "server" "max-sync-duration")) ;; KEEPING THIS AVAILABLE BUT SHOULD NOT USE, I'M PRETTY SURE IT DOES NOT WORK!
;; =not-used=  			   (sync-start         (current-milliseconds)))
;; =not-used=  		       (with-output-to-file start-file (lambda ()(print (current-process-id))))
;; =not-used=  		       
;; =not-used=  		       ;; put lock here
;; =not-used=  		       
;; =not-used=  		       ;; (if (or (not max-sync-duration)
;; =not-used=  		       ;;        (< sync-duration max-sync-duration)) ;; NOTE: db:sync-to-megatest.db keeps track of time of last sync and syncs incrementally
;; =not-used=  
;; =not-used=  		      ;;
;; =not-used=  		     
;; =not-used=  		       (for-each
;; =not-used=  			(lambda (subdb)
;; =not-used=  			  (let* (;;(dbstruct (db:setup))
;; =not-used=  				 (mtdb       (dbr:subdb-mtdbdat subdb))
;; =not-used=  				 (mtdb       (dbr:subdb-mtdbdat subdb))
;; =not-used=  				 (mtpath     (db:dbdat-get-path mtdb))
;; =not-used=  				 (tmp-area   (common:make-tmpdir-name *toppath* ""))
;; =not-used=  				 (res        (db:sync-to-megatest.db dbstruct no-sync-db: no-sync-db))) ;; did we sync any data? If so need to set the db touched flag to keep the server alive
;; =not-used=  			    (set! sync-duration (- (current-milliseconds) sync-start))
;; =not-used=  			    (if (> res 0) ;; some records were transferred, keep the db alive
;; =not-used=  				(begin
;; =not-used=  				  (mutex-lock! *heartbeat-mutex*)
;; =not-used=  				  (set! *db-last-access* (current-seconds))
;; =not-used=  				  (mutex-unlock! *heartbeat-mutex*)
;; =not-used=  				  (debug:print-info 0 *default-log-port* "sync called, " res " records transferred."))
;; =not-used=  				(debug:print-info 2 *default-log-port* "sync called but zero records transferred")))

;; =not-used=  			  )
;; =not-used=  			subdbs)))
;; =not-used=  		 
;; =not-used=  		 (if will-sync
;; =not-used=  		     (begin
;; =not-used=  		       (mutex-lock! *db-multi-sync-mutex*)
;; =not-used=  		       (set! *db-sync-in-progress* #f)
;; =not-used=  		       (set! *db-last-sync* start-time)
;; =not-used=  		       (with-output-to-file end-file (lambda ()(print (current-process-id))))
;; =not-used=  		       
;; =not-used=  		       ;; release lock here
;; =not-used=  		       
;; =not-used=  		       (mutex-unlock! *db-multi-sync-mutex*)))
;; =not-used=  		 (if (and debug-mode
;; =not-used=  			  (> (- start-time last-time) 60))
;; =not-used=  		     (begin
;; =not-used=  		       (set! last-time start-time)
;; =not-used=  		       (debug:print-info 4 *default-log-port* "timestamp -> " (seconds->time-string (current-seconds)) ", time since start -> " (seconds->hr-min-sec (- (current-seconds) *time-zero*))))))
;; =not-used=  	       
;; =not-used= 	       ;; keep going unless time to exit
;; =not-used= 	       ;;
;; =not-used= 	       (if (not *time-to-exit*)
;; =not-used= 		   (let delay-loop ((count 0))
;; =not-used= 		     ;;(debug:print-info 13 *default-log-port* "delay-loop top; count="count" pid="(current-process-id)" this-wd-num="this-wd-num" *time-to-exit*="*time-to-exit*)
;; =not-used= 		     
;; =not-used= 		     (if (and (not *time-to-exit*)
;; =not-used= 			      (< count 6)) ;; was 11, changing to 4. 
;; =not-used= 			 (begin
;; =not-used= 			   (thread-sleep! 1)
;; =not-used= 			   (delay-loop (+ count 1))))
;; =not-used= 		     (if (not *time-to-exit*) (loop))))
;; =not-used= 	       
;; =not-used= ;; 	       ;; time to exit, close the no-sync db here
;; =not-used= ;; 	       (db:no-sync-close-db no-sync-db stmt-cache)
;; =not-used= 	       (if (common:low-noise-print 30)
;; =not-used= 		   (debug:print-info 0 *default-log-port* "Exiting watchdog timer, *time-to-exit* = " *time-to-exit*" pid="(current-process-id) )))) 
;; =not-used= ))

(define (std-exit-procedure)
  ;;(common:telemetry-log-close)
  (on-exit (lambda () 0)) ;; why is this here?
  ;;(debug:print-info 13 *default-log-port* "std-exit-procedure called; *time-to-exit*="*time-to-exit*)
  (let ((no-hurry  (if *time-to-exit* ;; hurry up
		       #f

				       (sqlite3:database? *no-sync-db*))
				  (sqlite3:finalize! *no-sync-db* #t))
			      (if (and (not (args:get-arg "-server"))
				       *runremote*
				       (eq? (rmt:transport-mode) 'http))
				  (begin
				    (debug:print-info 0 *default-log-port* "Closing all client connections...")
				    
				    ;; (http-transport:close-connections *runremote*) ;; <== no definition for this
				    
				    #;(http-client#close-all-connections!)))
                              ;; (if (and *runremote*
                              ;;          (remote-conndat *runremote*))
                              ;;     (begin
                              ;;       (http-client#close-all-connections!))) ;; for http-client
                              (if (not (eq? *default-log-port* (current-error-port)))
                                  (close-output-port *default-log-port*))

      (thread-start! th2)
      (thread-join! th1)
      )
    )

  0)

;; open an sql database inside a file lock
;; returns: db existed-prior-to-opening
;; RA => Returns a db handler; sets the lock if opened in writable mode
;;
;; (define *db-open-mutex* (make-mutex))
;;
(define (db:lock-create-open fname initproc)
  (let* ((parent-dir   (or (pathname-directory fname)(current-directory))) ;; no parent? go local
         (raw-fname    (pathname-file fname))
	 (dir-writable (file-write-access? parent-dir))
	 (file-exists  (common:file-exists? fname))
	 (file-write   (if file-exists
			   (file-write-access? fname)
			   dir-writable )))
    ;; (mutex-lock! *db-open-mutex*) ;; tried this mutex, not clear it helped.
    (if file-write ;; dir-writable
	(condition-case
         (let* ((lockfname   (conc fname ".lock"))
                (readyfname  (conc parent-dir "/.ready-" raw-fname))
                (readyexists (common:file-exists? readyfname)))
           (if (not readyexists)
               (common:simple-file-lock-and-wait lockfname))
           (let ((db      (sqlite3:open-database fname)))
             (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))
             (sqlite3:execute db "PRAGMA synchronous = 0;")
             (if (and (configf:lookup *configdat* "setup" "tmp_mode") (string-match "^/tmp/.*" fname))
                 (begin
                   ;;(print "DEBUG: Setting tmp_mode for " fname) 
                   (sqlite3:execute db (configf:lookup *configdat* "setup" "tmp_mode"))
                   )
                 )  
             (if (and (configf:lookup *configdat* "setup" "nfs_mode") (not (string-match "^/tmp/.*" fname)))
                 (begin
                   ;;(print "DEBUG: Setting nfs_mode for " fname)
                   (sqlite3:execute db (configf:lookup *configdat* "setup" "nfs_mode"))
                   )
                 )  
             (if (and (not (or (configf:lookup *configdat* "setup" "tmp_mode") (configf:lookup *configdat* "setup" "nfs_mode")))  
                      (configf:lookup *configdat* "setup" "use-wal")
                      (string-match "^/tmp/.*" fname)) ;; this is a file in /tmp
                 (sqlite3:execute db "PRAGMA journal_mode=WAL;")
                 (debug:print 2 *default-log-port* "Creating " fname " in NON-WAL mode."))
             (if (not file-exists)
                 (initproc db))
             (if (not readyexists)
                 (begin
                   (common:simple-file-release-lock lockfname)
                   (with-output-to-file
                       readyfname
                     (lambda ()
                       (print "Ready at " 
                              (seconds->year-work-week/day-time 
                               (current-seconds)))))))
             db))
         (exn (io-error)  (debug:print 0 *default-log-port* "ERROR: i/o error with " fname ". Check permissions, disk space etc. and try again."))
         (exn (corrupt)   (debug:print 0 *default-log-port* "ERROR: database " fname " is corrupt. Repair it to proceed."))
         (exn (busy)      (debug:print 0 *default-log-port* "ERROR: database " fname " is locked. Try copying to another location, remove original and copy back."))
         (exn (permission)(debug:print 0 *default-log-port* "ERROR: database " fname " has some permissions problem."))
         (exn () (debug:print 0 *default-log-port* "ERROR: Unknown error with database " fname " message: " ((condition-property-accessor 'exn 'message) exn))))
        
	(condition-case
         (begin
           (debug:print 2 *default-log-port* "WARNING: opening db in non-writable dir " fname)
           (let ((db (sqlite3:open-database fname)))
             (sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))
             (sqlite3:execute db "PRAGMA synchronous = 0;")
	     ;; (mutex-unlock! *db-open-mutex*)
             db))
         (exn (io-error)  (debug:print 0 *default-log-port* "ERROR: i/o error with " fname ". Check permissions, disk space etc. and try again."))
         (exn (corrupt)   (debug:print 0 *default-log-port* "ERROR: database " fname " is corrupt. Repair it to proceed."))
         (exn (busy)      (debug:print 0 *default-log-port* "ERROR: database " fname " is locked. Try copying to another location, remove original and copy back."))
         (exn (permission)(debug:print 0 *default-log-port* "ERROR: database " fname " has some permissions problem."))
         (exn () (debug:print 0 *default-log-port* "ERROR: Unknown error with database " fname " message: " ((condition-property-accessor 'exn 'message) exn))))
	)))


;; traps to catch usage of functions that need to be tracked down

(define (db:get-subdb . params)
  (assert #f "FATAL: Call to db:get-subdb - needs to be fixed."))

)

(import (prefix sqlite3 sqlite3:)
	(prefix mtargs args:))

(import commonmod
	configfmod
	debugprint)

	  debugprint
  )))

(define (common:get-fields cfgdat)
  (let ((fields (hash-table-ref/default cfgdat "fields" '())))
    (map car fields)))

;;======================================================================
;; stuff from keys that can't be in commonmod. Maybe move all from commonmod to here?
;;======================================================================

(define (keys:make-key/field-string confdat)
  (let ((fields (configf:get-section confdat "fields")))
    (string-join
     (map (lambda (field)(conc (car field) " " (cadr field)))
	  fields)
     ",")))

(define keys:config-get-fields common:get-fields)

;;======================================================================
;; testsuite and area utilites
;;======================================================================

(define (get-testsuite-name toppath configdat)
  (or (lookup configdat "setup" "area-name")

(use csv-xml regex)
(declare (unit ods))
(declare (uses common))
(declare (uses commonmod))
(import commonmod)

;; Copyright 2011, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;

(use csv-xml regex)
(declare (unit ods))
(declare (uses common))
(declare (uses commonmod))
(import commonmod)

(module odsmod
	*
	
(define ods:dirs
  '("Configurations2"
    "Configurations2/toolpanel"
    "Configurations2/menubar"
    "Configurations2/toolbar"
    "Configurations2/progressbar"
    "Configurations2/floater"
    "Configurations2/images"
    "Configurations2/images/Bitmaps"
    "Configurations2/statusbar"
    "Configurations2/popupmenu"
    "Configurations2/accelerator"
    "META-INF"
    "Thumbnails"))

(define ods:0-len-files
  '("Configurations2/accelerator/current.xml"
    ;; "Thumbnails/thumbnail.png"
    "content.xml"
    ))

(define ods:files
  '(("META-INF/manifest.xml"
     ("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
      "<manifest:manifest xmlns:manifest=\"urn:oasis:names:tc:opendocument:xmlns:manifest:1.0\">\n"
      "<manifest:file-entry manifest:media-type=\"application/vnd.oasis.opendocument.spreadsheet\" manifest:version=\"1.2\" manifest:full-path=\"/\"/>\n"
      "<manifest:file-entry manifest:media-type=\"\" manifest:full-path=\"Configurations2/statusbar/\"/>\n"
      "<manifest:file-entry manifest:media-type=\"\" manifest:full-path=\"Configurations2/accelerator/current.xml\"/>\n"
      "<manifest:file-entry manifest:media-type=\"\" manifest:full-path=\"Configurations2/accelerator/\"/>\n"
      "<manifest:file-entry manifest:media-type=\"\" manifest:full-path=\"Configurations2/floater/\"/>\n"
      "<manifest:file-entry manifest:media-type=\"\" manifest:full-path=\"Configurations2/popupmenu/\"/>\n"
      "<manifest:file-entry manifest:media-type=\"\" manifest:full-path=\"Configurations2/progressbar/\"/>\n"
      "<manifest:file-entry manifest:media-type=\"\" manifest:full-path=\"Configurations2/toolpanel/\"/>\n"
      "<manifest:file-entry manifest:media-type=\"\" manifest:full-path=\"Configurations2/menubar/\"/>\n"
      "<manifest:file-entry manifest:media-type=\"\" manifest:full-path=\"Configurations2/toolbar/\"/>\n"
      "<manifest:file-entry manifest:media-type=\"\" manifest:full-path=\"Configurations2/images/Bitmaps/\"/>\n"
      "<manifest:file-entry manifest:media-type=\"\" manifest:full-path=\"Configurations2/images/\"/>\n"
      "<manifest:file-entry manifest:media-type=\"application/vnd.sun.xml.ui.configuration\" manifest:full-path=\"Configurations2/\"/>\n"
      "<manifest:file-entry manifest:media-type=\"text/xml\" manifest:full-path=\"content.xml\"/>\n"
      "<manifest:file-entry manifest:media-type=\"text/xml\" manifest:full-path=\"styles.xml\"/>\n"
      "<manifest:file-entry manifest:media-type=\"text/xml\" manifest:full-path=\"meta.xml\"/>\n"
      "<manifest:file-entry manifest:media-type=\"image/png\" manifest:full-path=\"Thumbnails/thumbnail.png\"/>\n"
      "<manifest:file-entry manifest:media-type=\"\" manifest:full-path=\"Thumbnails/\"/>\n"
      "<manifest:file-entry manifest:media-type=\"text/xml\" manifest:full-path=\"settings.xml\"/>\n"
      "</manifest:manifest>\n"))
    ("styles.xml"
     ("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
      "<office:document-styles xmlns:office=\"urn:oasis:names:tc:opendocument:xmlns:office:1.0\" xmlns:style=\"urn:oasis:names:tc:opendocument:xmlns:style:1.0\" xmlns:text=\"urn:oasis:names:tc:opendocument:xmlns:text:1.0\" xmlns:table=\"urn:oasis:names:tc:opendocument:xmlns:table:1.0\" xmlns:draw=\"urn:oasis:names:tc:opendocument:xmlns:drawing:1.0\" xmlns:fo=\"urn:oasis:names:tc:opendocument:xmlns:xsl-fo-compatible:1.0\" xmlns:xlink=\"http://www.w3.org/1999/xlink\" xmlns:dc=\"http://purl.org/dc/elements/1.1/\" xmlns:meta=\"urn:oasis:names:tc:opendocument:xmlns:meta:1.0\" xmlns:number=\"urn:oasis:names:tc:opendocument:xmlns:datastyle:1.0\" xmlns:presentation=\"urn:oasis:names:tc:opendocument:xmlns:presentation:1.0\" xmlns:svg=\"urn:oasis:names:tc:opendocument:xmlns:svg-compatible:1.0\" xmlns:chart=\"urn:oasis:names:tc:opendocument:xmlns:chart:1.0\" xmlns:dr3d=\"urn:oasis:names:tc:opendocument:xmlns:dr3d:1.0\" xmlns:math=\"http://www.w3.org/1998/Math/MathML\" xmlns:form=\"urn:oasis:names:tc:opendocument:xmlns:form:1.0\" xmlns:script=\"urn:oasis:names:tc:opendocument:xmlns:script:1.0\" xmlns:ooo=\"http://openoffice.org/2004/office\" xmlns:ooow=\"http://openoffice.org/2004/writer\" xmlns:oooc=\"http://openoffice.org/2004/calc\" xmlns:dom=\"http://www.w3.org/2001/xml-events\" xmlns:rpt=\"http://openoffice.org/2005/report\" xmlns:of=\"urn:oasis:names:tc:opendocument:xmlns:of:1.2\" xmlns:xhtml=\"http://www.w3.org/1999/xhtml\" xmlns:grddl=\"http://www.w3.org/2003/g/data-view#\" xmlns:tableooo=\"http://openoffice.org/2009/table\" xmlns:css3t=\"http://www.w3.org/TR/css3-text/\" office:version=\"1.2\" grddl:transformation=\"http://docs.oasis-open.org/office/1.2/xslt/odf2rdf.xsl\"><office:font-face-decls><style:font-face style:name=\"Arial\" svg:font-family=\"Arial\" style:font-family-generic=\"swiss\" style:font-pitch=\"variable\"/><style:font-face style:name=\"DejaVu Sans\" svg:font-family=\"&apos;DejaVu Sans&apos;\" style:font-family-generic=\"system\" style:font-pitch=\"variable\"/><style:font-face style:name=\"Droid Sans Fallback\" svg:font-family=\"&apos;Droid Sans Fallback&apos;\" style:font-family-generic=\"system\" style:font-pitch=\"variable\"/><style:font-face style:name=\"Lohit Hindi\" svg:font-family=\"&apos;Lohit Hindi&apos;\" style:font-family-generic=\"system\" style:font-pitch=\"variable\"/></office:font-face-decls><office:styles><style:default-style style:family=\"table-cell\"><style:paragraph-properties style:tab-stop-distance=\"0.5in\"/><style:text-properties style:font-name=\"Arial\" fo:language=\"en\" fo:country=\"US\" style:font-name-asian=\"DejaVu Sans\" style:language-asian=\"zh\" style:country-asian=\"CN\" style:font-name-complex=\"DejaVu Sans\" style:language-complex=\"hi\" style:country-complex=\"IN\"/></style:default-style><number:number-style style:name=\"N0\"><number:number number:min-integer-digits=\"1\"/></number:number-style><number:currency-style style:name=\"N104P0\" style:volatile=\"true\"><number:currency-symbol number:language=\"en\" number:country=\"US\">$</number:currency-symbol><number:number number:decimal-places=\"2\" number:min-integer-digits=\"1\" number:grouping=\"true\"/></number:currency-style><number:currency-style style:name=\"N104\"><style:text-properties fo:color=\"#ff0000\"/><number:text>-</number:text><number:currency-symbol number:language=\"en\" number:country=\"US\">$</number:currency-symbol><number:number number:decimal-places=\"2\" number:min-integer-digits=\"1\" number:grouping=\"true\"/><style:map style:condition=\"value()&gt;=0\" style:apply-style-name=\"N104P0\"/></number:currency-style><style:style style:name=\"Default\" style:family=\"table-cell\"><style:text-properties style:font-name-asian=\"Droid Sans Fallback\" style:font-name-complex=\"Lohit Hindi\"/></style:style><style:style style:name=\"Result\" style:family=\"table-cell\" style:parent-style-name=\"Default\"><style:text-properties fo:font-style=\"italic\" style:text-underline-style=\"solid\" style:text-underline-width=\"auto\" style:text-underline-color=\"font-color\" fo:font-weight=\"bold\"/></style:style><style:style style:name=\"Result2\" style:family=\"table-cell\" style:parent-style-name=\"Result\" style:data-style-name=\"N104\"/><style:style style:name=\"Heading\" style:family=\"table-cell\" style:parent-style-name=\"Default\"><style:table-cell-properties style:text-align-source=\"fix\" style:repeat-content=\"false\"/><style:paragraph-properties fo:text-align=\"center\"/><style:text-properties fo:font-size=\"16pt\" fo:font-style=\"italic\" fo:font-weight=\"bold\"/></style:style><style:style style:name=\"Heading1\" style:family=\"table-cell\" style:parent-style-name=\"Heading\"><style:table-cell-properties style:rotation-angle=\"90\"/></style:style></office:styles><office:automatic-styles><style:page-layout style:name=\"Mpm1\"><style:page-layout-properties style:writing-mode=\"lr-tb\"/><style:header-style><style:header-footer-properties fo:min-height=\"0.2957in\" fo:margin-left=\"0in\" fo:margin-right=\"0in\" fo:margin-bottom=\"0.0984in\"/></style:header-style><style:footer-style><style:header-footer-properties fo:min-height=\"0.2957in\" fo:margin-left=\"0in\" fo:margin-right=\"0in\" fo:margin-top=\"0.0984in\"/></style:footer-style></style:page-layout><style:page-layout style:name=\"Mpm2\"><style:page-layout-properties style:writing-mode=\"lr-tb\"/><style:header-style><style:header-footer-properties fo:min-height=\"0.2957in\" fo:margin-left=\"0in\" fo:margin-right=\"0in\" fo:margin-bottom=\"0.0984in\" fo:border=\"0.0346in solid #000000\" fo:padding=\"0.0071in\" fo:background-color=\"#c0c0c0\"><style:background-image/></style:header-footer-properties></style:header-style><style:footer-style><style:header-footer-properties fo:min-height=\"0.2957in\" fo:margin-left=\"0in\" fo:margin-right=\"0in\" fo:margin-top=\"0.0984in\" fo:border=\"0.0346in solid #000000\" fo:padding=\"0.0071in\" fo:background-color=\"#c0c0c0\"><style:background-image/></style:header-footer-properties></style:footer-style></style:page-layout></office:automatic-styles><office:master-styles><style:master-page style:name=\"Default\" style:page-layout-name=\"Mpm1\"><style:header><text:p><text:sheet-name>???</text:sheet-name></text:p></style:header><style:header-left style:display=\"false\"/><style:footer><text:p>Page <text:page-number>1</text:page-number></text:p></style:footer><style:footer-left style:display=\"false\"/></style:master-page><style:master-page style:name=\"Report\" style:page-layout-name=\"Mpm2\"><style:header><style:region-left><text:p><text:sheet-name>???</text:sheet-name> (<text:title>???</text:title>)</text:p></style:region-left><style:region-right><text:p><text:date style:data-style-name=\"N2\" text:date-value=\"2011-09-06\">09/06/2011</text:date>, <text:time>20:48:51</text:time></text:p></style:region-right></style:header><style:header-left style:display=\"false\"/><style:footer><text:p>Page <text:page-number>1</text:page-number> / <text:page-count>99</text:page-count></text:p></style:footer><style:footer-left style:display=\"false\"/></style:master-page></office:master-styles></office:document-styles>\n"))
    ("settings.xml"
     ("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
      "<office:document-settings xmlns:office=\"urn:oasis:names:tc:opendocument:xmlns:office:1.0\" xmlns:xlink=\"http://www.w3.org/1999/xlink\" xmlns:config=\"urn:oasis:names:tc:opendocument:xmlns:config:1.0\" xmlns:ooo=\"http://openoffice.org/2004/office\" office:version=\"1.2\"><office:settings><config:config-item-set config:name=\"ooo:view-settings\"><config:config-item config:name=\"VisibleAreaTop\" config:type=\"int\">0</config:config-item><config:config-item config:name=\"VisibleAreaLeft\" config:type=\"int\">0</config:config-item><config:config-item config:name=\"VisibleAreaWidth\" config:type=\"int\">4516</config:config-item><config:config-item config:name=\"VisibleAreaHeight\" config:type=\"int\">1799</config:config-item><config:config-item-map-indexed config:name=\"Views\"><config:config-item-map-entry><config:config-item config:name=\"ViewId\" config:type=\"string\">view1</config:config-item><config:config-item-map-named config:name=\"Tables\"><config:config-item-map-entry config:name=\"Sheet1\"><config:config-item config:name=\"CursorPositionX\" config:type=\"int\">0</config:config-item><config:config-item config:name=\"CursorPositionY\" config:type=\"int\">0</config:config-item><config:config-item config:name=\"HorizontalSplitMode\" config:type=\"short\">0</config:config-item><config:config-item config:name=\"VerticalSplitMode\" config:type=\"short\">0</config:config-item><config:config-item config:name=\"HorizontalSplitPosition\" config:type=\"int\">0</config:config-item><config:config-item config:name=\"VerticalSplitPosition\" config:type=\"int\">0</config:config-item><config:config-item config:name=\"ActiveSplitRange\" config:type=\"short\">2</config:config-item><config:config-item config:name=\"PositionLeft\" config:type=\"int\">0</config:config-item><config:config-item config:name=\"PositionRight\" config:type=\"int\">0</config:config-item><config:config-item config:name=\"PositionTop\" config:type=\"int\">0</config:config-item><config:config-item config:name=\"PositionBottom\" config:type=\"int\">0</config:config-item><config:config-item config:name=\"ZoomType\" config:type=\"short\">0</config:config-item><config:config-item config:name=\"ZoomValue\" config:type=\"int\">100</config:config-item><config:config-item config:name=\"PageViewZoomValue\" config:type=\"int\">60</config:config-item><config:config-item config:name=\"ShowGrid\" config:type=\"boolean\">true</config:config-item></config:config-item-map-entry><config:config-item-map-entry config:name=\"Sheet2\"><config:config-item config:name=\"CursorPositionX\" config:type=\"int\">0</config:config-item><config:config-item config:name=\"CursorPositionY\" config:type=\"int\">4</config:config-item><config:config-item config:name=\"HorizontalSplitMode\" config:type=\"short\">0</config:config-item><config:config-item config:name=\"VerticalSplitMode\" config:type=\"short\">0</config:config-item><config:config-item config:name=\"HorizontalSplitPosition\" config:type=\"int\">0</config:config-item><config:config-item config:name=\"VerticalSplitPosition\" config:type=\"int\">0</config:config-item><config:config-item config:name=\"ActiveSplitRange\" config:type=\"short\">2</config:config-item><config:config-item config:name=\"PositionLeft\" config:type=\"int\">0</config:config-item><config:config-item config:name=\"PositionRight\" config:type=\"int\">0</config:config-item><config:config-item config:name=\"PositionTop\" config:type=\"int\">0</config:config-item><config:config-item config:name=\"PositionBottom\" config:type=\"int\">0</config:config-item><config:config-item config:name=\"ZoomType\" config:type=\"short\">0</config:config-item><config:config-item config:name=\"ZoomValue\" config:type=\"int\">100</config:config-item><config:config-item config:name=\"PageViewZoomValue\" config:type=\"int\">60</config:config-item><config:config-item config:name=\"ShowGrid\" config:type=\"boolean\">true</config:config-item></config:config-item-map-entry></config:config-item-map-named><config:config-item config:name=\"ActiveTable\" config:type=\"string\">Sheet2</config:config-item><config:config-item config:name=\"HorizontalScrollbarWidth\" config:type=\"int\">270</config:config-item><config:config-item config:name=\"ZoomType\" config:type=\"short\">0</config:config-item><config:config-item config:name=\"ZoomValue\" config:type=\"int\">100</config:config-item><config:config-item config:name=\"PageViewZoomValue\" config:type=\"int\">60</config:config-item><config:config-item config:name=\"ShowPageBreakPreview\" config:type=\"boolean\">false</config:config-item><config:config-item config:name=\"ShowZeroValues\" config:type=\"boolean\">true</config:config-item><config:config-item config:name=\"ShowNotes\" config:type=\"boolean\">true</config:config-item><config:config-item config:name=\"ShowGrid\" config:type=\"boolean\">true</config:config-item><config:config-item config:name=\"GridColor\" config:type=\"long\">12632256</config:config-item><config:config-item config:name=\"ShowPageBreaks\" config:type=\"boolean\">true</config:config-item><config:config-item config:name=\"HasColumnRowHeaders\" config:type=\"boolean\">true</config:config-item><config:config-item config:name=\"HasSheetTabs\" config:type=\"boolean\">true</config:config-item><config:config-item config:name=\"IsOutlineSymbolsSet\" config:type=\"boolean\">true</config:config-item><config:config-item config:name=\"IsSnapToRaster\" config:type=\"boolean\">false</config:config-item><config:config-item config:name=\"RasterIsVisible\" config:type=\"boolean\">false</config:config-item><config:config-item config:name=\"RasterResolutionX\" config:type=\"int\">1270</config:config-item><config:config-item config:name=\"RasterResolutionY\" config:type=\"int\">1270</config:config-item><config:config-item config:name=\"RasterSubdivisionX\" config:type=\"int\">1</config:config-item><config:config-item config:name=\"RasterSubdivisionY\" config:type=\"int\">1</config:config-item><config:config-item config:name=\"IsRasterAxisSynchronized\" config:type=\"boolean\">true</config:config-item></config:config-item-map-entry></config:config-item-map-indexed></config:config-item-set><config:config-item-set config:name=\"ooo:configuration-settings\"><config:config-item config:name=\"IsKernAsianPunctuation\" config:type=\"boolean\">false</config:config-item><config:config-item config:name=\"IsRasterAxisSynchronized\" config:type=\"boolean\">true</config:config-item><config:config-item config:name=\"LinkUpdateMode\" config:type=\"short\">3</config:config-item><config:config-item config:name=\"SaveVersionOnClose\" config:type=\"boolean\">false</config:config-item><config:config-item config:name=\"AllowPrintJobCancel\" config:type=\"boolean\">true</config:config-item><config:config-item config:name=\"HasSheetTabs\" config:type=\"boolean\">true</config:config-item><config:config-item config:name=\"ShowPageBreaks\" config:type=\"boolean\">true</config:config-item><config:config-item config:name=\"RasterResolutionX\" config:type=\"int\">1270</config:config-item><config:config-item config:name=\"PrinterSetup\" config:type=\"base64Binary\"/><config:config-item config:name=\"RasterResolutionY\" config:type=\"int\">1270</config:config-item><config:config-item config:name=\"LoadReadonly\" config:type=\"boolean\">false</config:config-item><config:config-item config:name=\"RasterSubdivisionX\" config:type=\"int\">1</config:config-item><config:config-item config:name=\"ShowNotes\" config:type=\"boolean\">true</config:config-item><config:config-item config:name=\"ShowZeroValues\" config:type=\"boolean\">true</config:config-item><config:config-item config:name=\"RasterSubdivisionY\" config:type=\"int\">1</config:config-item><config:config-item config:name=\"ApplyUserData\" config:type=\"boolean\">true</config:config-item><config:config-item config:name=\"GridColor\" config:type=\"long\">12632256</config:config-item><config:config-item config:name=\"RasterIsVisible\" config:type=\"boolean\">false</config:config-item><config:config-item config:name=\"IsSnapToRaster\" config:type=\"boolean\">false</config:config-item><config:config-item config:name=\"PrinterName\" config:type=\"string\"/><config:config-item config:name=\"ShowGrid\" config:type=\"boolean\">true</config:config-item><config:config-item config:name=\"CharacterCompressionType\" config:type=\"short\">0</config:config-item><config:config-item config:name=\"HasColumnRowHeaders\" config:type=\"boolean\">true</config:config-item><config:config-item config:name=\"IsOutlineSymbolsSet\" config:type=\"boolean\">true</config:config-item><config:config-item config:name=\"AutoCalculate\" config:type=\"boolean\">true</config:config-item><config:config-item config:name=\"IsDocumentShared\" config:type=\"boolean\">false</config:config-item><config:config-item config:name=\"UpdateFromTemplate\" config:type=\"boolean\">true</config:config-item></config:config-item-set></office:settings></office:document-settings>\n"))
    ("mimetype"
     ("application/vnd.oasis.opendocument.spreadsheet"))
    ("meta.xml"
     ("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
      "<office:document-meta xmlns:office=\"urn:oasis:names:tc:opendocument:xmlns:office:1.0\" xmlns:xlink=\"http://www.w3.org/1999/xlink\" xmlns:dc=\"http://purl.org/dc/elements/1.1/\" xmlns:meta=\"urn:oasis:names:tc:opendocument:xmlns:meta:1.0\" xmlns:ooo=\"http://openoffice.org/2004/office\" xmlns:grddl=\"http://www.w3.org/2003/g/data-view#\" office:version=\"1.2\" grddl:transformation=\"http://docs.oasis-open.org/office/1.2/xslt/odf2rdf.xsl\"><office:meta><meta:initial-creator>Matt Welland</meta:initial-creator><meta:creation-date>2011-09-06T20:46:23</meta:creation-date><dc:date>2011-09-06T20:48:51</dc:date><dc:creator>Matt Welland</dc:creator><meta:editing-duration>PT2M29S</meta:editing-duration><meta:editing-cycles>1</meta:editing-cycles><meta:document-statistic meta:table-count=\"3\" meta:cell-count=\"10\" meta:object-count=\"0\"/><meta:generator>LibreOffice/3.3$Linux LibreOffice_project/330m19$Build-301</meta:generator></office:meta></office:document-meta>\n"))))

(define ods:content-header
  '("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
    "<office:document-content xmlns:office=\"urn:oasis:names:tc:opendocument:xmlns:office:1.0\" xmlns:style=\"urn:oasis:names:tc:opendocument:xmlns:style:1.0\" xmlns:text=\"urn:oasis:names:tc:opendocument:xmlns:text:1.0\" xmlns:table=\"urn:oasis:names:tc:opendocument:xmlns:table:1.0\" xmlns:draw=\"urn:oasis:names:tc:opendocument:xmlns:drawing:1.0\" xmlns:fo=\"urn:oasis:names:tc:opendocument:xmlns:xsl-fo-compatible:1.0\" xmlns:xlink=\"http://www.w3.org/1999/xlink\" xmlns:dc=\"http://purl.org/dc/elements/1.1/\" xmlns:meta=\"urn:oasis:names:tc:opendocument:xmlns:meta:1.0\" xmlns:number=\"urn:oasis:names:tc:opendocument:xmlns:datastyle:1.0\" xmlns:presentation=\"urn:oasis:names:tc:opendocument:xmlns:presentation:1.0\" xmlns:svg=\"urn:oasis:names:tc:opendocument:xmlns:svg-compatible:1.0\" xmlns:chart=\"urn:oasis:names:tc:opendocument:xmlns:chart:1.0\" xmlns:dr3d=\"urn:oasis:names:tc:opendocument:xmlns:dr3d:1.0\" xmlns:math=\"http://www.w3.org/1998/Math/MathML\" xmlns:form=\"urn:oasis:names:tc:opendocument:xmlns:form:1.0\" xmlns:script=\"urn:oasis:names:tc:opendocument:xmlns:script:1.0\" xmlns:ooo=\"http://openoffice.org/2004/office\" xmlns:ooow=\"http://openoffice.org/2004/writer\" xmlns:oooc=\"http://openoffice.org/2004/calc\" xmlns:dom=\"http://www.w3.org/2001/xml-events\" xmlns:xforms=\"http://www.w3.org/2002/xforms\" xmlns:xsd=\"http://www.w3.org/2001/XMLSchema\" xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" xmlns:rpt=\"http://openoffice.org/2005/report\" xmlns:of=\"urn:oasis:names:tc:opendocument:xmlns:of:1.2\" xmlns:xhtml=\"http://www.w3.org/1999/xhtml\" xmlns:grddl=\"http://www.w3.org/2003/g/data-view#\" xmlns:tableooo=\"http://openoffice.org/2009/table\" xmlns:field=\"urn:openoffice:names:experimental:ooo-ms-interop:xmlns:field:1.0\" xmlns:formx=\"urn:openoffice:names:experimental:ooxml-odf-interop:xmlns:form:1.0\" xmlns:css3t=\"http://www.w3.org/TR/css3-text/\" office:version=\"1.2\" grddl:transformation=\"http://docs.oasis-open.org/office/1.2/xslt/odf2rdf.xsl\">\n"
    "<office:scripts/>\n"
    "<office:font-face-decls>\n"
    "<style:font-face style:name=\"Arial\" svg:font-family=\"Arial\" style:font-family-generic=\"swiss\" style:font-pitch=\"variable\"/>\n"
    "<style:font-face style:name=\"DejaVu Sans\" svg:font-family=\"&apos;DejaVu Sans&apos;\" style:font-family-generic=\"system\" style:font-pitch=\"variable\"/>\n"
    "<style:font-face style:name=\"Droid Sans Fallback\" svg:font-family=\"&apos;Droid Sans Fallback&apos;\" style:font-family-generic=\"system\" style:font-pitch=\"variable\"/>\n"
    "<style:font-face style:name=\"Lohit Hindi\" svg:font-family=\"&apos;Lohit Hindi&apos;\" style:font-family-generic=\"system\" style:font-pitch=\"variable\"/>\n"
    "</office:font-face-decls>\n"
    "<office:automatic-styles>\n"
    "<style:style style:name=\"co1\" style:family=\"table-column\">\n"
    "<style:table-column-properties fo:break-before=\"auto\" style:column-width=\"0.8925in\"/>\n"
    "</style:style>\n"
    "<style:style style:name=\"ro1\" style:family=\"table-row\">\n"
    "<style:table-row-properties style:row-height=\"0.178in\" fo:break-before=\"auto\" style:use-optimal-row-height=\"true\"/>\n"
    "</style:style>\n"
    "<style:style style:name=\"ta1\" style:family=\"table\" style:master-page-name=\"Default\">\n"
    "<style:table-properties table:display=\"true\" style:writing-mode=\"lr-tb\"/>\n"
    "</style:style>\n"
    "</office:automatic-styles>\n"
    "<office:body>\n"
    "<office:spreadsheet>\n"))

(define ods:content-footer
  '("</office:spreadsheet>\n"
    "</office:body>\n"
    "</office:document-content>\n"))

(define (ods:make-thumbnail path)
  (let ((oup      (open-output-pipe (conc "uudecode -o " path "/Thumbnails/thumbnail.png"))))
    (with-output-to-port oup
      (lambda ()
	(print "begin-base64 640 Thumbnail.png
iVBORw0KGgoAAAANSUhEUgAAAL4AAAEACAIAAACCoVt7AAAEWElEQVR4nO3X
MU4bWQCA4bGUo5gUKCcgJwCaVNvShdI06VKmSxNKp6PdKg3xCcgJIhr7Ll6P
DTgBRbv5i11W+r7Gw7yZx0jv5415sV6vB/h9L/7rB+D/apfO4nxy8nk8OPq0
vDm9Pr8+nc+mv75pcXl5MNtfsLp8fXDxbRjefl3Pj//xb340yW+N8gyM6awu
vxwu1+txnVar1Xj2z7PJpoUxhYNdFmNSs+EukdHRcHpzt7Kr69s/luub6Wa1
V8Px9tx9TLsSH2a4OxwjWx5+uLgYhtOr4ezXo8Ori4tt0b8XJf+KMZ3p7N3w
ejIZV227hMP3V+/XNweX59erxZddK98uPi5eDvfdbC672u8I09l8tvlYDC/v
z93HNJa4+Hj7fr0+3mxs54vTw1e7BM+vh9n7T8PBbPlx8jD/k9HT4WzsRzfP
0/aFtVi+vNl9W75b4MODhwv2C7c4vz/e7C8/zzK+8Iav6ycLPJ1Ol3/zAPv5
N5vfo7tnN+vZuIFNJvJ5frYvrOHLh8nJyfjjuOsM1/slPH53uNmPTnYDD8dH
R5ut4uGFdf9F6WQy3C3wdPbmdjKZDNsw7u56PPMw3F6cXS6vDs/u57/66cE2
o+e3w+fP203p7RvdPDvbF9bx/GY935/bvYDuPsa//IeBH473jufrH+9+cu54
f9dPM893u9QPcz4dnT+emGfDP+dE0iGSDpF0iKRDJB0i6RBJh0g6RNIhkg6R
dIikQyQdIukQSYdIOkTSIZIOkXSIpEMkHSLpEEmHSDpE0iGSDpF0iKRDJB0i
6RBJh0g6RNIhkg6RdIikQyQdIukQSYdIOkTSIZIOkXSIpEMkHSLpEEmHSDpE
0iGSDpF0iKRDJB0i6RBJh0g6RNIhkg6RdIikQyQdIukQSYdIOkTSIZIOkXSI
pEMkHSLpEEmHSDpE0iGSDpF0iKRDJB0i6RBJh0g6RNIhkg6RdIikQyQdIukQ
SYdIOkTSIZIOkXSIpEMkHSLpEEmHSDpE0iGSDpF0iKRDJB0i6RBJh0g6RNIh
kg6RdIikQyQdIukQSYdIOkTSIZIOkXSIpEMkHSLpEEmHSDpE0iGSDpF0iKRD
JB0i6RBJh0g6RNIhkg6RdIikQyQdIukQSYdIOkTSIZIOkXSIpEMkHSLpEEmH
SDpE0iGSDpF0iKRDJB0i6RBJh0g6RNIhkg6RdIikQyQdIukQSYdIOkTSIZIO
kXSIpEMkHSLpEEmHSDpE0iGSDpF0iKRDJB0i6RBJh0g6RNIhkg6RdIikQyQd
IukQSYdIOkTSIZIOkXSIpEMkHSLpEEmHSDpE0iGSDpF0iKRDJB0i6RBJh0g6
RNIhkg6RdIikQyQdIukQSYdIOkTSIZIOkXSIpEMkHSLpEEmHSDpE0iGSDpF0
iKRDJB0i6RBJh0g6RNIhkg6RdIikQyQdIukQSYdIOkTSIZIOkXSIpEMkHSLp
EEmHSDpE0iGSDpF0iKRDJB0i6RBJh+gv8TgE/jVPQbMAAAAASUVORK5CYII=
====")))))

;; sheetdat is '("sheetname" (r1c1 r2c2 ...)(r2c1 r2c2 ...) ...)
(define (ods:sheet sheetdat)
  (let ((name (car sheetdat))
	(rows (cdr sheetdat)))
    (conc "<table:table table:name=\"" name "\" table:style-name=\"ta1\" table:print=\"false\">\n"
	  (conc (ods:column)
		(string-join (map ods:row rows) ""))
	  "</table:table>")))

;; seems to be called once at top of each sheet, i.e. a column of rows
(define (ods:column)
  "<table:table-column table:style-name=\"co1\" table:number-columns-repeated=\"2\" table:default-cell-style-name=\"Default\"/>\n")

;; cells is a list of <table:table-cell ..> ... </table:table-cell>
(define (ods:row cells)
  (conc	 "<table:table-row table:style-name=\"ro1\">\n"
	 (string-join (map ods:cell cells) "")
	 "</table:table-row>\n"))

;; types are "string" or "float"
(define (ods:cell value)
  (let* ((type (cond
	       ((string? value) "string")
	       ((symbol? value) "string")
	       ((number? value) "float")
	       (else #f)))
	(tmpval (if (symbol? value)
		    (symbol->string value) 
		    (if type value ""))) ;; convert everything else to an empty string
	(escval (if (string? tmpval)(string-substitute (regexp "<") "&lt;" (string-substitute (regexp ">") "&gt;" tmpval)) tmpval)))
    (conc "<table:table-cell office:value-type=\"" (if type type "string") "\""
	  (if (equal? type "float")(conc " office:value=\"" value "\"") "")
	  ">\n"
	  "<text:p>" escval "</text:p>" "\n"
	  "</table:table-cell>" "\n")))

;; create the directories
(define (ods:construct-dir path)
  (for-each 
   (lambda (subdir)
     (system (conc "mkdir -p "  path "/" subdir)))
   ods:dirs))

;; populate the necessary, non-constructed, files
(define (ods:add-non-content-files path)
  ;; first the zero-length files, nb// the dir should already be created
  (for-each 
   (lambda (fname)
     (system (conc "touch " path "/" fname)))
   ods:0-len-files)
  ;; create the files with stuff in them
  (for-each
   (lambda (fdat)
     (let* ((name  (car fdat))
	    (lines (cadr fdat)))
       (with-output-to-file (conc path "/" name)
	 (lambda ()
	   (for-each 
	    (lambda (line)
	      (display line))
	    lines)))))
   ods:files))

;; data format:
;;   '( (sheet1 (r1c1 r1c2 r1c3 ...)
;;              (r2c1 r2c3 r2c3 ...) )
;;      (sheet2 ( ... )
;;              ( ... ) ) )
(define (ods:list->ods path fname data)
  (if (not (common:file-exists? path))
      (print "ERROR: path to create ods data must pre-exist")
      (begin
	(with-output-to-file (conc path "/content.xml")
	  (lambda ()
	    (ods:construct-dir path)
	    (ods:add-non-content-files path)
	    (ods:make-thumbnail path)
	    (map display ods:content-header)
	    ;; process each sheet
	    (map print 
		 (map ods:sheet data))
	    (map display ods:content-footer)))
	(system (conc "cd " path "; zip " fname " -n mimetype mimetype `find . |grep -v mimetype` > /dev/null")))))

;;======================================================================
;; Extract ods file from the db
;;======================================================================

;; NOT REWRITTEN YET!!!!!

;; runspatt is a comma delimited list of run patterns
;; keypatt-alist must contain *all* keys with an associated pattern: '( ("KEY1" "%") .. )
(define (db:extract-ods-file dbstruct outputfile keypatt-alist runspatt pathmod)
  (assert #f "FATAL: call to db:extract-ods-file which is not ported yet.")
  (let* ((keysstr  (string-intersperse (map car keypatt-alist) ","))
	 (keyqry   (string-intersperse (map (lambda (p)(conc (car p) " LIKE ? ")) keypatt-alist) " AND "))
	 (numkeys  (length keypatt-alist))
	 (test-ids '())
	 (dbdat    (db:get-subdb dbstruct))
	 (db       (dbr:dbdat-dbh dbdat))
	 (windows  (and pathmod (substring-index "\\" pathmod)))
	 (tempdir  (conc "/tmp/" (current-user-name) "/" runspatt "_" (random 10000) "_" (current-process-id)))
	 (runsheader (append (list "Run Id" "Runname") ; 0 1
			     (map car keypatt-alist)   ; + N = length keypatt-alist
			     (list "Testname"          ; 2
				   "Item Path"         ; 3 
				   "Description"       ; 4 
				   "State"             ; 5 
				   "Status"            ; 6  
				   "Final Log"         ; 7 
				   "Run Duration"      ; 8 
				   "When Run"          ; 9 
				   "Tags"              ; 10
				   "Run Owner"         ; 11
				   "Comment"           ; 12
				   "Author"            ; 13
				   "Test Owner"        ; 14
				   "Reviewed"          ; 15
				   "Diskfree"          ; 16
				   "Uname"             ; 17
				   "Rundir"            ; 18
				   "Host"              ; 19
				   "Cpu Load"          ; 20
				   )))
	 (results (list runsheader))			 
	 (testdata-header (list "Run Id" "Testname" "Item Path" "Category" "Variable" "Value" "Expected" "Tol" "Units" "Status" "Comment"))
	 (mainqry (conc "SELECT
              t.testname,r.id,runname," keysstr ",t.testname,
              t.item_path,tm.description,t.state,t.status,
              final_logf,run_duration, 
              strftime('%m/%d/%Y %H:%M:%S',datetime(t.event_time,'unixepoch'),'localtime'),
              tm.tags,r.owner,t.comment,
              author,
              tm.owner,reviewed,
              diskfree,uname,rundir,
              host,cpuload
            FROM tests AS t JOIN runs AS r ON t.run_id=r.id JOIN test_meta AS tm ON tm.testname=t.testname
            WHERE runname LIKE ? AND " keyqry ";")))
    (debug:print 2 *default-log-port* "Using " tempdir " for constructing the ods file. keyqry: " keyqry " keystr: " keysstr " with keys: " (map cadr keypatt-alist)
		 "\n      mainqry: " mainqry)
    ;; "Expected Value"
    ;; "Value Found"
    ;; "Tolerance"
    (apply sqlite3:for-each-row
	   (lambda (test-id . b)
	     (set! test-ids (cons test-id test-ids))   ;; test-id is now testname
	     (set! results (append results ;; note, drop the test-id
				   (list
				    (if pathmod
					(let* ((vb        (apply vector b))
					       (keyvals   (let loop ((i    0)
								     (res '()))
							    (if (>= i numkeys)
								res
								(loop (+ i 1)
								      (append res (list (vector-ref vb (+ i 2))))))))
					       (runname   (vector-ref vb 1))
					       (testname  (vector-ref vb (+  2 numkeys)))
					       (item-path (vector-ref vb (+  3 numkeys)))
					       (final-log (vector-ref vb (+  7 numkeys)))
					       (run-dir   (vector-ref vb (+ 18 numkeys)))
					       (log-fpath (conc run-dir "/"  final-log))) ;; (string-intersperse keyvals "/") "/" testname "/" item-path "/"
					  (debug:print 4 *default-log-port* "log: " log-fpath " exists: " (common:file-exists? log-fpath))
					  (vector-set! vb (+ 7 numkeys) (if (common:file-exists? log-fpath)
									    (let ((newpath (conc pathmod "/"
												 (string-intersperse keyvals "/")
												 "/" runname "/" testname "/"
												 (if (string=? item-path "") "" (conc "/" item-path))
												 final-log)))
									      ;; for now throw away newpath and use the log-fpath conc'd with pathmod
									      (set! newpath (conc pathmod log-fpath))
									      (if windows (string-translate newpath "/" "\\") newpath))
									    (if (debug:debug-mode 1)
										(conc final-log " not-found")
										"")))
					  (vector->list vb))
					b)))))
	   db
	   mainqry
	   runspatt (map cadr keypatt-alist))
    (debug:print 2 *default-log-port* "Found " (length test-ids) " records")
    (set! results (list (cons "Runs" results)))
    ;; now, for each test, collect the test_data info and add a new sheet
    (for-each
     (lambda (test-id)
       (let ((test-data (list testdata-header))
	     (curr-test-name #f))
	 (sqlite3:for-each-row
	  (lambda (run-id testname item-path category variable value expected tol units status comment)
	    (set! curr-test-name testname)
	    (set! test-data (append test-data (list (list run-id testname item-path category variable value expected tol units status comment)))))
	  db 
	  ;; "SELECT run_id,testname,item_path,category,variable,td.value AS value,expected,tol,units,td.status AS status,td.comment AS comment FROM test_data AS td INNER JOIN tests ON tests.id=td.test_id WHERE test_id=?;"
	  "SELECT run_id,testname,item_path,category,variable,td.value AS value,td.expected,td.tol,td.units,td.status AS status,td.comment AS comment FROM test_data AS td INNER JOIN tests ON tests.id=td.test_id WHERE testname=?;"
	  test-id)
	 (if curr-test-name
	     (set! results (append results (list (cons curr-test-name test-data)))))
	 ))
     (sort (delete-duplicates test-ids) string<=))
    (system (conc "mkdir -p " tempdir))
    ;; (pp results)
    (ods:list->ods 
     tempdir
     (if (string-match (regexp "^[/~]+.*") outputfile) ;; full path?
	 outputfile
	 (begin
	   (debug:print 0 *default-log-port* "WARNING: path given, " outputfile " is relative, prefixing with current directory")
	   (conc (current-directory) "/" outputfile)))
     results)
    ;; brutal clean up
    (dbfile:add-dbdat dbstruct #f dbdat)
    (system "rm -rf tempdir")))

;; (db:extract-ods-file db "outputfile.ods" '(("sysname" "%")("fsname" "%")("datapath" "%")) "%")

)

;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;


(declare (unit portlogger))
(declare (uses debugprint))
(declare (uses commonmod))
;; (declare (uses dbmod))

(module portlogger
*

(import scheme)

(cond-expand
 (chicken-4
  (import chicken data-structures)
  (import posix
	  ;; hostinfo
	  ;; dot-locking
	  extras
	  )
  
  (import (prefix sqlite3 sqlite3:))

  )
 (chicken-5
  (import chicken.base
	  chicken.condition
	  chicken.file
	  chicken.pathname
	  chicken.process-context.posix

  (define file-write-access? file-writable?)
  (define random pseudo-random-integer)
  ))

(import srfi-1 srfi-69 z3
	(srfi 18) s11n)
(import (prefix sqlite3 sqlite3:))
(import debugprint
	;; dbmod
	commonmod
	)

;; lsof -i

(define (portlogger:open-db fname)
  (let* ((avail    (tasks:wait-on-journal fname 5 remove: #t)) ;; wait up to about 10 seconds for the journal to go away
	 (exists   (file-exists? fname))
	 (db       (if avail 

(define (common:get-last-run-version-number)
  (string->number 
   (substring (common:get-last-run-version) 0 6)))

(define (common:set-last-run-version)
  (rmt:set-var "MEGATEST_VERSION" (common:version-signature)))











;;======================================================================
;; postive number if megatest version > db version
;; negative number if megatest version < db version
(define (common:version-db-delta)
  (- megatest-version (common:get-last-run-version-number)))

(define (common:version-changed?)

;;	(debug:print 0 *default-log-port* "ERROR: cannot migrate version unless on homehost. Exiting.")
;;	(exit 1))))

;;======================================================================
;; E X I T   H A N D L I N G
;;======================================================================

;; (define (common:run-sync?)
;;   (and *toppath*               ;; gate if called before *toppath* is set
;;        (common:on-homehost?)
;;        (args:get-arg "-server")))


(define (std-signal-handler signum)
  ;; (signal-mask! signum)
  (set! *time-to-exit* #t) 
  ;;(debug:print-info 13 *default-log-port* "got signal "signum)
  (debug:print-error 0 *default-log-port* "Received signal " signum " aaa exiting promptly")

;;
;;======================================================================

;;======================================================================
;; T E S T   S P E C I F I C   D B 
;;======================================================================

;; =not-used= ;; Create the sqlite db for the individual test(s)
;; =not-used= ;;
;; =not-used= ;; Moved these tables into <runid>.db
;; =not-used= ;; THIS CODE TO BE REMOVED
;; =not-used= ;;
;; =not-used= (define (open-test-db work-area) 
;; =not-used=   (debug:print-info 11 *default-log-port* "open-test-db " work-area)
;; =not-used=   (if (and work-area 
;; =not-used= 	   (directory? work-area)
;; =not-used= 	   (file-read-access? work-area))
;; =not-used=       (let* ((dbpath              (conc work-area "/testdat.db"))
;; =not-used= 	     (dbexists            (common:file-exists? dbpath))
;; =not-used= 	     (work-area-writeable (file-write-access? work-area))
;; =not-used= 	     (db                  (handle-exceptions  ;; open the db if area writeable or db pre-existing. open in-mem otherwise. if exception, open in-mem
;; =not-used= 				   exn
;; =not-used= 				   (begin
;; =not-used= 				     (print-call-chain (current-error-port))
;; =not-used= 				     (debug:print 2 *default-log-port* "ERROR: problem accessing test db " work-area ", you probably should clean and re-run this test"
;; =not-used= 						  ((condition-property-accessor 'exn 'message) exn))
;; =not-used= 				     (set! dbexists #f) ;; must force re-creation of tables, more tom-foolery
;; =not-used= 				     (sqlite3:open-database ":memory:")) ;; open an in-memory db to allow readonly access 
;; =not-used= 				   (if (or work-area-writeable
;; =not-used= 					   dbexists)
;; =not-used= 				       (sqlite3:open-database dbpath)
;; =not-used= 				       (sqlite3:open-database ":memory:"))))
;; =not-used= 	     (tdb-writeable       (and (file-write-access? work-area)
;; =not-used= 				       (file-write-access? dbpath)))
;; =not-used= 	     (handler   (sqlite3:make-busy-timeout (if (args:get-arg "-override-timeout")
;; =not-used= 						       (string->number (args:get-arg "-override-timeout"))
;; =not-used= 						       136000))))
;; =not-used= 	
;; =not-used= 	(if (and tdb-writeable
;; =not-used= 		 *db-write-access*)
;; =not-used= 	    (sqlite3:set-busy-handler! db handler))
;; =not-used= 	(if (not dbexists)
;; =not-used= 	    (begin
;; =not-used= 	      (db:set-sync db) ;; (sqlite3:execute db "PRAGMA synchronous = FULL;")
;; =not-used= 	      (debug:print-info 11 *default-log-port* "Initialized test database " dbpath)
;; =not-used= 	      (tdb:testdb-initialize db)))
;; =not-used= 	;; (sqlite3:execute db "PRAGMA synchronous = 0;")
;; =not-used= 	(debug:print-info 11 *default-log-port* "open-test-db END (sucessful)" work-area)
;; =not-used= 	;; now let's test that everything is correct
;; =not-used= 	(handle-exceptions
;; =not-used= 	 exn
;; =not-used= 	 (begin
;; =not-used= 	   (print-call-chain (current-error-port))
;; =not-used= 	   (debug:print-error 0 *default-log-port* "problem accessing test db " work-area ", you probably should clean and re-run this test or remove the file " 
;; =not-used= 			dbpath ".\n  "
;; =not-used= 			((condition-property-accessor 'exn 'message) exn))
;; =not-used= 	   #f)
;; =not-used= 	 ;; Is there a cheaper single line operation that will check for existance of a table
;; =not-used= 	 ;; and raise an exception ?
;; =not-used= 	 (sqlite3:execute db "SELECT id FROM test_data LIMIT 1;"))
;; =not-used= 	db)
;; =not-used=       ;; no work-area or not readable - create a placeholder to fake rest of world out
;; =not-used=       (let ((baddb (sqlite3:open-database ":memory:")))
;; =not-used=  	(debug:print-info 11 *default-log-port* "open-test-db END (unsucessful)" work-area)
;; =not-used=  	;; provide an in-mem db (this is dangerous!)
;; =not-used=  	(tdb:testdb-initialize baddb)
;; =not-used=  	baddb)))
;; =not-used= 
;; =not-used= ;; find and open the testdat.db file for an existing test
;; =not-used= (define (tdb:open-test-db-by-test-id test-id #!key (work-area #f))
;; =not-used=   (let* ((test-path (if work-area
;; =not-used= 			work-area
;; =not-used= 			(rmt:test-get-rundir-from-test-id test-id))))
;; =not-used=     (debug:print 3 *default-log-port* "TEST PATH: " test-path)
;; =not-used=     (open-test-db test-path)))
;; =not-used= 
;; =not-used= ;; find and open the testdat.db file for an existing test
;; =not-used= (define (tdb:open-test-db-by-test-id-local dbstruct run-id test-id #!key (work-area #f))
;; =not-used=   (let* ((test-path (if work-area
;; =not-used= 			work-area
;; =not-used= 			(db:test-get-rundir-from-test-id dbstruct run-id test-id))))
;; =not-used=     (debug:print 3 *default-log-port* "TEST PATH: " test-path)
;; =not-used=     (open-test-db test-path)))
;; =not-used= 
;; =not-used= ;; find and open the testdat.db file for an existing test
;; =not-used= (define (tdb:open-run-close-db-by-test-id-local dbstruct run-id test-id work-area proc . params)
;; =not-used=   (let* ((test-path (if work-area
;; =not-used= 			work-area
;; =not-used= 			(db:test-get-rundir-from-test-id dbstruct run-id test-id)))
;; =not-used= 	 (tdb        (open-test-db test-path)))
;; =not-used=     (apply proc tdb params)))
;; =not-used= 
;; =not-used= (define (tdb:testdb-initialize db)
;; =not-used=   (debug:print 11 *default-log-port* "db:testdb-initialize START")
;; =not-used=   (sqlite3:with-transaction
;; =not-used=    db
;; =not-used=    (lambda ()
;; =not-used=      (for-each
;; =not-used=       (lambda (sqlcmd)
;; =not-used= 	(sqlite3:execute db sqlcmd))
;; =not-used=       (list "CREATE TABLE IF NOT EXISTS test_rundat (
;; =not-used=               id INTEGER PRIMARY KEY,
;; =not-used=               update_time TIMESTAMP,
;; =not-used=               cpuload INTEGER DEFAULT -1,
;; =not-used=               diskfree INTEGER DEFAULT -1,
;; =not-used=               diskusage INTGER DEFAULT -1,
;; =not-used=               run_duration INTEGER DEFAULT 0);"
;; =not-used= 	    "CREATE TABLE IF NOT EXISTS test_data (
;; =not-used=               id INTEGER PRIMARY KEY,
;; =not-used=               test_id INTEGER,
;; =not-used=               category TEXT DEFAULT '',
;; =not-used=               variable TEXT,
;; =not-used= 	      value REAL,
;; =not-used= 	      expected REAL,
;; =not-used= 	      tol REAL,
;; =not-used=               units TEXT,
;; =not-used=               comment TEXT DEFAULT '',
;; =not-used=               status TEXT DEFAULT 'n/a',
;; =not-used=               type TEXT DEFAULT '',
;; =not-used=               CONSTRAINT test_data_constraint UNIQUE (test_id,category,variable));"
;; =not-used= 	    "CREATE TABLE IF NOT EXISTS test_steps (
;; =not-used=               id INTEGER PRIMARY KEY,
;; =not-used=               test_id INTEGER, 
;; =not-used=               stepname TEXT, 
;; =not-used=               state TEXT DEFAULT 'NOT_STARTED', 
;; =not-used=               status TEXT DEFAULT 'n/a',
;; =not-used=               event_time TIMESTAMP,
;; =not-used=               comment TEXT DEFAULT '',
;; =not-used=               logfile TEXT DEFAULT '',
;; =not-used=               CONSTRAINT test_steps_constraint UNIQUE (test_id,stepname,state));"
;; =not-used= 	    ;; test_meta can be used for handing commands to the test
;; =not-used= 	    ;; e.g. KILLREQ
;; =not-used= 	    ;;      the ackstate is set to 1 once the command has been completed
;; =not-used= 	    "CREATE TABLE IF NOT EXISTS test_meta (
;; =not-used=               id INTEGER PRIMARY KEY,
;; =not-used=               var TEXT,
;; =not-used=               val TEXT,
;; =not-used=               ackstate INTEGER DEFAULT 0,
;; =not-used=               CONSTRAINT metadat_constraint UNIQUE (var));"))))
;; =not-used=   (debug:print 11 *default-log-port* "db:testdb-initialize END"))
;; =not-used= 
;; =not-used= ;; This routine moved to db:read-test-data
;; =not-used= ;;
;; =not-used= (define (tdb:read-test-data tdb test-id categorypatt)
;; =not-used=   (let ((res '()))
;; =not-used=     (sqlite3:for-each-row 
;; =not-used=      (lambda (id test_id category variable value expected tol units comment status type)
;; =not-used=        (set! res (cons (vector id test_id category variable value expected tol units comment status type) res)))
;; =not-used=      tdb
;; =not-used=      "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt)
;; =not-used=     (sqlite3:finalize! tdb)
;; =not-used=     (reverse res)))

;;======================================================================
;; T E S T   D A T A 
;;======================================================================

;; ;; get a list of test_data records matching categorypatt
;; (define (tdb:read-test-data test-id categorypatt #!key (work-area #f))

          (rmt:csv->test-data run-id test-id lin)
          ;;)
	  (loop (read-line)))))
  ;; roll up the current results.
  ;; FIXME: Add the status too 
  (rmt:test-data-rollup run-id test-id #f))





;;======================================================================
;; S T E P S 
;;======================================================================

(define (tdb:step-get-time-as-string vec)
  (seconds->time-string (tdb:step-get-event_time vec)))

    (append (if base-itemmap
		(list (list "%" base-itemmap))
		'())
	    (if itemmap-table
		itemmap-table
		'()))))


















(define (tests:get-global-waitons rconfig)
  (let* ((global-waitons (runconfigs-get rconfig "!GLOBAL_WAITONS")))
    (if (string? global-waitons)
	(string-split global-waitons)
	'())))

   (else ;; not waiting on items, waiting on entire waiton test.
    (let* ((patts (string-split test-patt ","))
           (new-patts (if (member waiton-test patts)
                          patts
                          (cons waiton-test patts))))
      (string-intersperse (delete-duplicates new-patts) ",")))))











































































;; Check for waiver eligibility
;;
(define (tests:check-waiver-eligibility testdat prev-testdat)
  (let* ((test-registry (make-hash-table))
	 (testconfig  (tests:get-testconfig (db:test-get-testname testdat) (db:test-get-item-path testdat) test-registry #f))
	 (test-rundir ;; (sdb:qry 'passstr 
	  (db:test-get-rundir testdat)) ;; )