Index: apimod.scm
==================================================================
--- apimod.scm
+++ apimod.scm
@@ -204,10 +204,11 @@
;; SERVERS
;; ((start-server) (apply server:kind-run params))
((kill-server) (set! *server-run* #f))
((get-server) (api:start-server dbstruct params))
+ ((get-server-info) (apply db:get-server-info dbstruct params))
((register-server) (apply db:register-server dbstruct params) );; dbstruct host port servkey pid ipaddr dbpath)
((deregister-server) (apply db:deregister-server dbstruct params) );; dbstruct host port servkey pid ipaddr dbpath)
((get-count-servers) (apply db:get-count-servers dbstruct params))
;; TESTS
ADDED build-assist/README
Index: build-assist/README
==================================================================
--- /dev/null
+++ build-assist/README
@@ -0,0 +1,28 @@
+Here is how I like to install chicken for building Megatest.
+
+This guide assumes you have the Megatest fossil and are in the build-assist directory and
+that you have the opensrc fossil with uv synced:
+
+fossil clone https://www.kiatoa.com/fossils/megatest
+fossil clone https://www.kiatoa.com/fossils/opensrc;cd opensrc;fossil uv sync
+
+Make a build directory and go to it:
+
+mkdir build;cd build
+
+Make a destination directory and set PREFIX
+
+export PREFIX=/opt/chicken/5.3.0; mkdir -p $PREFIX
+
+Get chicken:
+
+wget https://code.call-cc.org/releases/5.3.0/chicken-5.3.0.tar.gz
+
+Extract, build, and install chicken:
+
+tar xf chicken-5.3.0.tar.gz; cd chicken-5.3.0; make PLATFORM=linux PREFIX=$PREFIX install; cd ..
+
+Install all needed eggs.
+for egg in $(cat ../ck5-egg.list);do echo $egg;ck5 chicken-install $egg;done
+
+Now run the script ../iup-compile.sh for remaining instructions
Index: build-assist/ck5
==================================================================
--- build-assist/ck5
+++ build-assist/ck5
@@ -1,9 +1,17 @@
#!/bin/bash
-export PATH=/home/matt/data/buildall/ck5.2/bin:$PATH
-if [[ -z /home/matt/data/buildall/ck5.2/lib:/home/matt/data/buildall/ck5.2/lib64 ]];then
- export LD_LIBRARY_PATH=/home/matt/data/buildall/ck5.2/lib:/home/matt/data/buildall/ck5.2/lib64:$LD_LIBRARY_PATH
+# /opt/chicken/5.3.0
+# WHICHCKVER=5.1.0_WW45
+WHICHCKVER=5.3.0
+
+BASEDIR=/opt/chicken/$WHICHCKVER
+export PATH="$BASEDIR/bin:$PATH"
+
+NEW_LD_LIBRARY_PATH="$BASEDIR/lib:$BASEDIR/lib64"
+if [[ -z "$LD_LIBRARY_PATH" ]];then
+ export LD_LIBRARY_PATH=$NEW_LD_LIBRARY_PATH
else
- export LD_LIBRARY_PATH=/home/matt/data/buildall/ck5.2/lib:/home/matt/data/buildall/ck5.2/lib64
+ export LD_LIBRARY_PATH="$NEW_LD_LIBRARY_PATH:$LD_LIBRARY_PATH"
fi
-export CHICKEN_DOC_PAGER=cat
+
exec "$@"
+
Index: build-assist/ck5-eggs.list
==================================================================
--- build-assist/ck5-eggs.list
+++ build-assist/ck5-eggs.list
@@ -1,5 +1,6 @@
+csm
address-info
ansi-escape-sequences
apropos
base64
crypt
ADDED build-assist/installing-nng
Index: build-assist/installing-nng
==================================================================
--- /dev/null
+++ build-assist/installing-nng
@@ -0,0 +1,23 @@
+wget https://github.com/nanomsg/nng/archive/refs/tags/v1.5.2.tar.gz
+tar xf v1.5.2.tar.gz
+cd nng-1.5.2
+mkdir build
+cd build
+make
+sudo make install
+vi CMakeCache.txt
+
+Change OFF to ON for shared libraries:
+
+//Build shared library
+BUILD_SHARED_LIBS:BOOL=ON
+
+make
+sudo make install
+sudo ldconfig
+
+chicken-install nng
+-or-
+git clone https://gitlab.com/ariSun/chicken-nng.git
+cd chicken-ngg;chicken-install
+
Index: build-assist/iup-compile.sh
==================================================================
--- build-assist/iup-compile.sh
+++ build-assist/iup-compile.sh
@@ -4,11 +4,16 @@
fi
echo "Put iup, im and cd .a and .so files in PREFIX/lib"
echo " 1. get opensrc fossil from https://www.kiatoa.com/fossils/opensrc"
echo " 2. list the unversioned files and export the cd, im and iup lib for your kernel (try uname -a for the kernel number) 4.15 ==> 415_64"
+echo ' for x in $(fossil uv list | grep 415| awk ''{print $6}'');do targ=$(echo $x|cut -d/ -f3); fossil uv export $x $targ; done'
echo " 3. untar iup, im and cp tars into a clean working dir and then copy:"
+echo " find . -name \*.a -print -exec cp {} $PREFIX/lib \;"
+echo " find . -name \*.so -print -exec cp {} $PREFIX/lib \;"
+echo " rsync -av include/ $PREFIX/include/"
+echo " or (depending on versions and what you see in the iup tars - they seem to vary"
echo " cp *.a *.so $PREFIX/lib"
echo " cp include/*.h $PREFIX/include"
echo " 4. run the chicken-install like this:"
echo "If you use a wrapper (e.g. ck5) to create the chicken environment:"
Index: dashboard.scm
==================================================================
--- dashboard.scm
+++ dashboard.scm
@@ -42,10 +42,11 @@
(declare (uses subrunmod))
(declare (uses tree))
(declare (uses vgmod))
(declare (uses testsmod))
(declare (uses tasksmod))
+(declare (uses dbi))
;; needed for configf scripts, scheme etc.
;; (declare (uses apimod.import))
;; (declare (uses debugprint.import))
;; (declare (uses mtargs.import))
@@ -89,10 +90,11 @@
(prefix iup iup:)
canvas-draw
canvas-draw-iup
(prefix sqlite3 sqlite3:)
+ (prefix dbi dbi:)
srfi-1
regex regex-case srfi-69
typed-records
sparse-vectors
format
@@ -2842,11 +2844,11 @@
(dashboard:runs-horizontal-slider runs-dat))))
controls
))
(views-cfgdat (common:load-views-config))
(additional-tabnames '())
- (tab-start-num 5) ;; DON'T FORGET TO UPDATE THIS WHEN CHANGING THE STANDARD TABS BELOW
+ (tab-start-num 6) ;; DON'T FORGET TO UPDATE THIS WHEN CHANGING THE STANDARD TABS BELOW
;; (data (dboard:tabdat-init (make-d:data)))
(additional-views ;; process views-dat
(let ((tab-num tab-start-num)
(result '()))
(for-each
@@ -2889,18 +2891,21 @@
runs-view
;; (make-runs-view commondat runs2-dat 2)
(dashboard:runs-summary commondat onerun-dat tab-num: 2)
(dashboard:run-controls commondat runcontrols-dat tab-num: 3)
(dashboard:run-times commondat runtimes-dat tab-num: 4)
+ (iup:vbox (iup:button "Pushme")) ;; tab 5
additional-views)))
;; (set! (iup:callback tabs tabchange-cb:) (lambda (a b c)(print "SWITCHED TO TAB: " a " " b " " c)))
(iup:attribute-set! tabs "TABTITLE0" "Summary")
(iup:attribute-set! tabs "TABTITLE1" "Runs")
;; (iup:attribute-set! tabs "TABTITLE2" "Runs2")
(iup:attribute-set! tabs "TABTITLE2" "Run Summary")
(iup:attribute-set! tabs "TABTITLE3" "Run Control")
(iup:attribute-set! tabs "TABTITLE4" "Run Times")
+ (iup:attribute-set! tabs "TABTITLE5" "Sys Status")
+
;; (iup:attribute-set! tabs "TABTITLE3" "New View")
;; (iup:attribute-set! tabs "TABTITLE4" "Run Control")
;; set the tab names for user added tabs
(for-each
Index: dbi.scm
==================================================================
--- dbi.scm
+++ dbi.scm
@@ -17,7 +17,8 @@
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
(declare (unit dbi))
+(declare (uses autoload))
(include "dbi/dbi.scm")
Index: dbmod.scm
==================================================================
--- dbmod.scm
+++ dbmod.scm
@@ -44,15 +44,16 @@
db:get-ddb
db:open-dbdat
db:open-run-db
db:open-inmem-db
db:setup
-db:get-main-lock
+;; db:get-main-lock
db:with-lock-db
db:get-iam-server-lock
db:get-locker
db:take-lock
+db:steal-lock-db
db:release-lock
db:general-sqlite-error-dump
db:first-result-default
db:generic-error-printout
db:with-db
@@ -511,11 +512,11 @@
;; The lockname is the filename (can have many to one, run-id to fname
;;======================================================================
;; only use for main.db - need to re-write some of this :(
;;
-(define (db:get-main-lock dbfile)
+#;(define (db:get-main-lock dbfile)
(db:with-lock-db dbfile
(lambda (dbh dbfile)
(db:get-iam-server-lock dbh dbfile))))
(define (db:with-lock-db dbfile proc)
@@ -524,34 +525,39 @@
;; (sqlite3:finalize! dbh)
res))
;; called before db is open?
;;
-(define (db:get-iam-server-lock dbh dbfname)
+(define (db:get-iam-server-lock dbh dbfname port)
(sqlite3:with-transaction
dbh
(lambda ()
(let* ((locker (db:get-locker dbh dbfname)))
(if locker
- #f
- (db:take-lock dbh dbfname))))))
+ locker
+ (db:take-lock dbh dbfname port))))))
;; (exn sqlite3)
(define (db:get-locker dbh dbfname)
(condition-case
- (sqlite3:first-row dbh "SELECT owner_pid,owner_host,event_time FROM locks WHERE lockname=?;" dbfname)
+ (sqlite3:first-row dbh "SELECT owner_pid,owner_host,owner_port,event_time FROM locks WHERE lockname=?;" dbfname)
(exn (sqlite3) #f)))
;; should never fail because it is run in a transaction with a test for the lock
;;
-(define (db:take-lock dbh dbfname)
+(define (db:take-lock dbh dbfname port)
;; (condition-case
;; (begin
- (sqlite3:execute dbh "INSERT INTO locks (lockname,owner_pid,owner_host) VALUES (?,?,?);" dbfname (current-process-id) (get-host-name))
+ (sqlite3:execute dbh "INSERT INTO locks (lockname,owner_pid,owner_host,owner_port) VALUES (?,?,?,?);" dbfname (current-process-id) (get-host-name) port)
;; #t)
;; (exn (sqlite3) #f)))
#t)
+
+(define (db:steal-lock-db dbh dbfname port)
+ (sqlite3:execute dbh "DELETE FROM locks WHERE lockname=?;" dbfname)
+ (sqlite3:execute dbh "INSERT INTO locks (lockname,owner_pid,owner_host,owner_port) VALUES (?,?,?,?);" dbfname (current-process-id) (get-host-name) port)
+ #t)
(define (db:release-lock dbh dbfname)
(sqlite3:execute dbh "DELETE FROM locks WHERE lockname=?;" dbfname))
;;======================================================================
@@ -1515,10 +1521,11 @@
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS locks
(id INTEGER PRIMARY KEY,
lockname TEXT,
owner_pid INTEGER,
owner_host TEXT,
+ owner_port TEXT,
event_time TIMESTAMP DEFAULT (strftime('%s','now')),
CONSTRAINT lock_constraint UNIQUE (lockname));")
;; maps to *srvpktspec* from http-transportmod
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS servers
Index: rmtmod.scm
==================================================================
--- rmtmod.scm
+++ rmtmod.scm
@@ -299,11 +299,12 @@
)))
;;======================================================================
;; FOR DEBUGGING SET TO #t
-(define *localmode* #t)
+;; (define *localmode* #t)
+(define *localmode* #f)
(define *dbstruct* (make-dbr:dbstruct))
;; Defaults to current area
;;
(define (rmt:send-receive cmd rid params #!key (attemptnum 1)(area-dat #f))
@@ -411,10 +412,13 @@
(rmt:send-receive 'kill-server run-id (list run-id)))
(define (rmt:start-server run-id)
(rmt:send-receive 'start-server 0 (list run-id)))
+(define (rmt:get-server-info apath dbname)
+ (rmt:send-receive 'get-server-info 0 (list 0 apath dbname)))
+
;;======================================================================
;; M I S C
;;======================================================================
(define (rmt:login run-id)
@@ -1487,12 +1491,16 @@
;; do a final sync here
(debug:print-info 0 *default-log-port* "Doing final sync for "apath" "dbfile" at "(current-seconds))
(db:sync-inmem->disk *dbstruct-db* apath dbfile force-sync: #t)
;; let's finalize here
(debug:print-info 0 *default-log-port* "Finalizing db and inmem")
- (sqlite3:finalize! db)
- (sqlite3:finalize! inmem)
+ (if (sqlite3:database? db)
+ (sqlite3:finalize! db)
+ (debug:print-info 0 *default-log-port* "in rmt:server-shutdown, db is not a database, not finalizing..."))
+ (if (sqlite3:database? inmem)
+ (sqlite3:finalize! inmem)
+ (debug:print-info 0 *default-log-port* "in rmt:server-shutdown, inmem is not a database, not finalizing..."))
(debug:print-info 0 *default-log-port* "Finalizing db and inmem complete")
(if am-server
(if (string-match ".*/main.db$" dbfile)
(let ((pkt-file (conc (get-pkts-dir *toppath*)
"/" (servdat-uuid *server-info*)
@@ -1676,18 +1684,18 @@
(set! *server-info* (make-servdat host: ipaddrstr port: portnum)))
(debug:print-info 0 *default-log-port* "rmt:try-start-server time="
(seconds->time-string (current-seconds))
" ipaddrsstr=" ipaddrstr
" portnum=" portnum)
- (if (is-port-in-use portnum)
- (begin
- (portlogger:open-run-close portlogger:set-failed portnum)
- (debug:print 0 *default-log-port* "WARNING: failed to start on portnum: " portnum ", trying next port")
- ;; (thread-sleep! 0.1)
- (rmt:try-start-server ipaddrstr
- (portlogger:open-run-close
- portlogger:find-port)))
+;;(if (is-port-in-use portnum)
+;; (begin
+;; (portlogger:open-run-close portlogger:set-failed portnum)
+;; (debug:print 0 *default-log-port* "WARNING: failed to start on portnum: " portnum ", trying next port")
+;; ;; (thread-sleep! 0.1)
+;; (rmt:try-start-server ipaddrstr
+;; (portlogger:open-run-close
+;; portlogger:find-port)))
(begin
(if (not *server-info*)
(set! *server-info* (make-servdat
host: ipaddrstr
port: portnum)))
@@ -1714,11 +1722,11 @@
(rmt:try-start-server ipaddrstr
(portlogger:open-run-close portlogger:find-port)))
(begin
(print "ERROR: Tried and tried but could not start the server, stopping at port "portnum))))
(nng-listen rep (conc "tcp://*:" portnum))
- rep)))))
+ rep)))) ;;)
;;======================================================================
;; S E R V E R U T I L I T I E S
;;======================================================================
@@ -1816,13 +1824,25 @@
;; NEW SERVER METHOD
;;======================================================================
;; only use for main.db - need to re-write some of this :(
;;
-(define (get-lock-db sdat dbfile)
- (let* ((dbh (db:open-run-db dbfile db:initialize-db))
- (res (db:get-iam-server-lock dbh dbfile)))
+(define (get-lock-db sdat dbfile port)
+ (let* ((dbh (db:open-run-db dbfile db:initialize-db)) ;; open-run-db creates a standard db with schema used by all situations
+ (res (db:get-iam-server-lock dbh dbfile port)))
+ ;; res => list then already locked, check server is responsive
+ ;; => #t then sucessfully got the lock
+ ;; => #f reserved for future use as to indicate something went wrong
+ (match res
+ ((owner_pid owner_host owner_port event_time)
+ (if (server-ready? owner_host owner_port "abc")
+ #f
+ (begin
+ (debug:print 0 *default-log-port* "WARNING: stale lock - have to steal it. This may fail.")
+ (db:steal-lock-db dbh dbfile port))))
+ (#t #t) ;; placeholder so that we don't touch res if it is #t
+ (else (set! res #f)))
(sqlite3:finalize! dbh)
res))
(define (register-server pkts-dir pkt-spec host port servkey ipaddr dbpath)
@@ -1918,10 +1938,29 @@
(let* ((spkt (car tail)))
(loop (cdr tail)
(if (equal? dbpath (alist-ref 'dbpath spkt))
(cons spkt res)
res))))))
+
+(define (remove-pkts-if-not-alive serv-pkts)
+ (filter (lambda (pkt)
+ (let* ((host (alist-ref 'host pkt))
+ (port (alist-ref 'port pkt))
+ (key (alist-ref 'servkey pkt))
+ (pktz (alist-ref 'Z pkt))
+ (res (handle-exceptions
+ exn
+ #f
+ (server-ready? host port key))))
+ (if res
+ res
+ (let* ((pktsdir (get-pkts-dir *toppath*))
+ (pktpath (conc pktsdir"/"pktz".pkt")))
+ (debug:print 0 *default-log-port* "WARNING: pkt with no server "pktpath)
+ (delete-file* pktpath)
+ #f))))
+ serv-pkts))
;; from viable servers get one that is alive and ready
;;
(define (get-the-server apath serv-pkts)
(let loop ((tail serv-pkts))
@@ -2005,32 +2044,39 @@
(servdat-host sdat) db-file))
;; (set! *my-signature* (servdat-uuid sdat)) ;; replace with Z, no, stick with proper key
;; now read pkts and see if we are a contender
(let* ((all-pkts (get-all-server-pkts pkts-dir *srvpktspec*))
(viables (get-viable-servers all-pkts db-file))
- (best-srv (get-best-candidate viables db-file))
- (best-srv-key (if best-srv (alist-ref 'servkey best-srv) #f)))
- (debug:print 0 *default-log-port* "best-srv-key: "best-srv-key", server-key: "server-key)
+ (alive (remove-pkts-if-not-alive viables))
+ (best-srv (get-best-candidate alive db-file))
+ (best-srv-key (if best-srv (alist-ref 'servkey best-srv) #f))
+ (i-am-srv (equal? best-srv-key server-key))
+ (delete-pkt (lambda ()
+ (let* ((pktfile (conc (get-pkts-dir *toppath*)
+ "/" (servdat-uuid *server-info*)
+ ".pkt")))
+ (debug:print-info 0 *default-log-port* "Attempting to remove bogus pkt file "pktfile)
+ (delete-file* pktfile))))) ;; remove immediately instead of waiting for on-exit
+ (debug:print 0 *default-log-port* "best-srv-key: "best-srv-key", server-key: "server-key", i-am-srv: "i-am-srv)
;; am I the best-srv, compare server-keys to know
- (if (equal? best-srv-key server-key)
- (if (get-lock-db sdat db-file) ;; (db:get-iam-server-lock *dbstruct-db* *toppath* run-id)
+ (if i-am-srv
+ (if (get-lock-db sdat db-file (servdat-port sdat)) ;; (db:get-iam-server-lock *dbstruct-db* *toppath* run-id)
(begin
(debug:print 0 *default-log-port* "I'm the server!")
(servdat-dbfile-set! sdat db-file)
(servdat-status-set! sdat 'db-locked))
(begin
(debug:print 0 *default-log-port* "I'm not the server, exiting.")
(bdat-time-to-exit-set! *bdat* #t)
+ (delete-pkt)
(thread-sleep! 0.2)
(exit)))
(begin
(debug:print 0 *default-log-port*
"Keys do not match "best-srv-key", "server-key", exiting.")
(bdat-time-to-exit-set! *bdat* #t)
- (delete-file* (conc (get-pkts-dir *toppath*)
- "/" (servdat-uuid *server-info*)
- ".pkt")) ;; remove immediately instead of waiting for on-exit
+ (delete-pkt)
(thread-sleep! 0.2)
(exit)))
sdat))
(begin ;; sdat not yet contains server info
(debug:print-info 0 *default-log-port* "Still waiting, last-sdat=" last-sdat)
@@ -2155,13 +2201,21 @@
(let ((res (rmt:register-server *rmt:remote*
*toppath* iface port
server-key dbname)))
(if res ;; we are the server
(servdat-status-set! *server-info* 'have-interface-and-db)
- (begin
- (debug:print 0 *default-log-port* "We are not the server for "dbname", exiting.")
- (exit)))))
+ (let* ((serv-info (rmt:get-server-info *toppath* dbname)))
+ (match serv-info
+ ((host port servkey pid ipaddr apath dbpath)
+ (if (not (server-ready? host port servkey))
+ (begin
+ (debug:print-info 0 *default-log-port* "Server registered but not alive. Removing and trying again.")
+ (rmt:deregister-server host port servkey pid ipaddr apath dbpath)
+ (loop (+ count 1) bad-sync-count start-time))))
+ (else
+ (debug:print 0 *default-log-port* "We are not the server for "dbname", exiting. Server info is: "serv-info)
+ (exit)))))))
(debug:print 0 *default-log-port*
"SERVER: running, db "dbname" opened, megatest version: "
(common:get-full-version))
;; start the watchdog
Index: stml2.scm
==================================================================
--- stml2.scm
+++ stml2.scm
@@ -18,8 +18,10 @@
;;======================================================================
(declare (unit stml2))
(declare (uses cookie))
+(declare (uses dbi))
+(declare (uses autoload))
(include "stml2/stml2.scm")
Index: stml2/formdat.scm
==================================================================
--- stml2/formdat.scm
+++ stml2/formdat.scm
@@ -10,12 +10,11 @@
;; (declare (unit formdat))
(module formdat
*
-(import chicken scheme data-structures extras srfi-13 ports )
-(use html-filter)
+(import chicken scheme data-structures extras srfi-13 ports html-filter)
-(use regex)
-(require-extension srfi-69)
+(import regex)
+(import srfi-69)
)
Index: stml2/html-filter.scm
==================================================================
--- stml2/html-filter.scm
+++ stml2/html-filter.scm
@@ -11,11 +11,11 @@
(module html-filter
*
(import chicken scheme data-structures extras srfi-13 ports )
-(use misc-stml)
+(import misc-stml)
-(require-extension regex)
+(import regex)
;;
)
Index: stml2/misc-stml.scm
==================================================================
--- stml2/misc-stml.scm
+++ stml2/misc-stml.scm
@@ -16,9 +16,8 @@
(module misc-stml
*
(import chicken scheme data-structures extras srfi-13 ports posix)
-(use regex (prefix dbi dbi:))
-(use (prefix crypt c:))
-(use (prefix dbi dbi:))
+(import regex (prefix dbi dbi:))
+(import (prefix crypt c:))
)
Index: stml2/rollup-pages.scm
==================================================================
--- stml2/rollup-pages.scm
+++ stml2/rollup-pages.scm
@@ -1,6 +1,6 @@
-(use regex posix srfi-69 srfi-1)
+(import regex posix srfi-69 srfi-1)
(define extract-rx (regexp "pages\\/(.*)_(view|ctrl).scm"))
(define (print-page-wrapper lookup page)
(print "(define (pages:" page " session db shared)")
Index: stml2/session.scm
==================================================================
--- stml2/session.scm
+++ stml2/session.scm
@@ -11,10 +11,9 @@
(module session
*
(import chicken scheme data-structures extras srfi-13 ports posix files srfi-1)
-(use (prefix dbi dbi:) srfi-69)
-(require-extension regex)
-(use cookie stmlcommon) ;; (declare (uses cookie))
+(import (prefix dbi dbi:) srfi-69 regex)
+(import cookie stmlcommon) ;; (declare (uses cookie))
)
Index: stml2/setup.scm
==================================================================
--- stml2/setup.scm
+++ stml2/setup.scm
@@ -9,13 +9,12 @@
(module setup
*
(import chicken scheme data-structures extras srfi-13 ports posix)
-(uses session misc-stml)
+(import session misc-stml)
;; (declare (unit setup))se
;; (declare (uses session))
-(require-extension srfi-69)
-(require-extension regex)
+(import srfi-69 regex)
)
Index: stml2/spiffyserver.scm
==================================================================
--- stml2/spiffyserver.scm
+++ stml2/spiffyserver.scm
@@ -1,8 +1,8 @@
;; This doesn't work yet
;;
-(use spiffy cgi-handler)
+(import spiffy cgi-handler)
(spiffy-debug-mode #t)
(spiffy-file-ext-handlers
`(("drcdb" . ,(cgi-handler* "/path/to/drcdb"))))
Index: stml2/sqlite3.scm
==================================================================
--- stml2/sqlite3.scm
+++ stml2/sqlite3.scm
@@ -9,11 +9,11 @@
;;
;; I used this to get a simple interactive sqlite editor on the nokia n800
;; since I couldn't get sqlite3 to install (for reasons I can't remember).
-(use sqlite3)
+(import sqlite3)
(define args (argv))
(define num-args (length args))
(define dbname #f)
Index: stml2/stmlcommon.scm
==================================================================
--- stml2/stmlcommon.scm
+++ stml2/stmlcommon.scm
@@ -13,8 +13,8 @@
(module stmlcommon
*
(import chicken scheme data-structures extras srfi-13 ports posix)
-(use (prefix dbi dbi:) regex (prefix crypt c:) srfi-69)
+(import (prefix dbi dbi:) regex (prefix crypt c:) srfi-69)
)
Index: stml2/stmlrun.scm
==================================================================
--- stml2/stmlrun.scm
+++ stml2/stmlrun.scm
@@ -11,9 +11,9 @@
;; (require-extension syntax-case)
;; (declare (run-time-macros))
;; (include "stmlcommon.scm")
-(require-library stml)
+(import stml)
(stml:main #f)
Index: stml2/test.scm
==================================================================
--- stml2/test.scm
+++ stml2/test.scm
@@ -1,8 +1,7 @@
-(use test md5)
+(import test md5)
-(require-extension sqlite3)
(import (prefix sqlite3 sqlite3:))
(require-library dbi)
;; (declare (uses stml))
Index: tests/tests.scm
==================================================================
--- tests/tests.scm
+++ tests/tests.scm
@@ -15,11 +15,18 @@
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
-(import srfi-18 test)
+(import srfi-18
+ test
+ chicken.string
+ chicken.process-context
+ chicken.file
+ chicken.pretty-print
+ commonmod
+ )
(define test-work-dir (current-directory))
;; given list of lists
;; ( ( msg expected param1 param2 ...)
Index: testsmod.scm
==================================================================
--- testsmod.scm
+++ testsmod.scm
@@ -26,10 +26,11 @@
(declare (uses itemsmod))
(declare (uses rmtmod))
(declare (uses stml2))
(declare (uses dbmod))
(declare (uses tasksmod))
+(declare (uses dbi))
(module testsmod
*
(import scheme