brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Work on new ML checkers.

Browse source
This commit is contained in:
Dominik Pantůček 2023-11-16 18:31:39 +01:00
parent fbe3f02128
commit 3f2283e1ca
1 changed files with 30 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

47
src/hackerbase.scm
View file

@ -226,7 +226,7 @@
#f))
;; Load ML(s) and merge them
(define-values (MB1 internal-ml MLS)
(define-values (MB1 MLS)
(if MB0
(let ()
(define mls (load-mailman-lists))
@ -234,9 +234,11 @@
(mbase-merge-mailman mb ml))
MB0
mls)
(find-mailman-list mls "internal")
MLS))
(values #f #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
(define MB (if MB1
@ -281,6 +283,30 @@
(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))
(cdr l)))))
(define (check-mailing-list mls name)
(define ml (find-mailman-list mls name))
(let-values (((missing surplus)
(mailman-compare-members ml
(mbase-active-emails MB #:suspended #t))))
(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)))
(let ()
(print (format "~a mailing list:" (capitalize name)))
(when (not (null? missing))
(print " Missing: " missing))
(when (not (null? surplus))
(print " Outsiders: " surplus)))))))
;; Perform requested action
(case (-action-)
((print-info)
@ -292,20 +318,7 @@
(let ()
(print-members-base-table MB)
(newline)
(let-values (((missing surplus)
(mailman-compare-members internal-ml
(mbase-active-emails MB #:suspended #t))))
(if (null? (cdr internal-ml))
(print "Skipping ML check - not loaded")
(if (and (null? missing)
(null? surplus))
(print "Internal mailing list membership in sync.")
(let ()
(print "Internal mailing list:")
(when (not (null? missing))
(print " Missing: " missing))
(when (not (null? surplus))
(print " Outsiders: " surplus))))))
(check-mailing-list MLS "internal")
(print-git-status)))
(newline))
((print-stats)