Compare commits
	
		
			10 commits
		
	
	
		
			aa5d9383aa
			...
			6facd2a2cc
		
	
	| Author | SHA1 | Date | |
|---|---|---|---|
| 6facd2a2cc | |||
| b568de15c2 | |||
| 81cc80c7c0 | |||
| 0b7f042eaf | |||
| 68bad91262 | |||
| ca5e535025 | |||
| 27a1a3522b | |||
| fb47d60550 | |||
| 3520d49293 | |||
| db9f98dc7e | 
					 4 changed files with 50 additions and 22 deletions
				
			
		|  | @ -1,8 +1,8 @@ | ||||||
| set terminal pngcairo size 1000,600 | set terminal pngcairo size 1000,600 | ||||||
| set title "Members stats" | set title "Members stats" | ||||||
| set output 'members-base-stats.png' | set output 'members-base-stats-2023-11.png' | ||||||
| 
 | 
 | ||||||
| src='members-base-stats.data' | src='members-base-stats-2023-11.data' | ||||||
| 
 | 
 | ||||||
| set timefmt "%Y-%m" | set timefmt "%Y-%m" | ||||||
| set xdata time | set xdata time | ||||||
|  | @ -15,8 +15,8 @@ set grid | ||||||
| 
 | 
 | ||||||
| set key out right | set key out right | ||||||
| 
 | 
 | ||||||
| plot[][0:] \ | plot[1420066800:][0:] \ | ||||||
| src u 1:3 w l t 'active', \ | src u 1:3 w l lw 2 t 'active', \ | ||||||
| src u 1:4 w l t 'suspended', \ | src u 1:4 w l t 'suspended', \ | ||||||
| src u 1:5 w l t 'students', \ | src u 1:5 w l t 'students', \ | ||||||
| src u 1:6 w l t 'destroyed' | src u 1:6 w l t 'destroyed' | ||||||
|  |  | ||||||
|  | @ -48,7 +48,9 @@ | ||||||
| 	util-stdout | 	util-stdout | ||||||
| 	table | 	table | ||||||
| 	export-web-static | 	export-web-static | ||||||
| 	dokuwiki) | 	dokuwiki | ||||||
|  | 	racket-kwargs | ||||||
|  | 	util-string) | ||||||
| 
 | 
 | ||||||
| ;; Command-line options and configurable parameters | ;; Command-line options and configurable parameters | ||||||
| (define -needs-bank- (make-parameter #f)) | (define -needs-bank- (make-parameter #f)) | ||||||
|  | @ -237,9 +239,6 @@ | ||||||
| 		       mls) | 		       mls) | ||||||
| 		mls)) | 		mls)) | ||||||
|       (values #f #f))) |       (values #f #f))) | ||||||
| (define internal-ml (if MLS (find-mailman-list MLS "internal") #f)) |  | ||||||
| (define council-ml (if MLS (find-mailman-list MLS "rada") #f)) |  | ||||||
| (define revision-ml (if MLS (find-mailman-list MLS "rk") #f)) |  | ||||||
| 
 | 
 | ||||||
| ;; Load DokuWiki users | ;; Load DokuWiki users | ||||||
| (define MB (if MB1 | (define MB (if MB1 | ||||||
|  | @ -284,30 +283,31 @@ | ||||||
| 	      (print "  " (car keys) ": " (length (ldict-ref status (car keys))))) | 	      (print "  " (car keys) ": " (length (ldict-ref status (car keys))))) | ||||||
| 	    (loop (cdr keys))))))) | 	    (loop (cdr keys))))))) | ||||||
| 
 | 
 | ||||||
