Overview
Context
Changes
Modified Makefile
from [7a836bf2ef]
to [7124e619b5].
︙ | | |
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
|
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
|
-
+
-
+
+
+
+
+
+
+
|
else \
echo "(define *use-new-readline* #t)" > readline-fix.scm;\
fi
altdb.scm :
echo ";; optional alternate db setup" > altdb.scm
echo "(define *available-db* (make-hash-table))" >> altdb.scm
if csi -ne '(use mysql-client)';then \
if csi -ne '(use mysql-client)' &> /dev/null;then \
echo "(use mysql-client)(hash-table-set! *available-db* 'mysql #t)" >> altdb.scm; \
fi
if csi -ne '(use postgresql)';then \
if csi -ne '(use postgresql)'&> /dev/null;then \
echo "(use postgresql)(hash-table-set! *available-db* 'postgresql #t)" >> altdb.scm;\
fi
if csi -ne '(import mysql-client)'&> /dev/null;then \
echo "(import mysql-client)(hash-table-set! *available-db* 'mysql #t)" >> altdb.scm; \
fi
if csi -ne '(import postgresql)'&> /dev/null;then \
echo "(import postgresql)(hash-table-set! *available-db* 'postgresql #t)" >> altdb.scm;\
fi
portlogger-example : portlogger-example.scm api.o archive.o client.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o genexample.o gutils.o http-transport.o items.o keys.o launch.o lock-queue.o margs.o mt.o ods.o portlogger.o process.o rmt.o runconfig.o runs.o server.o synchash.o tasks.o tdb.o tests.o tree.o
csc $(CSCOPTS) portlogger-example.scm api.o archive.o client.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o genexample.o gutils.o http-transport.o items.o keys.o launch.o lock-queue.o margs.o mt.o ods.o portlogger.o process.o rmt.o runconfig.o runs.o server.o synchash.o tasks.o tdb.o tests.o tree.o
# create a pdf dot graphviz diagram from notations in rmt.scm
rmt.pdf : rmt.scm
grep ';;DOT' rmt.scm | sed -e 's/.*;;DOT //' > rmt.dot;dot -Tpdf rmt.dot -o rmt.pdf
|
︙ | | |
Modified commonmod.scm
from [ff27fc279a]
to [9d9e59dd4a].
︙ | | |
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
;; (declare (uses debugprint))
(use srfi-69)
(module commonmod
*
(import scheme
chicken
(prefix sqlite3 sqlite3:)
data-structures
extras
files
matchable
md5
message-digest
pathname-expand
posix
posix-extras
regex
regex-case
srfi-1
srfi-18
srfi-69
typed-records
;; debugprint
)
(import scheme)
(cond-expand
(chicken-4
(import chicken
(prefix sqlite3 sqlite3:)
data-structures
extras
files
matchable
md5
message-digest
pathname-expand
posix
posix-extras
regex
regex-case
srfi-1
srfi-18
srfi-69
typed-records)
(use srfi-69))
(chicken-5
(import (prefix sqlite3 sqlite3:)
;; data-structures
;; extras
;; files
;; posix
;; posix-extras
chicken.base
chicken.condition
chicken.file
chicken.file.posix
chicken.io
chicken.pathname
chicken.process
chicken.process-context
chicken.process-context.posix
chicken.sort
chicken.string
chicken.time
chicken.time.posix
matchable
md5
message-digest
pathname-expand
regex
regex-case
srfi-1
srfi-18
srfi-69
typed-records
system-information
)))
;;======================================================================
;; CONTENTS
;;
;; config file utils
;; misc conversion, data manipulation functions
;; testsuite and area utilites
|
︙ | | |
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
|
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
|
+
+
-
+
+
+
|
#f)
"megatest")))
(define (common:get-megatest-exe-path)
(let* ((mtpathdir (common:get-megatest-exe-dir)))
(conc mtpathdir":"(get-environment-variable "PATH") ":.")))
(cond-expand
(chicken-4
(define (realpath x) (resolve-pathname (pathname-expand (or x "/dev/null")) ))
(define (realpath x) (resolve-pathname (pathname-expand (or x "/dev/null")) )))
(chicken-5
(define (realpath x) (normalize-pathname (pathname-expand (or x "/dev/null"))))))
;; if it looks like a number -> convert it to a number, else return it
;;
(define (lazy-convert inval)
(let* ((as-num (if (string? inval)(string->number inval) #f)))
(or as-num inval)))
|
︙ | | |
Modified debugprint.scm
from [54f7083883]
to [b5deae7454].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
-
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
-
+
+
+
-
+
-
+
|
(declare (unit debugprint))
(declare (uses mtargs))
(module debugprint
*
;;(import scheme chicken data-structures extras files ports)
(import scheme)
(cond-expand
(chicken-4
(import
scheme
chicken
data-structures
posix
ports
extras
;; scheme
;; chicken.base
;; chicken.string
;; chicken.time
;; chicken.time.posix
;; chicken.port
;; chicken.process-context
;; chicken.process-context.posix
(prefix mtargs args:)
srfi-1
;; system-information
))
(chicken-5
(import
scheme
chicken.base
chicken.string
chicken.time
chicken.time.posix
chicken.port
chicken.process-context
chicken.process-context.posix
(prefix mtargs args:)
srfi-1
(prefix mtargs args:))
;; system-information
)
(define setenv set-environment-variable!)
))
;;======================================================================
;; debug stuff
;;======================================================================
(define verbosity (make-parameter '()))
(define *default-log-port* (current-error-port))
(define debug:print-logger (make-parameter #f)) ;; set to a proc to call on every logging print
(define (debug:setup)
(let ((debugstr (or (args:get-arg "-debug")
(args:get-arg "-debug-noprop")
(get-environment-variable "MT_DEBUG_MODE"))))
(verbosity (debug:calc-verbosity debugstr 'q))
(debug:check-verbosity (verbosity) debugstr)
;; 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))
(setenv "MT_DEBUG_MODE" (if (list? (verbosity))
(string-intersperse (map conc (verbosity)) ",")
(conc (verbosity)))))))
;; check verbosity, #t is ok
(define (debug:check-verbosity verbosity vstr)
(if (not (or (number? verbosity)
(list? verbosity)))
|
︙ | | |
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
-
-
-
-
-
+
+
+
+
+
|
(list? n))
(not (null? (lset-intersection! eq? vb n))))
((and (number? vb)
(list? n))
(member vb n))
(else #f))))
(define (debug:handle-remote-logging params)
(if (debug:print-logger) ;; NOTE: turn params into string to keep things simple for now
((debug:print-logger)(conc "REMOTE ("(get-host-name)", pid="(current-process-id)") "
(string-intersperse (map conc params) " ") "; "
(string-intersperse (command-line-arguments) " ")))))
;; (define (debug:handle-remote-logging params)
;; (if (debug:print-logger) ;; NOTE: turn params into string to keep things simple for now
;; ((debug:print-logger)(conc "REMOTE ("(get-host-name)", pid="(current-process-id)") "
;; (string-intersperse (map conc params) " ") "; "
;; (string-intersperse (command-line-arguments) " ")))))
(define debug:enable-timestamp (make-parameter #t))
(define (debug:timestamp)
(if (debug:enable-timestamp)
(conc (time->string
(seconds->local-time (current-seconds)) "%H:%M:%S") " ")
|
︙ | | |