Compare commits

...

5 commits

14 changed files with 73 additions and 63 deletions

View file

@ -1,6 +1,14 @@
ChangeLog
=========
1.19 - released 2025-04-16
--------------------------
* manpage updated
* added -n option for dry-runs
* removed mailman 2.x support
* added "councilml" start/stop support for member files
1.18 - released 2025-01-06
--------------------------

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

@ -188,7 +188,7 @@ 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
mbase.import.scm brmember.import.scm configuration.import.scm
export-cards.o: export-cards.import.scm
export-cards.import.scm: $(EXPORT-CARDS-SOURCES)

View file

@ -61,7 +61,8 @@
grantstart grantstop
joined destroyed
feestart feestop
phone))
phone
councilmlstart councilmlstop))
(define ignored-keys '(mail2))
(define known-keys (append mandatory-keys optional-keys))
@ -88,6 +89,9 @@
(feestart fee start)
(feestop fee stop)
(councilmlstart councilml start)
(councilmlstop councilml stop)
))
(define start-stop-markers (map car start-stop-markers-lookup))
@ -114,7 +118,7 @@
(info
,(lambda (mr output key value)
(case key
((student suspend member revision chair council grant fee)
((student suspend member revision chair council grant fee councilml)
(let* ((res (period-markers->cal-periods value))
(ok? (car res))
(periods0 (cadr res))

View file

@ -65,6 +65,7 @@
brmember-chair?
brmember-council?
brmember-councilml?
brmember-revision?
brmember-grant?
@ -394,6 +395,7 @@
;; Predicates for all organizational bodies recognized
(define brmember-chair? (brmember-body? 'chair))
(define brmember-council? (brmember-body? 'council))
(define brmember-councilml? (brmember-body? 'councilml))
(define brmember-revision? (brmember-body? 'revision))
(define brmember-grant? (brmember-body? 'grant))

View file

@ -43,6 +43,7 @@
*mailman3-sql*
*mailman3-sql-path*
*notifications-cc*
*dummy-run*
load-configuration!
)
@ -100,7 +101,7 @@
;; Which version of mailman to use
(define *mailman-version* (make-parameter #f))
(define =mailman-version= 2)
(define =mailman-version= 3)
;; What is the mailman 3 command
(define *mailman3-bin* (make-parameter #f))
@ -111,7 +112,7 @@
;; A string is the default, gets converted to boolean at the end of
;; loading configuration
(define *mailman3-sql* (make-parameter #f))
(define =mailman3-sql= "0")
(define =mailman3-sql= "1")
;; The path to SQLite3 DB file
(define *mailman3-sql-path* (make-parameter #f))
@ -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))))

View file

@ -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)
(when (not (*dummy-run*))
(cards-export/type mb 'card cardsfn)
(cards-export/type mb 'desfire desfirefn))
(cards-export/type mb 'desfire desfirefn)))
)

View file

@ -191,10 +191,11 @@
;; Generates all members in given directory
(define (gen-html-members 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))
(clean-members-files mb dir)))
)

View file

@ -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"

View file

@ -73,6 +73,7 @@
(define (rada-ml-pred? mr)
(or (brmember-council? mr)
(brmember-chair? mr)
(brmember-revision? mr)))
(brmember-revision? mr)
(brmember-councilml? mr)))
)

View file

@ -37,7 +37,8 @@
(chicken base)
(chicken format)
sqlite3
configuration)
configuration
(chicken condition))
;; Thread-local parameter to re-use SQLite3 DB handle for subsequent queries
(define *cached-mailman3-db* (make-parameter #f))
@ -55,10 +56,15 @@
;; Returns the list of mailman3 mailinglists by querying te
;; underlying SQLite3 DB directly
(define (list-mailman3-sql-lists)
(handle-exceptions
ex
'()
(let ((result
(let-values (((stmt _)
(prepare (mailman3-db)
"SELECT list_name FROM mailinglist")))
(map-row identity stmt)))
(map-row identity stmt))))
result)))
;; Returns a list of email addresses subscribed to given mailinglist
(define (list-mailman3-sql-list-members lst)

View file

@ -94,7 +94,8 @@
;; Adds given email
(define (add-email-to-mailman3-list lst email)
(print "Add " email " to " lst ".")
(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))
@ -102,11 +103,12 @@
(let loop ((lines result))
(when (not (null? lines))
(print " | " (car lines))
(loop (cdr lines))))))
(loop (cdr lines)))))))
;; Removes given email from given listname
(define (remove-email-from-mailman3-list lst email)
(print "Remove " email " from " lst ".")
(print "Remove " email " from " lst "." (if (*dummy-run*) " [no-op]" ""))
(when (not (*dummy-run*))
(let ((result
(get-mailman3-output-lines
"delmembers"
@ -115,6 +117,6 @@
(let loop ((lines result))
(when (not (null? lines))
(print " | " (car lines))
(loop (cdr lines))))))
(loop (cdr lines)))))))
)

View file

@ -114,7 +114,7 @@
(caddr c)))
(brmember-credit mr))
#:border '(((#:right light) ... none) ...))))
((suspend student member council chair revision grant)
((suspend student member council chair revision grant councilml)
(let* ((pdata (cons (list "Since" "Until")
(map
(lambda (p)

View file

@ -39,7 +39,7 @@
(chicken format))
;; Short banner
(define banner-line "HackerBase 1.19-dev (c) 2023-2025 Brmlab, z.s.")
(define banner-line "HackerBase 1.19 (c) 2023-2025 Brmlab, z.s.")
;; Banner source with numbers for ANSI CSI SGR
(define banner-source "