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