From 37b608ab675ba8c44c788ae1fe11ebff420fb43f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Wed, 16 Apr 2025 21:21:08 +0200 Subject: [PATCH] Add dry run support. --- members-base-stats.gp | 22 --------------------- src/Makefile | 4 ++-- src/configuration.scm | 4 ++++ src/export-cards.scm | 8 +++++--- src/export-web-static.scm | 11 ++++++----- src/hackerbase.scm | 2 ++ src/mailman3.scm | 40 ++++++++++++++++++++------------------- 7 files changed, 40 insertions(+), 51 deletions(-) delete mode 100644 members-base-stats.gp diff --git a/members-base-stats.gp b/members-base-stats.gp deleted file mode 100644 index a8bfdeb..0000000 --- a/members-base-stats.gp +++ /dev/null @@ -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' diff --git a/src/Makefile b/src/Makefile index 8a9a50b..8f05d4d 100644 --- a/src/Makefile +++ b/src/Makefile @@ -187,8 +187,8 @@ PROGRESS-SOURCES=progress.scm util-time.import.scm progress.o: progress.import.scm progress.import.scm: $(PROGRESS-SOURCES) -EXPORT-CARDS-SOURCES=export-cards.scm util-bst-ldict.import.scm \ - mbase.import.scm brmember.import.scm +EXPORT-CARDS-SOURCES=export-cards.scm util-bst-ldict.import.scm \ + mbase.import.scm brmember.import.scm configuration.import.scm export-cards.o: export-cards.import.scm export-cards.import.scm: $(EXPORT-CARDS-SOURCES) diff --git a/src/configuration.scm b/src/configuration.scm index 3518efc..b49d320 100644 --- a/src/configuration.scm +++ b/src/configuration.scm @@ -43,6 +43,7 @@ *mailman3-sql* *mailman3-sql-path* *notifications-cc* + *dummy-run* load-configuration! ) @@ -121,6 +122,9 @@ (define *notifications-cc* (make-parameter #f)) (define =notifications-cc= "rada@brmlab.cz") + ;; If #t, do not do anything + (define *dummy-run* (make-parameter #f)) + (define (load-single-configuration! fname) (when (file-exists? fname) (let loop ((lines (read-lines (open-input-file fname)))) diff --git a/src/export-cards.scm b/src/export-cards.scm index 41d7721..6940eaa 100644 --- a/src/export-cards.scm +++ b/src/export-cards.scm @@ -38,7 +38,8 @@ (chicken irregex) util-bst-ldict mbase - brmember) + brmember + configuration) ;; Prints single card type records. (define (cards-print/type mb type) @@ -84,7 +85,8 @@ ;; Exports cards and desfires to the files specified. (define (cards-export mb cardsfn desfirefn) - (cards-export/type mb 'card cardsfn) - (cards-export/type mb 'desfire desfirefn)) + (when (not (*dummy-run*)) + (cards-export/type mb 'card cardsfn) + (cards-export/type mb 'desfire desfirefn))) ) diff --git a/src/export-web-static.scm b/src/export-web-static.scm index 6647104..12c2abe 100644 --- a/src/export-web-static.scm +++ b/src/export-web-static.scm @@ -191,10 +191,11 @@ ;; Generates all members in given directory (define (gen-html-members mb dir) - (ensure-directory dir) - (with-mbase-progress% - mb dir mr - (gen-html-member mr dir)) - (clean-members-files mb dir)) + (when (not (*dummy-run*)) + (ensure-directory dir) + (with-mbase-progress% + mb dir mr + (gen-html-member mr dir)) + (clean-members-files mb dir))) ) diff --git a/src/hackerbase.scm b/src/hackerbase.scm index 9f29a94..8b8d60c 100644 --- a/src/hackerbase.scm +++ b/src/hackerbase.scm @@ -116,6 +116,8 @@ (-mailman3-sql-path (path) "Set mailman3 direct SQL access path" (*mailman3-sql* "1") (*mailman3-sql-path* path)) + (-n () "Do not do anything" + (*dummy-run* #t)) "" "Email options:" (-from (email) "Sender email address" diff --git a/src/mailman3.scm b/src/mailman3.scm index 571398d..2693504 100644 --- a/src/mailman3.scm +++ b/src/mailman3.scm @@ -94,27 +94,29 @@ ;; Adds given email (define (add-email-to-mailman3-list lst email) - (print "Add " email " to " lst ".") - (let ((result - (mailman3-send/recv - (list "addmembers" "-" (format "~A@brmlab.cz" lst)) - email))) - (let loop ((lines result)) - (when (not (null? lines)) - (print " | " (car lines)) - (loop (cdr lines)))))) + (print "Add " email " to " lst "." (if (*dummy-run*) " [no-op]" "")) + (when (not (*dummy-run*)) + (let ((result + (mailman3-send/recv + (list "addmembers" "-" (format "~A@brmlab.cz" lst)) + email))) + (let loop ((lines result)) + (when (not (null? lines)) + (print " | " (car lines)) + (loop (cdr lines))))))) ;; Removes given email from given listname (define (remove-email-from-mailman3-list lst email) - (print "Remove " email " from " lst ".") - (let ((result - (get-mailman3-output-lines - "delmembers" - "-l" (format "~A@brmlab.cz" lst) - "-m" email))) - (let loop ((lines result)) - (when (not (null? lines)) - (print " | " (car lines)) - (loop (cdr lines)))))) + (print "Remove " email " from " lst "." (if (*dummy-run*) " [no-op]" "")) + (when (not (*dummy-run*)) + (let ((result + (get-mailman3-output-lines + "delmembers" + "-l" (format "~A@brmlab.cz" lst) + "-m" email))) + (let loop ((lines result)) + (when (not (null? lines)) + (print " | " (car lines)) + (loop (cdr lines))))))) )