Megatest

Check-in [7f6ea52b90]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Synced mtargs with opensrc. Reduced noise in server output
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80
Files: files | file ages | folders
SHA1: 7f6ea52b90671c5b2aa1bebf7c755e2419526cfa
User & Date: mrwellan on 2023-01-06 09:23:33
Other Links: branch diff | manifest | tags
Context
2023-01-11
05:52
Merged fork check-in: 74f81f69c1 user: matt tags: v1.80
2023-01-10
13:50
Merged earlier change check-in: 143fb8134e user: mrwellan tags: v1.80
2023-01-06
09:23
Synced mtargs with opensrc. Reduced noise in server output check-in: 7f6ea52b90 user: mrwellan tags: v1.80
2022-12-12
15:25
Get .servinfo path in a function, create dir if needed. gate server start on high load check-in: 8adb8a0e7e user: mrwellan tags: v1.80, v1.8003
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added mtargs/mtargs.egg version [deacd4afda]. 

















>
>
>
>
>
>
>

1
2
3
4
5
6
7

((license "LGPL")
 (version 0.1)
 (category misc)
 (dependencies srfi-69 srfi-1)
 (author "Matt Welland")
 (synopsis "Primitive argument processor.")
 (components (extension mtargs)))

Modified mtargs/mtargs.scm from [54d4e74749] to [4162ab4280].

︙︙
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
66
67
68
69
70
71
72
73
74
75
76
77

     arg-hash
     get-arg
     get-arg-from
     usage
     get-args
     print-args
     any-defined?
     help
     )

(import scheme chicken data-structures extras posix ports files)
(use srfi-69 srfi-1)

(define arg-hash (make-hash-table))
(define help "")

