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

View file

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

View file

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

View file

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