Compare commits

...

10 commits

4 changed files with 50 additions and 22 deletions

View file

@ -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'

View file

@ -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)

View file

@ -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 "

View file

@ -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")
)) ))
) )