2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
|
(begin
(if (not (launch:setup))
(begin
(debug:print 0 *default-log-port* "Failed to setup, exiting")
(exit 1)))
;; keep this one local
;; (open-run-close patch-db #f)
(let ((dbstructs (db:setup #f)))
(common:cleanup-db dbstructs full: #t))
(set! *didsomething* #t)))
(if (args:get-arg "-cleanup-db")
(begin
(if (not (launch:setup))
(begin
|
|
|
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
|
(begin
(if (not (launch:setup))
(begin
(debug:print 0 *default-log-port* "Failed to setup, exiting")
(exit 1)))
;; keep this one local
;; (open-run-close patch-db #f)
(let ((dbstructs (db:setup)))
(common:cleanup-db dbstructs full: #t))
(set! *didsomething* #t)))
(if (args:get-arg "-cleanup-db")
(begin
(if (not (launch:setup))
(begin
|
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
|
(args:get-arg "-repl")
(args:get-arg "-load"))
(let* ((toppath (launch:setup))
(dbstructs (if (and toppath
;; NOTE: server:choose-server is starting a server
;; either add equivalent for tcp mode or ????
#;(server:choose-server toppath 'home?))
(db:setup #t)
#f))) ;; make-dbr:dbstruct path: toppath local: (args:get-arg "-local")) #f)))
(if *toppath*
(cond
((getenv "MT_RUNSCRIPT")
;; How to run megatest scripts
;;
;; #!/bin/bash
|
|
|
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
|
(args:get-arg "-repl")
(args:get-arg "-load"))
(let* ((toppath (launch:setup))
(dbstructs (if (and toppath
;; NOTE: server:choose-server is starting a server
;; either add equivalent for tcp mode or ????
#;(server:choose-server toppath 'home?))
(db:setup)
#f))) ;; make-dbr:dbstruct path: toppath local: (args:get-arg "-local")) #f)))
(if *toppath*
(cond
((getenv "MT_RUNSCRIPT")
;; How to run megatest scripts
;;
;; #!/bin/bash
|
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
|
;; ;; ;; redo me (list "uname" "rundir" "final_logf" "comment"))
;; ;; ;; redo me (set! *didsomething* #t)))
(if (args:get-arg "-import-megatest.db")
(begin
(launch:setup)
(db:multi-db-sync
(db:setup #f)
'killservers
'dejunk
'adj-testids
'old2new
)
(set! *didsomething* #t)))
(if (args:get-arg "-import-sexpr")
(begin
(launch:setup)
(rmt:import-sexpr (args:get-arg "-import-sexpr"))
(set! *didsomething* #t)))
(if (args:get-arg "-sync-to-megatest.db")
(let* ((duh (launch:setup))
(dbstruct (db:setup #t))
(tmpdbpth (dbr:dbstruct-tmppath dbstruct))
(lockfile (conc tmpdbpth ".lock"))
(locked (common:simple-file-lock lockfile))
(res (if locked
(db:multi-db-sync
dbstruct
'new2old)
|
|
|
|
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
|
;; ;; ;; redo me (list "uname" "rundir" "final_logf" "comment"))
;; ;; ;; redo me (set! *didsomething* #t)))
(if (args:get-arg "-import-megatest.db")
(begin
(launch:setup)
(db:multi-db-sync
(db:setup)
'killservers
'dejunk
'adj-testids
'old2new
)
(set! *didsomething* #t)))
(if (args:get-arg "-import-sexpr")
(begin
(launch:setup)
(rmt:import-sexpr (args:get-arg "-import-sexpr"))
(set! *didsomething* #t)))
(if (args:get-arg "-sync-to-megatest.db")
(let* ((duh (launch:setup))
(dbstruct (db:setup))
(tmpdbpth (dbr:dbstruct-tmppath dbstruct))
(lockfile (conc tmpdbpth ".lock"))
(locked (common:simple-file-lock lockfile))
(res (if locked
(db:multi-db-sync
dbstruct
'new2old)
|