diff --git a/members-base-stats.gp b/members-base-stats.gp index 5f4f588..a8bfdeb 100644 --- a/members-base-stats.gp +++ b/members-base-stats.gp @@ -1,8 +1,8 @@ set terminal pngcairo size 1000,600 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 xdata time @@ -15,8 +15,8 @@ set grid set key out right -plot[][0:] \ -src u 1:3 w l t 'active', \ +plot[1420066800:][0:] \ +src u 1:3 w l lw 2 t 'active', \ src u 1:4 w l t 'suspended', \ src u 1:5 w l t 'students', \ src u 1:6 w l t 'destroyed' diff --git a/src/hackerbase.scm b/src/hackerbase.scm index 2a071e1..f458a18 100644 --- a/src/hackerbase.scm +++ b/src/hackerbase.scm @@ -48,7 +48,9 @@ util-stdout table export-web-static - dokuwiki) + dokuwiki + racket-kwargs + util-string) ;; Command-line options and configurable parameters (define -needs-bank- (make-parameter #f)) @@ -237,9 +239,6 @@ mls) mls)) (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 (define MB (if MB1 @@ -284,30 +283,31 @@ (print " " (car keys) ": " (length (ldict-ref status (car keys))))) (loop (cdr keys))))))) -(define (capitalize s) - (let ((l (string->list s))) - (list->string - (cons - (char-upcase (car l)) - (map char-downcase (cdr l)))))) - -(define (check-mailing-list mls name) +(define* (check-mailing-list mls name #:pred? (pred? #f)) (define ml (find-mailman-list mls name)) (let-values (((missing surplus) (mailman-compare-members ml - (mbase-active-emails MB #:suspended #t)))) + (mbase-active-emails MB + #:suspended #t + #:pred? pred? + )))) (if (null? (cdr ml)) (print "Skipping ML check - not loaded") (if (and (null? missing) (null? surplus)) - (print (format "~a mailing list membership in sync." (capitalize name))) + (print (format "~a mailing list membership in sync." (string-capitalize name))) (let () - (print (format "~a mailing list:" (capitalize name))) + (print (format "~a mailing list:" (string-capitalize name))) (when (not (null? missing)) (print " Missing: " missing)) (when (not (null? surplus)) (print " Outsiders: " surplus))))))) +(define (rada-ml-pred? mr) + (or (brmember-council? mr) + (brmember-chair? mr) + (brmember-revision? mr))) + ;; Perform requested action (case (-action-) ((print-info) @@ -320,7 +320,8 @@ (print-members-base-table MB) (newline) (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?) (print-git-status))) (newline)) @@ -389,7 +390,14 @@ (print-unpaired-table MB)) ((mlsync) (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 (print "Mailman synchronization disabled with manually specified current month.")))) ((notify) diff --git a/src/texts.scm b/src/texts.scm index f08ee94..203d078 100644 --- a/src/texts.scm +++ b/src/texts.scm @@ -39,7 +39,7 @@ (chicken format)) ;; 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 (define banner-source " diff --git a/src/util-string.scm b/src/util-string.scm index d9914b9..2a17d7a 100644 --- a/src/util-string.scm +++ b/src/util-string.scm @@ -37,6 +37,8 @@ string-upcase + string-capitalize + string-tests! ) @@ -100,6 +102,18 @@ using ```char-upcase```. Does not work with UTF-8.") (map char-upcase (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. (define (string-tests!) (run-tests @@ -122,6 +136,12 @@ using ```char-upcase```. Does not work with UTF-8.") (test-equal? string-upcase (string-upcase "asdFGH") "ASDFGH") + (test-equal? string-capitalize + (string-capitalize "asdf") + "Asdf") + (test-equal? string-capitalize + (string-capitalize "ASDF") + "Asdf") )) )