Split out mailinglist check base.

src/Makefile

@@ -42,7 +42,7 @@ HACKERBASE-DEPS=hackerbase.scm cal-month.import.scm			\
 	tests.import.scm notifications.import.scm logging.import.scm	\
 	progress.import.scm cal-period.import.scm			\
 	util-stdout.import.scm export-web-static.import.scm		\
-	dokuwiki.import.scm
+	dokuwiki.import.scm mailinglist.import.scm
 
 HACKERBASE-OBJS=hackerbase.o testing.o listing.o cal-month.o		\
 	 cal-period.o ansi.o util-bst-ldict.o command-line.o mbase.o	\
@@ -59,7 +59,8 @@ HACKERBASE-OBJS=hackerbase.o testing.o listing.o cal-month.o		\
 	 template-list-expander.o box-drawing.o export-web-static.o	\
 	 util-dir.o dokuwiki.o racket-kwargs.o duck.o util-bst.o	\
 	 util-bst-bdict.o util-bst-ldict.o util-bst-lset.o mailman2.o	\
-	 mailman-common.o mailman3.o mailman3-sql.o tiocgwinsz.o
+	 mailman-common.o mailman3.o mailman3-sql.o tiocgwinsz.o	\
+	 mailinglist.o
 
 GENDOC-SOURCES=gendoc.scm duck-extract.import.scm			\
 	util-time.import.scm util-csv.import.scm util-git.import.scm	\
@@ -550,3 +551,9 @@ TIOCGWINSZ-SOURCES=tiocgwinsz.scm duck.import.scm
 
 tiocgwinsz.o: tiocgwinsz.import.scm
 tiocgwinsz.import.scm: $(TIOCGWINSZ-SOURCES)
+
+MAILINGLIST-SOURCES=mailinglist.scm racket-kwargs.import.scm		\
+	mailman.import.scm mbase.import.scm util-string.import.scm
+
+mailinglist.o: mailinglist.import.scm
+mailinglist.import.scm: $(MAILINGLIST-SOURCES)

src/hackerbase.scm

@@ -50,7 +50,8 @@
 	export-web-static
 	dokuwiki
 	racket-kwargs
-	util-string)
+	util-string
+	mailinglist)
 
 ;; Command-line options and configurable parameters
 (define -needs-bank- (make-parameter #f))
@@ -286,27 +287,6 @@
 	      (print "  " (car keys) ": " (length (ldict-ref status (car keys)))))
 	    (loop (cdr keys)))))))
 
-(define* (check-mailing-list mls name #:pred? (pred? #f) #:suspended (suspended #f))
-  (define ml (find-mailman-list mls name))
-  (when ml
-    (let-values (((missing surplus)
-		  (mailman-compare-members ml
-					   (mbase-active-emails MB
-								#:suspended suspended
-								#: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." (string-capitalize name)))
-	      (let ()
-		(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)
@@ -323,10 +303,10 @@
        (let ()
 	 (print-members-base-table MB)
 	 (newline)
-	 (check-mailing-list MLS "internal" #:suspended #t)
-	 (check-mailing-list MLS "rada"
+	 (check-mailing-list MB MLS "internal" #:suspended #t)
+	 (check-mailing-list MB MLS "rada"
 			     #:pred? rada-ml-pred?)
-	 (check-mailing-list MLS "rk" #:pred? brmember-revision?)
+	 (check-mailing-list MB MLS "rk" #:pred? brmember-revision?)
 	 (print-git-status)))
    (newline))
   ((print-stats)

src/mailinglist.scm

@@ -0,0 +1,63 @@
+;;
+;; mailinglist.scm
+;;
+;; Common high-level mailinglist management procedures.
+;;
+;; ISC License
+;;
+;; Copyright 2023 Brmlab, z.s.
+;; Dominik Pantůček <dominik.pantucek@trustica.cz>
+;;
+;; Permission to use, copy, modify, and/or distribute this software
+;; for any purpose with or without fee is hereby granted, provided
+;; that the above copyright notice and this permission notice appear
+;; in all copies.
+;; 
+;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
+;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
+;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
+;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
+;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
+;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+;;
+
+(declare (unit mailinglist))
+
+(module
+ mailinglist
+ (
+  check-mailing-list
+  )
+
+ (import scheme
+	 (chicken base)
+	 (chicken format)
+	 racket-kwargs
+	 mailman
+	 mbase
+	 util-string)
+
+ (define* (check-mailing-list MB mls name #:pred? (pred? #f) #:suspended (suspended #f))
+   (define ml (find-mailman-list mls name))
+   (when ml
+     (let-values (((missing surplus)
+		   (mailman-compare-members ml
+					    (mbase-active-emails MB
+								 #:suspended suspended
+								 #: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." (string-capitalize name)))
+	       (let ()
+		 (print (format "~a mailing list:" (string-capitalize name)))
+		 (when (not (null? missing))
+		   (print "  Missing: " missing))
+		 (when (not (null? surplus))
+		   (print "  Outsiders: " surplus))))))))
+
+ )