Overview
| Comment: | Improvements to -list-targets for RobertG |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.60 |
| Files: | files | file ages | folders |
| SHA1: |
b95936eb28386c28a35c88fbe46d5580 |
| User & Date: | mrwellan on 2015-11-04 08:09:34 |
| Other Links: | branch diff | manifest | tags |
Context
|
2015-11-04
| ||
| 08:17 | Reduced debug noise a little check-in: c443f71228 user: mrwellan tags: v1.60 | |
| 08:09 | Improvements to -list-targets for RobertG check-in: b95936eb28 user: mrwellan tags: v1.60 | |
|
2015-11-02
| ||
| 09:36 | Don't updated stored cpu/disk space unless changed more than 200 Meg or .6 load check-in: c7ef1b27a4 user: mrwellan tags: v1.60 | |
Changes
Modified common.scm from [1ec3dc239a] to [2955bbfc6b].
| ︙ | ︙ | |||
393 394 395 396 397 398 399 |
(set! res #t))))
(string-split patts ","))
res)
#t))
;; (map print (map car (hash-table->alist (read-config "runconfigs.config" #f #t))))
(define (common:get-runconfig-targets #!key (configf #f))
| | | | | | | > > > > > > | 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 |
(set! res #t))))
(string-split patts ","))
res)
#t))
;; (map print (map car (hash-table->alist (read-config "runconfigs.config" #f #t))))
(define (common:get-runconfig-targets #!key (configf #f))
(let ((targs (sort (map car (hash-table->alist
(or configf
(read-config (conc *toppath* "/runconfigs.config")
#f #t)
(make-hash-table))))
string<?))
(target-patt (args:get-arg "-target")))
(if target-patt
(filter (lambda (x)
(patt-list-match x target-patt))
targs)
targs)))
;; '(print (string-intersperse (map cadr (hash-table-ref/default (read-config "megatest.config" \#f \#t) "disks" '"'"'("none" ""))) "\n"))'
(define (common:get-disks #!key (configf #f))
(hash-table-ref/default
(or configf (read-config "megatest.config" #f #t))
"disks" '("none" "")))
|
| ︙ | ︙ | |||
662 663 664 665 666 667 668 |
(bestsize 0))
(for-each
(lambda (disk-num)
(let* ((dirpath (cadr (assoc disk-num disks)))
(freespc (cond
((not (directory? dirpath))
(if (common:low-noise-print 50 "disks not a dir " disk-num)
| | | | | 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 |
(bestsize 0))
(for-each
(lambda (disk-num)
(let* ((dirpath (cadr (assoc disk-num disks)))
(freespc (cond
((not (directory? dirpath))
(if (common:low-noise-print 50 "disks not a dir " disk-num)
(debug:print 0 "WARNING: disk " disk-num " at path \"" dirpath "\" is not a directory - ignoring it."))
-1)
((not (file-write-access? dirpath))
(if (common:low-noise-print 50 "disks not writeable " disk-num)
(debug:print 0 "WARNING: disk " disk-num " at path \"" dirpath "\" is not writeable - ignoring it."))
-1)
((not (eq? (string-ref dirpath 0) #\/))
(if (common:low-noise-print 50 "disks not a proper path " disk-num)
(debug:print 0 "WARNING: disk " disk-num " at path \"" dirpath "\" is not a fully qualified path - ignoring it."))
-1)
(else
(get-df dirpath)))))
(if (> freespc bestsize)
(begin
(set! best (cons disk-num dirpath))
(set! bestsize freespc)))))
|
| ︙ | ︙ |
Modified megatest.scm from [be504e6804] to [47f4506230].
| ︙ | ︙ | |||
756 757 758 759 760 761 762 |
;;======================================================================
;; Weird special calls that need to run *after* the server has started?
;;======================================================================
(if (args:get-arg "-list-targets")
(let ((targets (common:get-runconfig-targets)))
| | | 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 |
;;======================================================================
;; Weird special calls that need to run *after* the server has started?
;;======================================================================
(if (args:get-arg "-list-targets")
(let ((targets (common:get-runconfig-targets)))
(debug:print 1 "Found "(length targets) " targets")
(case (string->symbol (or (args:get-arg "-dumpmode") "alist"))
((alist)
(for-each (lambda (x)
;; (print "[" x "]"))
(print x))
targets))
((json)
|
| ︙ | ︙ | |||
939 940 941 942 943 944 945 946 947 948 949 950 951 952 |
(if indx
(if (>= indx (vector-length datavec))
#f ;; index to high, should raise an error I suppose
(vector-ref datavec indx))
#f)))
;; NOTE: list-runs and list-db-targets operate on local db!!!
;;
(if (or (args:get-arg "-list-runs")
(args:get-arg "-list-db-targets"))
(if (launch:setup-for-run)
(let* (;; (dbstruct (make-dbr:dbstruct path: *toppath* local: (args:get-arg "-local")))
(runpatt (args:get-arg "-list-runs"))
(testpatt (common:args-get-testpatt #f))
| > > | 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 |
(if indx
(if (>= indx (vector-length datavec))
#f ;; index to high, should raise an error I suppose
(vector-ref datavec indx))
#f)))
;; NOTE: list-runs and list-db-targets operate on local db!!!
;;
;; IDEA: megatest list -runname blah% ...
;;
(if (or (args:get-arg "-list-runs")
(args:get-arg "-list-db-targets"))
(if (launch:setup-for-run)
(let* (;; (dbstruct (make-dbr:dbstruct path: *toppath* local: (args:get-arg "-local")))
(runpatt (args:get-arg "-list-runs"))
(testpatt (common:args-get-testpatt #f))
|
| ︙ | ︙ |