(define (get-arg arg . default)
  (if (null? default)
      (hash-table-ref/default arg-hash arg #f)
      (hash-table-ref/default arg-hash arg (car default))))

(define (any-defined? . args)
  (not (null? (filter (lambda (x) x)
		      (map get-arg args)))))

;; (define any any-defined?)

(define (get-arg-from ht arg . default)
  (if (null? default)
      (hash-table-ref/default ht arg #f)
      (hash-table-ref/default ht arg (car default))))

(define (usage . args)
  (if (> (length args) 0)
      (apply print "ERROR: " args))
  (if (string? help)
      (print help)
      (print "Usage: " (car (argv)) " ... "))
  (exit 0))

 ;; one-of args defined
(define (any-defined? . param)
  (let ((res #f))
    (for-each 
     (lambda (arg)
       (if (get-arg arg)(set! res #t)))
     param)
    res))

;; args: 
(define (get-args args params switches arg-hash num-needed)
  (let* ((numtargs (length args))
	 (adj-num-needed (if num-needed (+ num-needed 2) #f)))
    (if (< numtargs (if adj-num-needed adj-num-needed 2))
	(if (>= num-needed 1)
	    (usage "No arguments provided")
	    '())








<


|
|


<

















<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








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

     arg-hash
     get-arg
     get-arg-from
     usage
     get-args
     print-args
     any-defined?

     )

(import scheme (chicken base) (chicken port) (chicken file) (chicken process-context))
(import srfi-69 srfi-1)

(define arg-hash (make-hash-table))


(define (get-arg arg . default)
  (if (null? default)
      (hash-table-ref/default arg-hash arg #f)
      (hash-table-ref/default arg-hash arg (car default))))

(define (any-defined? . args)
  (not (null? (filter (lambda (x) x)
		      (map get-arg args)))))

;; (define any any-defined?)

(define (get-arg-from ht arg . default)
  (if (null? default)
      (hash-table-ref/default ht arg #f)
      (hash-table-ref/default ht arg (car default))))



















(define (get-args args params switches arg-hash num-needed)
  (let* ((numtargs (length args))
	 (adj-num-needed (if num-needed (+ num-needed 2) #f)))
    (if (< numtargs (if adj-num-needed adj-num-needed 2))
	(if (>= num-needed 1)
	    (usage "No arguments provided")
	    '())
︙︙
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106

	    (if (null? tail) remtargs
		(loop (car tail)(cdr tail) remtargs)))
	   (else
	    (if (null? tail)(append remtargs (list arg)) ;; return the non-used args
		(loop (car tail)(cdr tail)(append remtargs (list arg))))))))
    ))

(define (print-args remtargs arg-hash)
  (print "ARGS: " remtargs)
  (for-each (lambda (arg)
	      (print "   " arg "   " (hash-table-ref/default arg-hash arg #f)))
	    (hash-table-keys arg-hash)))


)








|
<







72
73
74
75
76
77
78
79

80
81
82
83
84
85

	    (if (null? tail) remtargs
		(loop (car tail)(cdr tail) remtargs)))
	   (else
	    (if (null? tail)(append remtargs (list arg)) ;; return the non-used args
		(loop (car tail)(cdr tail)(append remtargs (list arg))))))))
    ))

(define (print-args arg-hash)

  (for-each (lambda (arg)
	      (print "   " arg "   " (hash-table-ref/default arg-hash arg #f)))
	    (hash-table-keys arg-hash)))


)

Modified server.scm from [80dd7784f0] to [df559aacc0].

︙︙
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188

        (dbprep-found 0)
	(bad-dat      (list #f #f #f #f #f)))
    (handle-exceptions
     exn
     (begin
       ;; WARNING: this is potentially dangerous to blanket ignore the errors
       (if (file-exists? logf)
	   (debug:print-info 0 *default-log-port* "Unable to get server info from "logf", exn=" exn))
       bad-dat) ;; no idea what went wrong, call it a bad server
     (with-input-from-file
	 logf
       (lambda ()
	 (let loop ((inl  (read-line))
		    (lnum 0))
	   (if (not (eof-object? inl))








|








174
175
176
177
178
179
180
181
182
183
184
185
186
187
188

        (dbprep-found 0)
	(bad-dat      (list #f #f #f #f #f)))
    (handle-exceptions
     exn
     (begin
       ;; WARNING: this is potentially dangerous to blanket ignore the errors
       (if (file-exists? logf)
	   (debug:print-info 2 *default-log-port* "Unable to get server info from "logf", exn=" exn))
       bad-dat) ;; no idea what went wrong, call it a bad server
     (with-input-from-file
	 logf
       (lambda ()
	 (let loop ((inl  (read-line))
		    (lnum 0))
	   (if (not (eof-object? inl))
︙︙
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431

       (lambda (f)
	 (let* ((hostport  (pathname-strip-directory f))
		(serverdat (server:logf-get-start-info f)))
	   (match serverdat
	     ((host port start server-id pid)
	      (if (and host port start server-id pid)
		  (hash-table-set! res hostport serverdat)
		  (debug:print-info 0 *default-log-port* "bad server info for "f": "serverdat)))
	     (else
	      (debug:print-info 0 *default-log-port* "bad server info for "f": "serverdat)))))
       allfiles)
      res)))

;; check the .servinfo directory, are there other servers running on this
;; or another host?
;;
;; returns #t => ok to start another server








|

|








415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431

       (lambda (f)
	 (let* ((hostport  (pathname-strip-directory f))
		(serverdat (server:logf-get-start-info f)))
	   (match serverdat
	     ((host port start server-id pid)
	      (if (and host port start server-id pid)
		  (hash-table-set! res hostport serverdat)
		  (debug:print-info 2 *default-log-port* "bad server info for "f": "serverdat)))
	     (else
	      (debug:print-info 2 *default-log-port* "bad server info for "f": "serverdat)))))
       allfiles)
      res)))

;; check the .servinfo directory, are there other servers running on this
;; or another host?
;;
;; returns #t => ok to start another server
︙︙

This page was generated in about 0.111s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00