Index: Makefile
==================================================================
--- Makefile
+++ Makefile
@@ -28,14 +28,12 @@
ezsteps.scm lock-queue.scm rmt.scm api.scm \
subrun.scm portlogger.scm archive.scm env.scm \
diff-report.scm cgisetup/models/pgdb.scm
# module source files
-MSRCFILES = dbmod.scm dbfile.scm debugprint.scm mtargs.scm commonmod.scm
-
-mofiles/dbfile.o : mofiles/debugprint.o
-mofiles/debugprint.o : mofiles/mtargs.o
+MSRCFILES = dbmod.scm dbfile.scm debugprint.scm mtargs.scm commonmod.scm \
+ ducttape-lib.scm pkts.scm dbi.scm
# ftail.scm rmtmod.scm commonmod.scm removed
# MSRCFILES = ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm \
# mtargs.scm commonmod.scm dbmod.scm adjutant.scm ulex.scm \
# rmtmod.scm apimod.scm
@@ -152,11 +150,15 @@
$(PREFIX)/share/db/mt-pg.sql : mt-pg.sql
mkdir -p $(PREFIX)/share/db
$(INSTALL) mt-pg.sql $(PREFIX)/share/db/mt-pg.sql
# Special dependencies for the includes
-$(MOFILE) $(MOIMPFILES) : megatest-fossil-hash.scm
+$(MOFILE) $(MOIMPFILES) $(MSRCFILES) : megatest-fossil-hash.scm
+
+mofiles/pkts.o : mofiles/dbi.o
+mofiles/dbfile.o : mofiles/debugprint.o
+mofiles/debugprint.o : mofiles/mtargs.o
common.o : mofiles/commonmod.o megatest-fossil-hash.scm
# mofiles/dbmod.o : mofiles/configfmod.o
Index: TODO
==================================================================
--- TODO
+++ TODO
@@ -15,10 +15,21 @@
# You should have received a copy of the GNU General Public License
# along with Megatest. If not, see .
TODO
====
+
+Loose ends
+----------
+
+15:09:29 error in calling find-and-mark-incomplete for run-id 5, exn=#
+ might be related to initial conditions in the db. (no run entry in runs table?).
+
+. -list-servers not correct
+. move *remotedat* into bigdata
+. add back server stats on exit (look in rmt:run in rmtmod.scm)
+
WW15
. fill newview matrix with data, filter pipeline gui elements
. improve [script], especially indent handling
Index: cgisetup/models/pgdb.scm
==================================================================
--- cgisetup/models/pgdb.scm
+++ cgisetup/models/pgdb.scm
@@ -16,25 +16,25 @@
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see .
;;======================================================================
-(declare (unit pgdb))
-(declare (uses configf))
-
-;; I don't know how to mix compilation units and modules, so no module here.
-;;
-;; (module pgdb
-;; (
-;; open-pgdb
-;; )
-;;
-;; (import scheme)
-;; (import data-structures)
-;; (import chicken)
-
-(use typed-records (prefix dbi dbi:))
+;; (declare (unit pgdb))
+;; (declare (uses configf))
+;;
+;; ;; I don't know how to mix compilation units and modules, so no module here.
+;; ;;
+;; ;; (module pgdb
+;; ;; (
+;; ;; open-pgdb
+;; ;; )
+;; ;;
+;; ;; (import scheme)
+;; ;; (import data-structures)
+;; ;; (import chicken)
+;;
+;; (use typed-records (prefix dbi dbi:))
;; given a configdat lookup the connection info and open the db
;;
(define (pgdb:open configdat #!key (dbname #f)(dbispec #f))
(let ((pgconf (or dbispec
Index: common.scm
==================================================================
--- common.scm
+++ common.scm
@@ -202,11 +202,11 @@
(define *numcpus-cache* (make-hash-table))
(use posix-extras pathname-expand files)
;; this plugs a hole in posix-extras in recent chicken versions > 4.9)
-(let-values (( (chicken-release-number chicken-major-version)
+#;(let-values (( (chicken-release-number chicken-major-version)
(apply values
(map string->number
(take
(string-split (chicken-version) ".")
2)))))
Index: commonmod.scm
==================================================================
--- commonmod.scm
+++ commonmod.scm
@@ -23,15 +23,34 @@
(use srfi-69)
(module commonmod
*
-(import scheme chicken data-structures extras files)
-(import (prefix sqlite3 sqlite3:)
- posix typed-records srfi-18 srfi-69
- md5 message-digest
- regex srfi-1)
+ (import
+ scheme
+ chicken.base
+ chicken.condition
+ chicken.file
+ chicken.file.posix
+ chicken.io
+ chicken.pathname
+ chicken.process-context
+ chicken.process-context.posix
+ chicken.string
+ chicken.time
+ system-information
+
+ ;; data-structures extras files
+ (prefix sqlite3 sqlite3:)
+ ;; posix typed-records
+ srfi-18
+ srfi-69
+ md5
+ message-digest
+ regex
+ srfi-1
+ )
;;======================================================================
;; CONTENTS
;;
;; config file utils
Index: configure
==================================================================
--- configure
+++ configure
@@ -15,87 +15,18 @@
# 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 .
-# Configure the build
-
-if [[ "$1"x == "x" ]];then
- PREFIX=$PWD
-else
- PREFIX=$1
-fi
-
-
-#======================================================================
-# Configure stuff needed for eggs
-#======================================================================
-
-function configure_dependencies () {
-
- #======================================================================
- # libnanomsg
- #======================================================================
-
- if [[ ! $(ls /usr/lib/*/libnanomsg*) ]];then
- echo "libnanomsg build needed."
- echo "BUILD_NANOMSG=yes" >> makefile.inc
- fi
-
- #======================================================================
- # postgresql libraries
- #======================================================================
-
- if [[ ! $(ls /usr/lib/*/libpq.*) ]];then
- echo "Postgresql build needed."
- echo "BUILD_POSTGRES=yes" >> makefile.inc
- fi
-
- if [[ ! $(ls /usr/lib/*/libsqlite3.*) ]];then
- echo "Sqlite3 build needed."
- echo "BUILD_SQLITE3=yes" >> makefile.inc
- fi
-
-}
-
-#======================================================================
-# Initialize makefile.inc
-#======================================================================
-
-echo "" > makefile.inc
-
-#======================================================================
-# Do we need Chicken?
-#======================================================================
-
-if [[ -e /usr/bin/sw_vers ]]; then
- ARCHSTR=$(/usr/bin/sw_vers -productVersion)
-else
- ARCHSTR=$(lsb_release -sr)
-fi
-
-echo "CHICKEN_PREFIX=$PREFIX/.$ARCHSTR" >> makefile.inc
-CHICKEN_PREFIX=$PREFIX/bin/.$ARCHSTR
-
-if [[ ! $(type csi) ]];then
- echo "Chicken build needed."
- echo "BUILD_CHICKEN=yes" >> makefile.inc
- configure_dependencies
- echo "include chicken.makefile" >> makefile.inc
-else
- echo "CSIPATH=$(which csi)" >> makefile.inc
- CSIPATH=$(which csi)
- echo "CKPATH=$(dirname $(dirname $CSIPATH))" >> makefile.inc
-fi
-
-# Make setup scripts
-echo "#!/bin/bash" > setup.sh
-echo "export PATH=$CHICKEN_PREFIX/bin:\$PATH" >> setup.sh
-echo "export LD_LIBRARY_PATH=$CHICKEN_PREFIX/lib" >> setup.sh
-echo 'exec "$@"' >> setup.sh
-chmod a+x setup.sh
-
-echo "setenv PATH $CHICKEN_PREFIX/bin:\$PATH" > setup.csh
-echo "setenv LD_LIBRARY_PATH $CHICKEN_PREFIX/lib" >> setup.csh
-
-echo "All done creating makefile.inc, feel free to edit it!"
-echo "run \"setup.sh bash\" or source setup.csh to get PATH and LD_LIBRARY_PATH adjusted"
+# Flavors include: simple, full and none
+
+# look at build.config (not a version controlled file and
+# create ulex.scm and dbmgr.scm
+
+if [[ -e transport-flavor ]];then
+ FLAVOR=$(cat transport-flavor)
+else
+ FLAVOR=simple
+fi
+
+sed -e "s/FLAVOR/$FLAVOR/" ulex.scm.template > ulex.scm
+sed -e "s/FLAVOR/$FLAVOR/" dbmgrmod.scm.template > dbmgrmod.scm
Index: dbfile.scm
==================================================================
--- dbfile.scm
+++ dbfile.scm
@@ -23,25 +23,41 @@
(declare (uses commonmod))
(module dbfile
*
- (import scheme
- chicken
- data-structures
- extras
- matchable)
-
-(import (prefix sqlite3 sqlite3:)
- posix typed-records srfi-18 srfi-1
- srfi-69
- stack
- files
- ports
-
- commonmod
- )
+ (import
+ scheme
+
+ chicken.base
+ chicken.condition
+ chicken.file
+ chicken.file.posix
+ chicken.io
+ chicken.port
+ chicken.process
+ chicken.process-context.posix
+ chicken.sort
+ chicken.time
+ chicken.string
+
+ ;; data-structures
+ ;; extras
+ matchable
+ (prefix sqlite3 sqlite3:)
+ ;; posix
+ typed-records
+ srfi-18
+ srfi-1
+ srfi-69
+ stack
+ system-information
+ ;; files
+ ;; ports
+
+ commonmod
+ )
;; (import debugprint)
;;======================================================================
;; R E C O R D S
@@ -312,11 +328,11 @@
;;
;; NOTE: returns a dbdat not a dbstruct!
;;
(define (dbfile:open-sqlite3-db dbpath init-proc)
(let* ((dbexists (file-exists? dbpath))
- (write-access (file-write-access? dbpath))
+ (write-access (file-writable? dbpath))
(db (dbfile:cautious-open-database dbpath init-proc))) #;(sqlite3:open-database dbpath)
(dbfile:inc-db-open dbpath)
(sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 10000))
(sqlite3:execute db (conc "PRAGMA synchronous = 0;"))
;; (init-proc db)
@@ -491,11 +507,11 @@
(retry (lambda ()
(thread-sleep! delay-time)
(if (> tries-left 0)
(dbfile:cautious-open-database fname init-proc (- tries-left 1))))))
(assert (>= tries-left 0) (conc "FATAL: too many attempts in dbfile:cautious-open-database of "fname", giving up."))
- (if (and (file-write-access? fname)
+ (if (and (file-writable? fname)
(file-exists? busy-file))
(begin
(dbfile:print-err "INFO: dbfile:cautious-open-database: journal file " busy-file " exists, trying again in few seconds.")
(thread-sleep! 1)
(if (eq? tries-left 2)
@@ -886,17 +902,17 @@
-3)
((not (sqlite3:database? (dbr:dbdat-dbh todb)))
(dbfile:print-err "db:sync-tables called with todb not a database " todb)
-4)
- ((not (file-write-access? (dbr:dbdat-dbfile todb)))
+ ((not (file-writable? (dbr:dbdat-dbfile todb)))
(dbfile:print-err "db:sync-tables called with todb not a read-only database " todb)
-5)
((not (null? (let ((readonly-slave-dbs
(filter
(lambda (dbdat)
- (not (file-write-access? (dbr:dbdat-dbfile todb))))
+ (not (file-writable? (dbr:dbdat-dbfile todb))))
slave-dbs)))
(for-each
(lambda (bad-dbdat)
(dbfile:print-err "db:sync-tables called with todb not a read-only database " bad-dbdat))
readonly-slave-dbs)
@@ -905,11 +921,11 @@
;; (dbfile:print-err "db:sync-tables: args are good")
(let ((stmts (make-hash-table)) ;; table-field => stmt
(all-stmts '()) ;; ( ( stmt1 value1 ) ( stml2 value2 ))
(numrecs (make-hash-table))
- (start-time (current-milliseconds))
+ (start-time (current-process-milliseconds))
(tot-count 0))
(for-each ;; table
(lambda (tabledat)
(let* ((tablename (car tabledat))
(fields (cdr tabledat))
@@ -1063,11 +1079,11 @@
(append (list todb) slave-dbs)
)
)
)
tbls)
- (let* ((runtime (- (current-milliseconds) start-time))
+ (let* ((runtime (- (current-process-milliseconds) start-time))
(should-print (or ;; (debug:debug-mode 12)
(common:low-noise-print 120 "db sync" (> runtime 500))))) ;; low and high sync times treated as separate.
(if should-print (dbfile:print-err "INFO: db sync, total run time " runtime " ms"))
(for-each
(lambda (dat)
Index: dbmod.scm
==================================================================
--- dbmod.scm
+++ dbmod.scm
@@ -21,14 +21,19 @@
(declare (unit dbmod))
(module dbmod
*
-(import scheme chicken data-structures extras)
-(import (prefix sqlite3 sqlite3:)
- posix typed-records srfi-18
- srfi-69)
+(import
+ scheme
+ chicken.string
+ ;; chicken data-structures extras
+ (prefix sqlite3 sqlite3:)
+ ;; posix
+ typed-records srfi-18
+ srfi-69
+ )
(define (db:run-id->dbname run-id)
(cond
((number? run-id)(conc run-id ".db"))
((not run-id) "main.db")
Index: debugprint.scm
==================================================================
--- debugprint.scm
+++ debugprint.scm
@@ -6,15 +6,22 @@
*
;;(import scheme chicken data-structures extras files ports)
(import
scheme
- chicken
- data-structures
- posix
- ports
- extras
+ chicken.base
+ chicken.process-context
+ chicken.process-context.posix
+ chicken.time
+ chicken.port
+ chicken.time.posix
+ chicken.string
+ system-information
+ ;; data-structures
+ ;; posix
+ ;; ports
+ ;; extras
;; scheme
;; chicken.base
;; chicken.string
;; chicken.time
@@ -45,11 +52,11 @@
;; if we were handed a bad verbosity rule then we will override it with 1 and continue
(if (not (verbosity))(verbosity 1))
(if (and (not (args:get-arg "-debug-noprop"))
(or (args:get-arg "-debug")
(not (get-environment-variable "MT_DEBUG_MODE"))))
- (setenv #;set-environment-variable! "MT_DEBUG_MODE" (if (list? (verbosity))
+ (set-environment-variable! "MT_DEBUG_MODE" (if (list? (verbosity))
(string-intersperse (map conc (verbosity)) ",")
(conc (verbosity)))))))
;; check verbosity, #t is ok
(define (debug:check-verbosity verbosity vstr)
Index: diff-report.scm
==================================================================
--- diff-report.scm
+++ diff-report.scm
@@ -17,15 +17,18 @@
;;
(declare (unit diff-report))
(declare (uses common))
(declare (uses rmt))
+(declare (uses ducttape-lib))
(include "common_records.scm")
-(use matchable)
-(use fmt)
-(use ducttape-lib)
+(import
+ matchable
+ fmt
+ ducttape-lib)
+
(define css "")
(define (diff:tests-mindat->hash tests-mindat)
(let* ((res (make-hash-table)))
(for-each
Index: ducttape/ducttape-lib.scm
==================================================================
--- ducttape/ducttape-lib.scm
+++ ducttape/ducttape-lib.scm
@@ -44,24 +44,55 @@
isodate->wwdate
wwdate->seconds
wwdate->isodate
current-wwdate
current-isodate
- *this-exe-dir*
- *this-exe-name*
- *this-exe-fullpath*
+ ;; *this-exe-dir*
+ ;; *this-exe-name*
+ ;; *this-exe-fullpath*
)
- (import scheme chicken extras ports data-structures )
- (use posix regex ansi-escape-sequences test srfi-1 irregex slice srfi-13 rfc3339)
- ;;scsh-process ;; dropping scsh-process, it was clobbering posix's process and process*
- (use directory-utils uuid-lib filepath srfi-19 ) ; linenoise
-
- ;; plugs a hole in posix-extras in latter chicken versions
- (use posix-extras pathname-expand files)
- (define ##sys#expand-home-path pathname-expand)
- (define (realpath x) (resolve-pathname (pathname-expand (or x "/dev/null")) ))
+(import
+ scheme
+ ;; chicken extras ports data-structures )
+ ;; (use posix
+ regex ansi-escape-sequences test srfi-1
+
+ chicken.base
+ chicken.condition
+ chicken.file
+ chicken.file.posix
+ chicken.format
+ chicken.irregex
+ chicken.io
+ chicken.string
+ chicken.time
+ chicken.time.posix
+ chicken.pathname
+ chicken.port
+ chicken.process
+ chicken.process-context
+ chicken.process-context.posix
+
+ slice
+ srfi-13
+ srfi-19
+ rfc3339
+ ;;scsh-process ;; dropping scsh-process, it was clobbering posix's process and process*
+ ;; directory-utils
+ uuid-lib
+ ;; filepath srfi-19 ) ; linenoise
+
+ ;; plugs a hole in posix-extras in latter chicken versions
+ ;; (use posix-extras pathname-expand files)
+ srfi-19
+ test
+;;(use format)
+ )
+
+ ;; (define ##sys#expand-home-path pathname-expand)
+;; (define (realpath x) (resolve-pathname (pathname-expand (or x "/dev/null")) ))
;; (include "mimetypes.scm") ; provides ext->mimetype
;; (include "workweekdate.scm")
;; gathered from macosx:
@@ -841,14 +872,10 @@
("avi" . "video/x-msvideo")
("movie" . "video/x-sgi-movie")
("smv" . "video/x-smv")
("ice" . "x-conference/x-cooltalk")))
-(use srfi-19)
-(use test)
-;;(use format)
-(use regex)
;(declare (unit wwdate))
;; utility procedures to convert among
;; different ways to express date (wwdate, seconds since epoch, isodate)
;;
;; samples:
@@ -1058,19 +1085,19 @@
(if (null? rest-path-items)
#f
(let* ((this-dir (car rest-path-items))
(next-rest (cdr rest-path-items))
(candidate (conc this-dir "/" exe)))
- (if (file-execute-access? candidate)
+ (if (file-executable? candidate)
candidate
(loop next-rest)))))))
;;;; define some handy globals
;; resolve fullpath to this script or binary.
- (define (__get-this-script-fullpath #!key (argv (argv)))
+ #;(define (__get-this-script-fullpath #!key (argv (argv)))
(let* ((this-script
(cond
((and (> (length argv) 2)
(string-match "^(.*/csi|csi)$" (car argv))
(string-match "^-(s|ss|sx|script)$" (cadr argv)))
@@ -1079,13 +1106,13 @@
;;(foo (begin (print "hello "(find-exe "/bin/sh") #f)))
(fullpath (or (find-exe this-script) (realpath this-script))))
fullpath))
- (define *this-exe-fullpath* (__get-this-script-fullpath))
- (define *this-exe-dir* (pathname-directory *this-exe-fullpath*))
- (define *this-exe-name* (pathname-strip-directory *this-exe-fullpath*))
+ ;; (define *this-exe-fullpath* (__get-this-script-fullpath))
+ ;; (define *this-exe-dir* (pathname-directory *this-exe-fullpath*))
+ ;; (define *this-exe-name* (pathname-strip-directory *this-exe-fullpath*))
;;;; utility procedures
@@ -1247,15 +1274,15 @@
(let ((num-debug-level (runs-ok (string->number raw-debug-level))))
(if (integer? num-debug-level)
(begin
(let ((new-num-debug-level (- num-debug-level 1)))
(if (> new-num-debug-level 0) ;; decrement
- (setenv "DUCTTAPE_DEBUG_LEVEL" (number->string new-num-debug-level))
- (unsetenv "DUCTTAPE_DEBUG_LEVEL")))
+ (set-environment-variable! "DUCTTAPE_DEBUG_LEVEL" (number->string new-num-debug-level))
+ (unset-environment-variable! "DUCTTAPE_DEBUG_LEVEL")))
num-debug-level) ; it was set and > 0, mode is value
(begin
- (unsetenv "DUCTTAPE_DEBUG_LEVEL") ;; value was invalid, unset it
+ (unset-environment-variable! "DUCTTAPE_DEBUG_LEVEL") ;; value was invalid, unset it
#f))) ; value was invalid, mode is f
#f)))) ; var not set, mode is f
(define ducttape-debug-mode (if (ducttape-debug-level) #t #f))
@@ -1360,11 +1387,11 @@
(user (or (get-environment-variable "USER") "nouser"))
(host (or (get-environment-variable "HOST") "nohost")))
(if logfile
(begin
(ducttape-log-file logfile)
- (setenv "DUCTTAPE_LOG_FILE" (ducttape-log-file))))
+ (set-environment-variable! "DUCTTAPE_LOG_FILE" (ducttape-log-file))))
(ducttape-append-logfile 'note (format #f "START - pid=~A ppid=~A argv=(~A) pwd=~A user=~A host=~A" pid ppid argv pwd user host) #t)))
;; log exit code
(define (set-ducttape-log-exit-handler)
@@ -1500,12 +1527,10 @@
(if dir dir (get-tmpdir))
"/" prefix ".XXXXXX"))))
(close-output-port (open-output-file* fd))
path))
-
-
;;http://stackoverflow.com/questions/11134857/using-sendmail-for-html-body-and-binary-attachment
;; write send-email using:
;; - isys-foreach-stdin-line
;; - formatting in http://stackoverflow.com/questions/11134857/using-sendmail-for-html-body-and-binary-attachment
(define (sendmail to_addr subject body
@@ -1575,13 +1600,13 @@
(wl body)
(body-boundary))
(define (attach-file file #!key (content-id #f))
(let* ((filename
- (filepath:take-file-name file))
+ (pathname-file file))
(ext-with-dot
- (filepath:take-extension file))
+ (pathname-extension file))
(ext (string-take-right
ext-with-dot
(- (string-length ext-with-dot) 1)))
(mimetype (ext->mimetype ext))
(uuencode-command (conc "uuencode " file " " filename)))
@@ -1702,40 +1727,40 @@
;; --quiet
(let ((quiet-opts (skim-cmdline-opts-noarg-by-regex "--?quiet")))
(if (not (null? quiet-opts))
(begin
- (setenv "DUCTTAPE_QUIET_MODE" "1")
+ (set-environment-variable! "DUCTTAPE_QUIET_MODE" "1")
(ducttape-quiet-mode "1"))))
;; --silent
(let ((silent-opts (skim-cmdline-opts-noarg-by-regex "--?silent")))
(if (not (null? silent-opts))
(begin
- (setenv "DUCTTAPE_SILENT_MODE" "1")
+ (set-environment-variable! "DUCTTAPE_SILENT_MODE" "1")
(ducttape-silent-mode "1"))))
;; -color
(let ((color-opts (skim-cmdline-opts-noarg-by-regex "--?colou?r(ize)?")))
(if (not (null? color-opts))
(begin
- (setenv "DUCTTAPE_COLORIZE" "1")
+ (set-environment-variable! "DUCTTAPE_COLORIZE" "1")
(ducttape-color-mode "1"))))
;; -nocolor
(let ((nocolor-opts (skim-cmdline-opts-noarg-by-regex "--?nocolou?r(ize)?")))
(if (not (null? nocolor-opts))
(begin
- (unsetenv "DUCTTAPE_COLORIZE" )
+ (unset-environment-variable! "DUCTTAPE_COLORIZE" )
(ducttape-color-mode #f))))
;; -logfile
(let ((logfile-opts (skim-cmdline-opts-withargs-by-regex "--?log(-?file)?")))
(if (not (null? logfile-opts))
(begin
(ducttape-log-file (car (reverse logfile-opts)))
- (setenv "DUCTTAPE_LOG_FILE" (ducttape-log-file)))))
+ (set-environment-variable! "DUCTTAPE_LOG_FILE" (ducttape-log-file)))))
;; -d -dd -d#
(let ((debug-opts (skim-cmdline-opts-noarg-by-regex "-d(d*|\\d+)"))
(initial-debuglevel (if (ducttape-debug-level) (ducttape-debug-level) 0) ))
(if (not (null? debug-opts))
@@ -1750,19 +1775,19 @@
(ds (string-match "-(d+)" curopt))
(dnum (string-match "-d(\\d+)" curopt)))
(cond
(ds (loop restopts (+ debuglevel (string-length (cadr ds)))))
(dnum (loop restopts (string->number (cadr dnum)))))))))
- (setenv "DUCTTAPE_DEBUG_LEVEL" (number->string (ducttape-debug-level))))))
+ (set-environment-variable! "DUCTTAPE_DEBUG_LEVEL" (number->string (ducttape-debug-level))))))
;; -dp / --debug-pattern
(let ((debugpat-opts (skim-cmdline-opts-withargs-by-regex "--?(debug-pattern|dp)")))
(if (not (null? debugpat-opts))
(begin
(ducttape-debug-regex-filter (string-join debugpat-opts "|"))
- (setenv "DUCTTAPE_DEBUG_PATTERN" (ducttape-debug-regex-filter))))))
+ (set-environment-variable! "DUCTTAPE_DEBUG_PATTERN" (ducttape-debug-regex-filter))))))
;;; following code commented out; side effects not wanted on startup
;; immediately activate logfile (will be noop if logfile disabled)
;;(ducttape-activate-logfile)
Index: http-transport.scm
==================================================================
--- http-transport.scm
+++ http-transport.scm
@@ -14,16 +14,23 @@
;; 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 .
-(require-extension (srfi 18) extras tcp s11n)
-
-
-(use srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest posix-extras)
+(import
+ (srfi 18)
+ ;; extras
+ chicken.tcp
+ s11n
+ srfi-1
+ ;; posix
+ regex regex-case srfi-69
+ ;; hostinfo
+ md5 message-digest
+ ;;posix-extras
-(use spiffy uri-common intarweb http-client spiffy-request-vars intarweb spiffy-directory-listing)
+ spiffy uri-common intarweb http-client spiffy-request-vars intarweb spiffy-directory-listing)
;; Configurations for server
(tcp-buffer-size 2048)
(max-connections 2048)
Index: megatest.scm
==================================================================
--- megatest.scm
+++ megatest.scm
@@ -67,17 +67,24 @@
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "megatest-fossil-hash.scm")
-(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (prefix base64 base64:)
- readline apropos json http-client directory-utils typed-records
- http-client srfi-18 extras format)
+(import
+ (prefix sqlite3 sqlite3:) srfi-1
+ ;; posix
+ regex regex-case srfi-69 (prefix base64 base64:)
+ breadline apropos json http-client
+ ;; directory-utils
+ typed-records
+ http-client srfi-18
+ ;; extras
+ (chicken.format)
-;; Added for csv stuff - will be removed
-;;
-(use sparse-vectors)
+ ;; Added for csv stuff - will be removed
+ ;;
+ sparse-vectors)
(require-library mutils)
(define *usage-log-file* #f) ;; put path to file for logging usage in this var in the ~/.megatestrc file
(define *usage-use-seconds* #t) ;; for Epoc seconds in usage logging change this to #t in ~/.megatestrc file
@@ -2399,13 +2406,13 @@
(repl))
(else
(begin
(set! *db* dbstructs)
- (import extras) ;; might not be needed
+ ;; (import extras) ;; might not be needed
;; (import csi)
- (import readline)
+ (import breadline)
(import apropos)
(import dbfile)
;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ...
(if *use-new-readline*
Index: mtargs/mtargs.scm
==================================================================
--- mtargs/mtargs.scm
+++ mtargs/mtargs.scm
@@ -26,12 +26,19 @@
print-args
any-defined?
help
)
-(import scheme chicken data-structures extras posix ports files)
-(use srfi-69 srfi-1)
+ (import
+ scheme
+ chicken.base
+ chicken.process-context
+ ;; scheme
+ ;; chicken data-structures extras posix ports files
+ srfi-69
+ srfi-1
+ )
(define arg-hash (make-hash-table))
(define help "")
(define (get-arg arg . default)
Index: mtut.scm
==================================================================
--- mtut.scm
+++ mtut.scm
@@ -13,27 +13,35 @@
;; 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 .
;;
+
+(declare (uses common))
+(declare (uses margs))
+(declare (uses configf))
+(declare (uses pkts))
+;; (declare (uses rmt))
;; (include "common.scm")
(include "megatest-version.scm")
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)
-(use srfi-1 posix srfi-69 readline ;; regex regex-case srfi-69 apropos json http-client directory-utils rpc typed-records;; (srfi 18) extras)
- srfi-19 srfi-18 extras format pkts regex regex-case
- (prefix dbi dbi:)
- (prefix sqlite3 sqlite3:)
- nanomsg)
-
-(declare (uses common))
-(declare (uses margs))
-(declare (uses configf))
-;; (declare (uses rmt))
+(import
+ srfi-1
+ ;; posix
+ srfi-69 breadline ;; regex regex-case srfi-69 apropos json http-client directory-utils rpc typed-records;; (srfi 18) extras)
+ srfi-19 srfi-18
+ ;; extras
+ chicken.format
+ pkts regex regex-case
+ (prefix dbi dbi:)
+ (prefix sqlite3 sqlite3:)
+ nanomsg)
+
(use ducttape-lib)
(include "megatest-fossil-hash.scm")
@@ -1951,13 +1959,13 @@
(exit)))
(if (or (args:get-arg "-repl")
(args:get-arg "-load"))
(begin
- (import extras) ;; might not be needed
+ ;; (import extras) ;; might not be needed
;; (import csi)
- (import readline)
+ (import breadline)
(import apropos)
;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ...
(install-history-file (get-environment-variable "HOME") ".mtutil_history") ;; [homedir] [filename] [nlines])
(current-input-port (make-readline-port "mtutil> "))
Index: pkts/pkts.scm
==================================================================
--- pkts/pkts.scm
+++ pkts/pkts.scm
@@ -162,12 +162,20 @@
;; utility procs
increment-string ;; used to get indexes for strings in ref pkts
make-report ;; make a .dot file
)
-(import chicken scheme data-structures posix srfi-1 regex srfi-13 srfi-69 ports extras)
-(use crypt sha1 message-digest (prefix dbi dbi:) typed-records)
+
+(import
+ ;; chicken
+ scheme
+ ;; data-structures posix
+ srfi-1 regex srfi-13 srfi-69
+ ;; ports extras)
+ crypt sha1 message-digest
+ (prefix dbi dbi:)
+ typed-records)
;;======================================================================
;; DATA MANIPULATION UTILS
;;======================================================================
Index: portlogger.scm
==================================================================
--- portlogger.scm
+++ portlogger.scm
@@ -15,14 +15,22 @@
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see .
;;
-(require-extension (srfi 18) extras tcp s11n)
+(import
+ (srfi 18)
+ ;; chicken.tcp
+ s11n
-(use sqlite3 srfi-1 posix srfi-69 hostinfo dot-locking z3)
-(import (prefix sqlite3 sqlite3:))
+ srfi-1
+ ;; posix
+ srfi-69
+ ;; hostinfo
+ ;; dot-locking
+ z3
+ (prefix sqlite3 sqlite3:))
(declare (unit portlogger))
(declare (uses db))
;; lsof -i
Index: runs.scm
==================================================================
--- runs.scm
+++ runs.scm
@@ -15,13 +15,17 @@
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see .
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
-(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18)
- posix-extras directory-utils pathname-expand typed-records format sxml-serializer
- sxml-modifications matchable)
+(import
+ (prefix sqlite3 sqlite3:) srfi-1
+ ;; posix
+ regex regex-case srfi-69 (srfi 18)
+ ;; posix-extras directory-utils pathname-expand
+ typed-records format sxml-serializer
+ sxml-modifications matchable)
(declare (unit runs))
(declare (uses db))
(declare (uses common))
(declare (uses items))
Index: server.scm
==================================================================
--- server.scm
+++ server.scm
@@ -14,16 +14,27 @@
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see .
;;
-(require-extension (srfi 18) extras tcp s11n)
+(import
+ (srfi 18)
+ ;; extras
+ chicken.tcp
+ s11n
-(use srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest
- directory-utils posix-extras matchable utils)
+ srfi-1
+ ;; posix
+ regex regex-case srfi-69
+ ;; hostinfo
+ md5 message-digest
+ ;; directory-utils posix-extras
+ matchable
+ ;; utils
-(use spiffy uri-common intarweb http-client spiffy-request-vars)
+ spiffy uri-common intarweb http-client spiffy-request-vars
+ )
(declare (unit server))
(declare (uses commonmod))
Index: tdb.scm
==================================================================
--- tdb.scm
+++ tdb.scm
@@ -20,14 +20,19 @@
;;======================================================================
;; Database access
;;======================================================================
-(require-extension (srfi 18) extras tcp)
-(use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64)
-(import (prefix sqlite3 sqlite3:))
-(import (prefix base64 base64:))
+(import
+ (srfi 18)
+ ;; extras tcp)
+
+ sqlite3 srfi-1
+ ;; posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64
+
+ (prefix sqlite3 sqlite3:)
+ (prefix base64 base64:))
(declare (unit tdb))
(declare (uses common))
(declare (uses keys))
(declare (uses ods))