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

Prepare for loading all mailinglists.

Browse source
This commit is contained in:
Dominik Pantůček 2023-04-06 19:54:04 +02:00
parent 6aab5d9fcf
commit 56e1a70068
2 changed files with 14 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

21
src/bbstool.scm
View file

@ -65,8 +65,9 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
(define -run-tests?- (make-parameter #f)) (define -run-tests?- (make-parameter #f))
(define -web-dir- (make-parameter #f)) (define -web-dir- (make-parameter #f))
(define -bank-dir- (make-parameter #f)) (define -bank-dir- (make-parameter #f))
(define -cards-enabled- (make-parameter #t)) (define -normal-month- (make-parameter #t))
(define -jendasap-checked- (make-parameter "checked.ntlm")) (define -jendasap-checked- (make-parameter "checked.ntlm"))
(define -ml-all- (make-parameter #f))
;; Arguments parsing ;; Arguments parsing
(command-line (command-line
@ -84,7 +85,7 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
"Configuration options:" "Configuration options:"
(-members (dir) "Members base directory" (*members-directory* dir)) (-members (dir) "Members base directory" (*members-directory* dir))
(-month (YYYY-MM) "Specify current month" (-month (YYYY-MM) "Specify current month"
(-cards-enabled- #f) (-normal-month- #f)
(*current-month* (string->month YYYY-MM))) (*current-month* (string->month YYYY-MM)))
(-tstyle (style) "Use given table style: debug, ascii, unicode" (-tstyle (style) "Use given table style: debug, ascii, unicode"
(*table-border-style* (string->symbol style))) (*table-border-style* (string->symbol style)))
@ -94,6 +95,8 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
(-bank-dir- dir)) (-bank-dir- dir))
(-checked (file) "JendaSAP checked.ntlm file" (-checked (file) "JendaSAP checked.ntlm file"
(-jendasap-checked- file)) (-jendasap-checked- file))
(-ml-all () "Load all mailman lists"
(-ml-all- #t))
"" ""
"Query options:" "Query options:"
(-mi (id) "Specify member by id" (-member-id- (string->number id))) (-mi (id) "Specify member by id" (-member-id- (string->number id)))
@ -161,11 +164,13 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
mb)) mb))
#f)) #f))
;; Load ML(s) ;; Load ML(s) and merge them
(define internal-ml (load-mailman-list "internal")) (define MB
(cond ((-ml-all-)
;; Merge (define internal-ml (load-mailman-list "internal"))
(define MB (members-base-merge-mailman MB0 internal-ml)) (members-base-merge-mailman MB0 internal-ml))
(else
MB0)))
;; If a member is specified by either id or nick, get its record ;; If a member is specified by either id or nick, get its record
(define mr (define mr
@ -222,7 +227,7 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
(print "New member id: " (gen-member-id MB)) (print "New member id: " (gen-member-id MB))
(newline)) (newline))
((gencards) ((gencards)
(if (-cards-enabled-) (if (-normal-month-)
(apply cards-export MB (-fname-)) (apply cards-export MB (-fname-))
(print "Cards export disabled with manually specified current month."))) (print "Cards export disabled with manually specified current month.")))
((problems) ((problems)

2
src/members-print.scm
View file

@ -138,7 +138,7 @@
(ansi-string #:red #:bold "---"))))))) (ansi-string #:red #:bold "---")))))))
sikeys)) sikeys))
(mailman (list (list "Mailing Lists" (mailman (list (list "Mailing Lists"
(string-intersperse (member-mailman mr) ", ")))) (string-intersperse (member-mailman mr) "\n"))))
(result (filter identity (append head body mailman)))) (result (filter identity (append head body mailman))))
(table->string result #:table-border #f #:row-border #t #:col-border #t #:ansi #t))) (table->string result #:table-border #f #:row-border #t #:col-border #t #:ansi #t)))