Add dry run support.

This commit is contained in:
Dominik Pantůček 2025-04-16 21:21:08 +02:00
parent 5f4724874e
commit 37b608ab67
7 changed files with 40 additions and 51 deletions

View file

@ -1,22 +0,0 @@
set terminal pngcairo size 1000,600
set title "Members stats"
set output 'members-base-stats-2023-11.png'
src='members-base-stats-2023-11.data'
set timefmt "%Y-%m"
set xdata time
set format x "%Y-%m"
set xlabel "Month"
set ylabel "Members"
set grid
set key out right
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

@ -187,8 +187,8 @@ PROGRESS-SOURCES=progress.scm util-time.import.scm
progress.o: progress.import.scm progress.o: progress.import.scm
progress.import.scm: $(PROGRESS-SOURCES) progress.import.scm: $(PROGRESS-SOURCES)
EXPORT-CARDS-SOURCES=export-cards.scm util-bst-ldict.import.scm \ EXPORT-CARDS-SOURCES=export-cards.scm util-bst-ldict.import.scm \
mbase.import.scm brmember.import.scm mbase.import.scm brmember.import.scm configuration.import.scm
export-cards.o: export-cards.import.scm export-cards.o: export-cards.import.scm
export-cards.import.scm: $(EXPORT-CARDS-SOURCES) export-cards.import.scm: $(EXPORT-CARDS-SOURCES)

View file

@ -43,6 +43,7 @@
*mailman3-sql* *mailman3-sql*
*mailman3-sql-path* *mailman3-sql-path*
*notifications-cc* *notifications-cc*
*dummy-run*
load-configuration! load-configuration!
) )
@ -121,6 +122,9 @@
(define *notifications-cc* (make-parameter #f)) (define *notifications-cc* (make-parameter #f))
(define =notifications-cc= "rada@brmlab.cz") (define =notifications-cc= "rada@brmlab.cz")
;; If #t, do not do anything
(define *dummy-run* (make-parameter #f))
(define (load-single-configuration! fname) (define (load-single-configuration! fname)
(when (file-exists? fname) (when (file-exists? fname)
(let loop ((lines (read-lines (open-input-file fname)))) (let loop ((lines (read-lines (open-input-file fname))))

View file

@ -38,7 +38,8 @@
(chicken irregex) (chicken irregex)
util-bst-ldict util-bst-ldict
mbase mbase
brmember) brmember
configuration)
;; Prints single card type records. ;; Prints single card type records.
(define (cards-print/type mb type) (define (cards-print/type mb type)
@ -84,7 +85,8 @@
;; Exports cards and desfires to the files specified. ;; Exports cards and desfires to the files specified.
(define (cards-export mb cardsfn desfirefn) (define (cards-export mb cardsfn desfirefn)
(cards-export/type mb 'card cardsfn) (when (not (*dummy-run*))
(cards-export/type mb 'desfire desfirefn)) (cards-export/type mb 'card cardsfn)
(cards-export/type mb 'desfire desfirefn)))
) )

View file

@ -191,10 +191,11 @@
;; Generates all members in given directory ;; Generates all members in given directory
(define (gen-html-members mb dir) (define (gen-html-members mb dir)
(ensure-directory dir) (when (not (*dummy-run*))
(with-mbase-progress% (ensure-directory dir)
mb dir mr (with-mbase-progress%
(gen-html-member mr dir)) mb dir mr
(clean-members-files mb dir)) (gen-html-member mr dir))
(clean-members-files mb dir)))
) )

View file

@ -116,6 +116,8 @@
(-mailman3-sql-path (path) "Set mailman3 direct SQL access path" (-mailman3-sql-path (path) "Set mailman3 direct SQL access path"
(*mailman3-sql* "1") (*mailman3-sql* "1")
(*mailman3-sql-path* path)) (*mailman3-sql-path* path))
(-n () "Do not do anything"
(*dummy-run* #t))
"" ""
"Email options:" "Email options:"
(-from (email) "Sender email address" (-from (email) "Sender email address"

View file

@ -94,27 +94,29 @@
;; Adds given email ;; Adds given email
(define (add-email-to-mailman3-list lst email) (define (add-email-to-mailman3-list lst email)
(print "Add " email " to " lst ".") (print "Add " email " to " lst "." (if (*dummy-run*) " [no-op]" ""))
(let ((result (when (not (*dummy-run*))
(mailman3-send/recv (let ((result
(list "addmembers" "-" (format "~A@brmlab.cz" lst)) (mailman3-send/recv
email))) (list "addmembers" "-" (format "~A@brmlab.cz" lst))
(let loop ((lines result)) email)))
(when (not (null? lines)) (let loop ((lines result))
(print " | " (car lines)) (when (not (null? lines))
(loop (cdr lines)))))) (print " | " (car lines))
(loop (cdr lines)))))))
;; Removes given email from given listname ;; Removes given email from given listname
(define (remove-email-from-mailman3-list lst email) (define (remove-email-from-mailman3-list lst email)
(print "Remove " email " from " lst ".") (print "Remove " email " from " lst "." (if (*dummy-run*) " [no-op]" ""))
(let ((result (when (not (*dummy-run*))
(get-mailman3-output-lines (let ((result
"delmembers" (get-mailman3-output-lines
"-l" (format "~A@brmlab.cz" lst) "delmembers"
"-m" email))) "-l" (format "~A@brmlab.cz" lst)
(let loop ((lines result)) "-m" email)))
(when (not (null? lines)) (let loop ((lines result))
(print " | " (car lines)) (when (not (null? lines))
(loop (cdr lines)))))) (print " | " (car lines))
(loop (cdr lines)))))))
) )