| (define (capitalize s) | (define* (check-mailing-list mls name #:pred? (pred? #f)) | ||||||
|   (let ((l (string->list s))) |  | ||||||
|     (list->string |  | ||||||
|      (cons |  | ||||||
|       (char-upcase (car l)) |  | ||||||
|       (map char-downcase (cdr l)))))) |  | ||||||
| 
 |  | ||||||
| (define (check-mailing-list mls name) |  | ||||||
|   (define ml (find-mailman-list mls name)) |   (define ml (find-mailman-list mls name)) | ||||||
|   (let-values (((missing surplus) |   (let-values (((missing surplus) | ||||||
| 		(mailman-compare-members ml | 		(mailman-compare-members ml | ||||||
| 					 (mbase-active-emails MB #:suspended #t)))) | 					 (mbase-active-emails MB | ||||||
|  | 							      #:suspended #t | ||||||
|  | 							      #:pred? pred? | ||||||
|  | 							      )))) | ||||||
|     (if (null? (cdr ml)) |     (if (null? (cdr ml)) | ||||||
| 	(print "Skipping ML check - not loaded") | 	(print "Skipping ML check - not loaded") | ||||||
| 	(if (and (null? missing) | 	(if (and (null? missing) | ||||||
| 		 (null? surplus)) | 		 (null? surplus)) | ||||||
| 	    (print (format "~a mailing list membership in sync." (capitalize name))) | 	    (print (format "~a mailing list membership in sync." (string-capitalize name))) | ||||||
| 	    (let () | 	    (let () | ||||||
| 	      (print (format "~a mailing list:" (capitalize name))) | 	      (print (format "~a mailing list:" (string-capitalize name))) | ||||||
| 	      (when (not (null? missing)) | 	      (when (not (null? missing)) | ||||||
| 		(print "  Missing: " missing)) | 		(print "  Missing: " missing)) | ||||||
| 	      (when (not (null? surplus)) | 	      (when (not (null? surplus)) | ||||||
| 		(print "  Outsiders: " surplus))))))) | 		(print "  Outsiders: " surplus))))))) | ||||||
| 
 | 
 | ||||||
|  | (define (rada-ml-pred? mr) | ||||||
|  |   (or (brmember-council? mr) | ||||||
|  |       (brmember-chair? mr) | ||||||
|  |       (brmember-revision? mr))) | ||||||
|  | 
 | ||||||
| ;; Perform requested action | ;; Perform requested action | ||||||
| (case (-action-) | (case (-action-) | ||||||
|   ((print-info) |   ((print-info) | ||||||
|  | @ -320,7 +320,8 @@ | ||||||
| 	 (print-members-base-table MB) | 	 (print-members-base-table MB) | ||||||
| 	 (newline) | 	 (newline) | ||||||
| 	 (check-mailing-list MLS "internal") | 	 (check-mailing-list MLS "internal") | ||||||
| 	 (check-mailing-list MLS "rada" #:pred? brmember-council?) | 	 (check-mailing-list MLS "rada" | ||||||
|  | 			     #:pred? rada-ml-pred?) | ||||||
| 	 (check-mailing-list MLS "rk" #:pred? brmember-revision?) | 	 (check-mailing-list MLS "rk" #:pred? brmember-revision?) | ||||||
| 	 (print-git-status))) | 	 (print-git-status))) | ||||||
|    (newline)) |    (newline)) | ||||||
|  | @ -389,7 +390,14 @@ | ||||||
|    (print-unpaired-table MB)) |    (print-unpaired-table MB)) | ||||||
|   ((mlsync) |   ((mlsync) | ||||||
|    (cond ((-normal-month-) |    (cond ((-normal-month-) | ||||||
| 	  (mailman-sync-members internal-ml (mbase-active-emails MB #:suspended #t))) | 	  (mailman-sync-members (find-mailman-list MLS "internal") | ||||||
|  | 				(mbase-active-emails MB #:suspended #t)) | ||||||
|  | 	  (mailman-sync-members (find-mailman-list MLS "rada") | ||||||
|  | 				(mbase-active-emails MB | ||||||
|  | 						     #:pred? rada-ml-pred?)) | ||||||
|  | 	  (mailman-sync-members (find-mailman-list MLS "rk") | ||||||
|  | 				(mbase-active-emails MB | ||||||
|  | 						     #:pred? brmember-revision?))) | ||||||
| 	 (else | 	 (else | ||||||
| 	  (print "Mailman synchronization disabled with manually specified current month.")))) | 	  (print "Mailman synchronization disabled with manually specified current month.")))) | ||||||
|   ((notify) |   ((notify) | ||||||
|  |  | ||||||
|  | @ -39,7 +39,7 @@ | ||||||
| 	 (chicken format)) | 	 (chicken format)) | ||||||
| 
 | 
 | ||||||
|  ;; Short banner |  ;; Short banner | ||||||
|  (define banner-line "HackerBase 1.11 (c) 2023 Brmlab, z.s.") |  (define banner-line "HackerBase 1.12 (c) 2023 Brmlab, z.s.") | ||||||
| 
 | 
 | ||||||
|  ;; Banner source with numbers for ANSI CSI SGR |  ;; Banner source with numbers for ANSI CSI SGR | ||||||
|  (define banner-source " |  (define banner-source " | ||||||
|  |  | ||||||
|  | @ -37,6 +37,8 @@ | ||||||
| 
 | 
 | ||||||
|   string-upcase |   string-upcase | ||||||
| 
 | 
 | ||||||
|  |   string-capitalize | ||||||
|  | 
 | ||||||
|   string-tests! |   string-tests! | ||||||
|   ) |   ) | ||||||
| 
 | 
 | ||||||
|  | @ -100,6 +102,18 @@ using ```char-upcase```. Does not work with UTF-8.") | ||||||
|     (map char-upcase |     (map char-upcase | ||||||
| 	 (string->list str)))) | 	 (string->list str)))) | ||||||
| 
 | 
 | ||||||
|  |  (define/doc (string-capitalize str) | ||||||
|  |    ("* ```str``` - arbitrary string | ||||||
|  | 
 | ||||||
|  | Returns the ```str``` with the first character converted to upper case | ||||||
|  | using ```char-upcase``` and the remainder converted to lower case | ||||||
|  | using ```char-downcase```. Does not work with UTF-8.") | ||||||
|  |   (let ((l (string->list str))) | ||||||
|  |     (list->string | ||||||
|  |      (cons | ||||||
|  |       (char-upcase (car l)) | ||||||
|  |       (map char-downcase (cdr l)))))) | ||||||
|  | 
 | ||||||
|  ;; Performs utils module self-tests. |  ;; Performs utils module self-tests. | ||||||
|  (define (string-tests!) |  (define (string-tests!) | ||||||
|    (run-tests |    (run-tests | ||||||
|  | @ -122,6 +136,12 @@ using ```char-upcase```. Does not work with UTF-8.") | ||||||
|     (test-equal? string-upcase |     (test-equal? string-upcase | ||||||
| 		 (string-upcase "asdFGH") | 		 (string-upcase "asdFGH") | ||||||
| 		 "ASDFGH") | 		 "ASDFGH") | ||||||
|  |     (test-equal? string-capitalize | ||||||
|  | 		 (string-capitalize "asdf") | ||||||
|  | 		 "Asdf") | ||||||
|  |     (test-equal? string-capitalize | ||||||
|  | 		 (string-capitalize "ASDF") | ||||||
|  | 		 "Asdf") | ||||||
|     )) |     )) | ||||||
| 
 | 
 | ||||||
|  ) |  ) | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue