84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
keysmod
(prefix base64 base64:)
(prefix dbi dbi:)
(prefix sqlite3 sqlite3:)
(srfi 18)
directory-utils
format
matchable
md5
message-digest
regex
regex-case
sparse-vectors
|
>
|
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
keysmod
(prefix base64 base64:)
(prefix dbi dbi:)
(prefix sqlite3 sqlite3:)
(srfi 18)
directory-utils
dot-locking
format
matchable
md5
message-digest
regex
regex-case
sparse-vectors
|
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
;;======================================================================
;; parameters
;;======================================================================
;; while targets are Megatest specific they are a useful concept
(define mytarget (make-parameter #f))
;;======================================================================
;; move debug stuff to separate module then put these back where they belong
;;======================================================================
;;======================================================================
;; lookup routines - replicated from configf
;;======================================================================
|
>
>
>
>
>
|
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
;;======================================================================
;; parameters
;;======================================================================
;; while targets are Megatest specific they are a useful concept
(define mytarget (make-parameter #f))
;; locking is optional, many environments don't care (e.g. running on one machine)
;; NOTE: the locker must follow the same syntax as with-dot-lock*
;;
(define my-with-lock (make-parameter with-dot-lock*))
;;======================================================================
;; move debug stuff to separate module then put these back where they belong
;;======================================================================
;;======================================================================
;; lookup routines - replicated from configf
;;======================================================================
|
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
|
;;======================================================================
;; DO THE LOCKING AROUND THE CALL
;;======================================================================
;;
(define (configf:write-alist cdat fname)
;; (if (not (common:faux-lock fname))
(debug:print 0 *default-log-port* "INFO: NEED LOCKING ADDED HERE " fname)
(let* ((dat (configf:config->alist cdat))
(res
(begin
(with-output-to-file fname ;; first write out the file
(lambda ()
(pp dat)))
;; I don't like this. It makes write-alist opaque and complicated. -mrw-
(if (file-exists? fname) ;; now verify it is readable
(if (configf:read-alist fname)
#t ;; data is good.
(begin
(handle-exceptions
exn
(begin
(debug:print 0 *default-log-port* "deleting " fname " failed, exn=" exn)
#f)
(debug:print 0 *default-log-port* "WARNING: content " dat " for cache " fname " is not readable. Deleting generated file.")
(delete-file fname))
#f))
#f))))
;; (common:faux-unlock fname)
res))
(define (common:get-fields cfgdat)
(let ((fields (hash-table-ref/default cfgdat "fields" '())))
(map car fields)))
)
|
|
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<
|
|
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
|
;;======================================================================
;; DO THE LOCKING AROUND THE CALL
;;======================================================================
;;
(define (configf:write-alist cdat fname)
;; (if (not (common:faux-lock fname))
;; (debug:print 0 *default-log-port* "INFO: NEED LOCKING ADDED HERE " fname)
((my-with-lock)
fname
(lambda ()
(let* ((dat (configf:config->alist cdat))
(res
(begin
(with-output-to-file fname ;; first write out the file
(lambda ()
(pp dat)))
;; I don't like this. It makes write-alist opaque and complicated. -mrw-
(if (file-exists? fname) ;; now verify it is readable
(if (configf:read-alist fname)
#t ;; data is good.
(begin
(handle-exceptions
exn
(begin
(debug:print 0 *default-log-port* "deleting " fname " failed, exn=" exn)
#f)
(debug:print 0 *default-log-port* "WARNING: content " dat " for cache " fname " is not readable. Deleting generated file.")
(delete-file fname))
#f))
#f))))
res))))
(define (common:get-fields cfgdat)
(let ((fields (hash-table-ref/default cfgdat "fields" '())))
(map car fields)))
)
|