517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
|
"-list-disks"
"-list-targets"
"-show-runconfig"
;;"-list-db-targets"
"-show-runconfig"
"-show-config"
"-show-cmdinfo"
"-cleanup-db"))
(no-watchdog-args-vals (filter (lambda (x) x)
(map args:get-arg no-watchdog-args)))
(start-watchdog (null? no-watchdog-args-vals)))
;;(BB> "no-watchdog-args="no-watchdog-args "no-watchdog-args-vals="no-watchdog-args-vals)
(if start-watchdog
(thread-start! *watchdog*)))
;; bracket open-output-file with code to make leading directory if it does not exist and handle exceptions
(define (open-logfile logpath-in)
(condition-case
|
|
>
>
>
>
>
>
>
>
>
>
|
|
|
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
|
"-list-disks"
"-list-targets"
"-show-runconfig"
;;"-list-db-targets"
"-show-runconfig"
"-show-config"
"-show-cmdinfo"
"-cleanup-db"
))
(no-watchdog-argvals (list '("-archive" . "replicate-db")))
(start-watchdog-specail-arg-val (let loop ((hed (car no-watchdog-argvals))
(tail (cdr no-watchdog-argvals)))
(print "hed" hed " arg " (args:get-arg (car hed)) " val:" (cdr hed) " eql" (equal? (args:get-arg (car hed)) (cdr hed)))
(if (equal? (args:get-arg (car hed)) (cdr hed))
#f
(if (null? tail)
#t
(loop (car tail) (cdr tail))))))
(no-watchdog-args-vals (filter (lambda (x) x)
(map args:get-arg no-watchdog-args)))
(start-watchdog (and (null? no-watchdog-args-vals) start-watchdog-specail-arg-val)))
;(print "no-watchdog-args="no-watchdog-args "no-watchdog-args-vals="no-watchdog-args-vals " start-watchdog-specail-arg-val:" start-watchdog-specail-arg-val " start-watchdog:" start-watchdog)
(if start-watchdog
(thread-start! *watchdog*)))
;; bracket open-output-file with code to make leading directory if it does not exist and handle exceptions
(define (open-logfile logpath-in)
(condition-case
|
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
|
(print path))
paths))))))
;;======================================================================
;; Archive tests
;;======================================================================
;; Archive tests matching target, runname, and testpatt
(if (equal? (args:get-arg "-archive") "replicacte-db")
(begin
;; check if source
;; check if megatest.db exist
(launch:setup)
(if (not (args:get-arg "-source"))
(begin
(debug:print-info 1 *default-log-port* "Missing required argument -source <archive path>")
(exit 1)))
(if (common:file-exists? (conc *toppath* "/megatest.db"))
(begin
(debug:print-info 1 *default-log-port* "File " (conc *toppath* "/megatest.db") " already exists. Please remove it before trying to replicate db")
|
|
|
|
|
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
|
(print path))
paths))))))
;;======================================================================
;; Archive tests
;;======================================================================
;; Archive tests matching target, runname, and testpatt
(if (equal? (args:get-arg "-archive") "replicate-db")
(begin
;; check if source
;; check if megatest.db exist
(launch:setup)
(if (not (args:get-arg "-source"))
(begin
(debug:print-info 1 *default-log-port* "Missing required argument -source <archive path>")
(exit 1)))
(if (common:file-exists? (conc *toppath* "/megatest.db"))
(begin
(debug:print-info 1 *default-log-port* "File " (conc *toppath* "/megatest.db") " already exists. Please remove it before trying to replicate db")
|
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
|
(begin
(archive:restore-db src ts)
(set! *didsomething* #t))
(begin
(debug:print-error 1 *default-log-port* "Path " source " not found")
(exit 1))))))
;; else do a general-run-call
(if (and (args:get-arg "-archive") (not (equal? (args:get-arg "-archive") "replicacte-db")))
(begin
;; for the archive get we need to preserve the starting dir as part of the target path
(if (and (args:get-arg "-dest")
(not (equal? (substring (args:get-arg "-dest") 0 1) "/")))
(let ((newpath (conc (current-directory) "/" (args:get-arg "-dest"))))
(debug:print-info 1 *default-log-port* "Preserving original path to destination, was " (args:get-arg "-dest") ", now " newpath)
(hash-table-set! args:arg-hash "-dest" newpath)))
|
|
|
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
|
(begin
(archive:restore-db src ts)
(set! *didsomething* #t))
(begin
(debug:print-error 1 *default-log-port* "Path " source " not found")
(exit 1))))))
;; else do a general-run-call
(if (and (args:get-arg "-archive") (not (equal? (args:get-arg "-archive") "replicate-db")))
(begin
;; for the archive get we need to preserve the starting dir as part of the target path
(if (and (args:get-arg "-dest")
(not (equal? (substring (args:get-arg "-dest") 0 1) "/")))
(let ((newpath (conc (current-directory) "/" (args:get-arg "-dest"))))
(debug:print-info 1 *default-log-port* "Preserving original path to destination, was " (args:get-arg "-dest") ", now " newpath)
(hash-table-set! args:arg-hash "-dest" newpath)))
|