From 24c829cbc858a6302cf4ec190598e966dd5ffdb6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 5 Dec 2023 22:04:14 +0100 Subject: [PATCH 01/95] Fix depdendencies for gendoc. --- doc/d-utils.md | 10 ++++++++++ src/Makefile | 5 +++-- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/doc/d-utils.md b/doc/d-utils.md index fdf2ad2..08b8a43 100644 --- a/doc/d-utils.md +++ b/doc/d-utils.md @@ -388,6 +388,16 @@ quoted-printable sequences. Returns the ```str``` with all characters converted to upper case using ```char-upcase```. Does not work with UTF-8. +### string-capitalize [procedure] + + (string-capitalize str) + +* ```str``` - arbitrary string + +Returns the ```str``` with the first character converted to upper case +using ```char-upcase``` and the remainder converted to lower case +using ```char-downcase```. Does not work with UTF-8. + ## util-mail [module] (import util-mail) diff --git a/src/Makefile b/src/Makefile index 0615ce5..5af8425 100644 --- a/src/Makefile +++ b/src/Makefile @@ -68,14 +68,15 @@ GENDOC-SOURCES=gendoc.scm duck-extract.import.scm \ util-format.import.scm util-tag.import.scm \ util-string.import.scm util-bst.import.scm \ util-bst-bdict.import.scm util-bst-ldict.import.scm \ - util-dir.import.scm util-utf8.import.scm + util-dir.import.scm util-utf8.import.scm util-mail.import.scm \ + util-bst-lset.import.scm GENDOC-OBJS=gendoc.o duck-extract.o util-time.o util-csv.o util-io.o \ progress.o testing.o util-proc.o util-git.o util-io.o \ util-stdout.o util-parser.o util-proc.o util-format.o \ racket-kwargs.o util-bst-ldict.o util-tag.o duck.o \ util-string.o util-bst.o util-bst-bdict.o util-bst-ldict.o \ - util-dir.o util-utf8.o + util-dir.o util-utf8.o util-bst-lset.o util-mail.o .PHONY: imports imports: $(HACKERBASE-DEPS) From 0b23dd6666132389f24569b211a47acdd88b2bcf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 5 Dec 2023 22:16:08 +0100 Subject: [PATCH 02/95] Start work on tiocgwinsz. --- src/Makefile | 7 +++++- src/tiocgwinsz.scm | 58 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 64 insertions(+), 1 deletion(-) create mode 100644 src/tiocgwinsz.scm diff --git a/src/Makefile b/src/Makefile index 5af8425..d8f6d50 100644 --- a/src/Makefile +++ b/src/Makefile @@ -59,7 +59,7 @@ 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 + mailman-common.o mailman3.o mailman3-sql.o tiocgwinsz.o GENDOC-SOURCES=gendoc.scm duck-extract.import.scm \ util-time.import.scm util-csv.import.scm util-git.import.scm \ @@ -544,3 +544,8 @@ MAILMAN3-SQL-SOURCES=mailman3-sql.scm configuration.import.scm mailman3-sql.o: mailman3-sql.import.scm mailman3-sql.import.scm: $(MAILMAN3-SQL-SOURCES) + +TIOCGWINSZ-SOURCES=tiocgwinsz.scm + +tiocgwinsz.o: tiocgwinsz.import.scm +tiocgwinsz.import.scm: $(TIOCGWINSZ-SOURCES) diff --git a/src/tiocgwinsz.scm b/src/tiocgwinsz.scm new file mode 100644 index 0000000..fb77d66 --- /dev/null +++ b/src/tiocgwinsz.scm @@ -0,0 +1,58 @@ +;; +;; tiocgwinsz.scm +;; +;; Get size of current terminal. +;; +;; ISC License +;; +;; Copyright 2023 Brmlab, z.s. +;; Dominik Pantůček +;; +;; 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 tiocgwinsz)) + +(module + tiocgwinsz + ( + tiocgwinsz + ) + + (import scheme + (chicken foreign) + (chicken bitwise)) + + (foreign-declare "#include ") + + (define tiocgwinsz-ioctl + (foreign-lambda* + int () + " +struct winsize wss; +if (ioctl(0, TIOCGWINSZ, &wss) == 0) { + C_return(wss.ws_row*65536+wss.ws_col); +} else { + C_return(0); +} +" + )) + + (define (tiocgwinsz) + (let ((res (tiocgwinsz-ioctl))) + (values (bitwise-and res #xffff) + (arithmetic-shift res -16)))) + + ) From fd05ecda88aaf5ddfcb2ab16f7469328d19b491f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 5 Dec 2023 22:22:27 +0100 Subject: [PATCH 03/95] Duck tiocgwinsz. --- src/tiocgwinsz.scm | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/tiocgwinsz.scm b/src/tiocgwinsz.scm index fb77d66..8d00ff8 100644 --- a/src/tiocgwinsz.scm +++ b/src/tiocgwinsz.scm @@ -25,8 +25,11 @@ (declare (unit tiocgwinsz)) -(module +(import duck) + +(module* tiocgwinsz + #:doc ("TTY terminal size support.") ( tiocgwinsz ) @@ -50,7 +53,8 @@ if (ioctl(0, TIOCGWINSZ, &wss) == 0) { " )) - (define (tiocgwinsz) + (define/doc (tiocgwinsz) + ("Returns the number of terminal rows and columns.") (let ((res (tiocgwinsz-ioctl))) (values (bitwise-and res #xffff) (arithmetic-shift res -16)))) From b34770269ee084bd8b505dd5f4b3f6b3cf3f2fae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 5 Dec 2023 22:33:59 +0100 Subject: [PATCH 04/95] Use tiocgwinsz for printing the info table. --- src/Makefile | 5 +- src/members-print.scm | 194 +++++++++++++++++++++--------------------- src/tiocgwinsz.scm | 13 +-- 3 files changed, 108 insertions(+), 104 deletions(-) diff --git a/src/Makefile b/src/Makefile index d8f6d50..c71d1ff 100644 --- a/src/Makefile +++ b/src/Makefile @@ -206,7 +206,8 @@ MEMBERS-PRINT-SOURCES=members-print.scm util-bst-ldict.import.scm \ bank-account.import.scm members-fees.import.scm \ members-payments.import.scm brmember-format.import.scm \ specification.import.scm cal-format.import.scm \ - util-git.import.scm racket-kwargs.import.scm + util-git.import.scm racket-kwargs.import.scm \ + tiocgwinsz.import.scm members-print.o: members-print.import.scm members-print.import.scm: $(MEMBERS-PRINT-SOURCES) @@ -545,7 +546,7 @@ MAILMAN3-SQL-SOURCES=mailman3-sql.scm configuration.import.scm mailman3-sql.o: mailman3-sql.import.scm mailman3-sql.import.scm: $(MAILMAN3-SQL-SOURCES) -TIOCGWINSZ-SOURCES=tiocgwinsz.scm +TIOCGWINSZ-SOURCES=tiocgwinsz.scm duck.import.scm tiocgwinsz.o: tiocgwinsz.import.scm tiocgwinsz.import.scm: $(TIOCGWINSZ-SOURCES) diff --git a/src/members-print.scm b/src/members-print.scm index 3fdf736..2784851 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -67,7 +67,8 @@ cal-format util-git cal-day - racket-kwargs) + racket-kwargs + tiocgwinsz) (define *show-payments-count* (make-parameter 36)) @@ -301,102 +302,103 @@ ;; Prints nicely aligned members base info (define (print-members-base-table mb) - (let* ((total-count (length - (find-members-by-predicate mb brmember-usable?))) - (invalid-mrs (find-members-by-predicate - mb - (compose not is-4digit-prime? brmember-id))) - (suspended-mrs (find-members-by-predicate mb brmember-suspended?)) - (debtor-mrs (sort - (members-to-notify mb 3) - brmemberstring - (filter - identity - (list (list "Type" "Count" "List") - (members-pred-table-row mb - (ansi-string #:yellow "Chair:") - brmember-chair? - "~N") - (members-pred-table-row mb - (ansi-string #:yellow "Council:") - brmember-council? - "~N") - (members-pred-table-row mb - (ansi-string #:yellow "Revision:") - brmember-revision? - "~N") - (members-pred-table-row mb - (ansi-string #:yellow "Grant:") - brmember-grant? - "~N") - (members-pred-table-row mb - (string-append a:success "Active:") - brmember-active? - "~N~E") - (members-pred-table-row mb - (string-append a:highlight "Students:") - brmember-student? - "~N~E") - (members-table-row a:warning "Suspended:" suspended-mrs "~N~E (~S)") - (members-pred-table-row mb - (string-append a:warning "Destroyed:") - brmember-destroyed? - "~N~E") - (let ((suspended2 (filter - (lambda (mr) - (>= (brmember-suspended-months mr) - member-suspend-max-months)) - suspended-mrs))) - (if (null? suspended2) + (let-values (((rows columns) (term-size))) + (let* ((total-count (length + (find-members-by-predicate mb brmember-usable?))) + (invalid-mrs (find-members-by-predicate + mb + (compose not is-4digit-prime? brmember-id))) + (suspended-mrs (find-members-by-predicate mb brmember-suspended?)) + (debtor-mrs (sort + (members-to-notify mb 3) + brmemberstring + (filter + identity + (list (list "Type" "Count" "List") + (members-pred-table-row mb + (ansi-string #:yellow "Chair:") + brmember-chair? + "~N") + (members-pred-table-row mb + (ansi-string #:yellow "Council:") + brmember-council? + "~N") + (members-pred-table-row mb + (ansi-string #:yellow "Revision:") + brmember-revision? + "~N") + (members-pred-table-row mb + (ansi-string #:yellow "Grant:") + brmember-grant? + "~N") + (members-pred-table-row mb + (string-append a:success "Active:") + brmember-active? + "~N~E") + (members-pred-table-row mb + (string-append a:highlight "Students:") + brmember-student? + "~N~E") + (members-table-row a:warning "Suspended:" suspended-mrs "~N~E (~S)") + (members-pred-table-row mb + (string-append a:warning "Destroyed:") + brmember-destroyed? + "~N~E") + (let ((suspended2 (filter + (lambda (mr) + (>= (brmember-suspended-months mr) + member-suspend-max-months)) + suspended-mrs))) + (if (null? suspended2) + #f + (members-table-row (ansi #:magenta) "Suspended (long):" suspended2 "~N (~S)"))) + (if (null? soon-expire-mrs) #f - (members-table-row (ansi #:magenta) "Suspended (long):" suspended2 "~N (~S)"))) - (if (null? soon-expire-mrs) - #f - (members-table-row (ansi #:magenta #:bold) "Expire Soon:" - soon-expire-mrs "~N (~S)")) - (members-pred-table-row mb - (ansi-string #:red #:bold "Prolems:") - brmember-has-problems? - "~N~E ~A") - (if (null? debtor-mrs) - #f - (list (ansi-string "\t" #:magenta #:bold "Debtors:") - (format "~A" (length debtor-mrs)) - (table->string - (append - (members-attrs-table debtor-mrs - brmember-format - (list "Name" "Balance" "Last Payment") - (list "~N" "\t~B" "~L")) - (list - (list - "Total" - (format - "\t~A" - (foldr - (lambda (v a) - (+ (member-total-balance v) a)) - 0 - debtor-mrs))))) - #:border '(((#:bottom #:right light) ... (#:bottom light)) - ((#:right light) ... none) ... - ((#:top #:right light) ... (#:top light))) - #:ansi-reset? #t))) - )) - #:border '(((#:bottom #:right light) ... (#:bottom light)) - ... - ((#:right light) ... none)) - #:width 70 - #:ansi-reset? #t))) + (members-table-row (ansi #:magenta #:bold) "Expire Soon:" + soon-expire-mrs "~N (~S)")) + (members-pred-table-row mb + (ansi-string #:red #:bold "Prolems:") + brmember-has-problems? + "~N~E ~A") + (if (null? debtor-mrs) + #f + (list (ansi-string "\t" #:magenta #:bold "Debtors:") + (format "~A" (length debtor-mrs)) + (table->string + (append + (members-attrs-table debtor-mrs + brmember-format + (list "Name" "Balance" "Last Payment") + (list "~N" "\t~B" "~L")) + (list + (list + "Total" + (format + "\t~A" + (foldr + (lambda (v a) + (+ (member-total-balance v) a)) + 0 + debtor-mrs))))) + #:border '(((#:bottom #:right light) ... (#:bottom light)) + ((#:right light) ... none) ... + ((#:top #:right light) ... (#:top light))) + #:ansi-reset? #t))) + )) + #:border '(((#:bottom #:right light) ... (#:bottom light)) + ... + ((#:right light) ... none)) + #:width (- columns 10) + #:ansi-reset? #t)))) (let ((pmrs (find-members-by-predicate mb brmember-file-has-problems?))) (when (not (null? pmrs)) (newline) diff --git a/src/tiocgwinsz.scm b/src/tiocgwinsz.scm index 8d00ff8..78eda74 100644 --- a/src/tiocgwinsz.scm +++ b/src/tiocgwinsz.scm @@ -27,19 +27,19 @@ (import duck) +(foreign-declare "#include ") + (module* tiocgwinsz #:doc ("TTY terminal size support.") ( - tiocgwinsz + term-size ) (import scheme (chicken foreign) (chicken bitwise)) - (foreign-declare "#include ") - (define tiocgwinsz-ioctl (foreign-lambda* int () @@ -53,10 +53,11 @@ if (ioctl(0, TIOCGWINSZ, &wss) == 0) { " )) - (define/doc (tiocgwinsz) + (define/doc (term-size) ("Returns the number of terminal rows and columns.") (let ((res (tiocgwinsz-ioctl))) - (values (bitwise-and res #xffff) - (arithmetic-shift res -16)))) + (values + (arithmetic-shift res -16) + (bitwise-and res #xffff)))) ) From fb6e0868ded4406cf521e15aa34543db8b51a023 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 5 Dec 2023 22:36:02 +0100 Subject: [PATCH 05/95] Do not format paragraph for table. --- src/members-print.scm | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/members-print.scm b/src/members-print.scm index 2784851..ee02be2 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -268,11 +268,9 @@ (define (members-table-row a:? label mrs fmt) (list (string-append "\t" a:? label) (length mrs) - (ansi-paragraph-format - (member-records->string - (sort mrs brmemberstring + (sort mrs brmember Date: Wed, 6 Dec 2023 20:56:17 +0100 Subject: [PATCH 06/95] Handle sqlite busy locking. --- src/mailman3-sql.scm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/mailman3-sql.scm b/src/mailman3-sql.scm index a9a0fc8..741ec23 100644 --- a/src/mailman3-sql.scm +++ b/src/mailman3-sql.scm @@ -45,7 +45,11 @@ ;; Returns (possibly cached) SQLite3 DB handle (define (mailman3-db) (when (not (*cached-mailman3-db*)) - (*cached-mailman3-db* (open-database (*mailman3-sql-path*)))) + (*cached-mailman3-db* + (let ((handler (make-busy-timeout 2000))) + (let ((db (open-database (*mailman3-sql-path*)))) + (set-busy-handler! db handler) + db)))) (*cached-mailman3-db*)) ;; Returns the list of mailman3 mailinglists by querying te From 2dc8d3c119365a9cde6d70c9f40a842d431f9fea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Wed, 6 Dec 2023 21:00:35 +0100 Subject: [PATCH 07/95] Fix -notify and -notify3 output with -quiet. --- src/hackerbase.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/hackerbase.scm b/src/hackerbase.scm index f458a18..3844dd9 100644 --- a/src/hackerbase.scm +++ b/src/hackerbase.scm @@ -406,7 +406,7 @@ (if (null? nmembers) (print "Everyone paid on time.") (let () - (print "Notify" (-notify-months-)) + (stdout-print "Notify" (-notify-months-)) (let loop ((lst nmembers)) (when (and (not (null? lst)) (or (not mr) From 45a7af9c27d31f182e56158b716c551cfbe17ad6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Wed, 6 Dec 2023 21:33:47 +0100 Subject: [PATCH 08/95] Add -only-active to -fees. --- src/hackerbase.scm | 5 ++++- src/members-print.scm | 17 ++++++++++++----- 2 files changed, 16 insertions(+), 6 deletions(-) diff --git a/src/hackerbase.scm b/src/hackerbase.scm index 3844dd9..9494c10 100644 --- a/src/hackerbase.scm +++ b/src/hackerbase.scm @@ -62,6 +62,7 @@ (define -web-dir- (make-parameter #f)) (define -normal-month- (make-parameter #t)) (define -show-destroyed- (make-parameter #f)) +(define -show-only-active- (make-parameter #f)) (define -notify-months- (make-parameter 1)) (define -send-emails- (make-parameter #f)) @@ -137,6 +138,8 @@ "Misc options:" (-destroyed () "Show destroyed members in -fees" (-show-destroyed- #t)) + (-only-active () "Show only active members in -fees" + (-show-only-active- #t)) "" "Base Actions:" (-info () "Print information" @@ -372,7 +375,7 @@ (newline) (if mr (print-member-balances-table mr) - (print-members-fees-table MB (-show-destroyed-)))) + (print-members-fees-table MB (-show-destroyed-) (-show-only-active-))) ((repl) (repl)) ((genweb) diff --git a/src/members-print.scm b/src/members-print.scm index ee02be2..86e14c1 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -471,10 +471,14 @@ ")")))) ;; Prints summary table of all fees and credits for all members - (define (print-members-fees-table MB . ds) - (let ((destroyed? (if (null? ds) + (define (print-members-fees-table MB . dsa) + (let ((destroyed? (if (null? dsa) #f - (car ds)))) + (car dsa))) + (only-active? (if (or (null? dsa) + (null? (cdr dsa))) + #f + (cadr dsa)))) (let* ((members ;; Pass 1 (map (lambda (mr) @@ -500,8 +504,11 @@ (sort (if destroyed? (find-members-by-predicate MB (lambda x #t)) - (find-members-by-predicate MB (lambda (mr) - (not (brmember-destroyed? mr))))) + (if only-active? + (find-members-by-predicate MB (lambda (mr) + (brmember-active? mr))) + (find-members-by-predicate MB (lambda (mr) + (not (brmember-destroyed? mr)))))) brmember Date: Wed, 6 Dec 2023 21:34:29 +0100 Subject: [PATCH 09/95] Add missing parenthesis. --- src/hackerbase.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/hackerbase.scm b/src/hackerbase.scm index 9494c10..24552d1 100644 --- a/src/hackerbase.scm +++ b/src/hackerbase.scm @@ -375,7 +375,7 @@ (newline) (if mr (print-member-balances-table mr) - (print-members-fees-table MB (-show-destroyed-) (-show-only-active-))) + (print-members-fees-table MB (-show-destroyed-) (-show-only-active-)))) ((repl) (repl)) ((genweb) From a294055929cc21b2b3a648f3bd3449eada00977d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Wed, 6 Dec 2023 21:37:03 +0100 Subject: [PATCH 10/95] Bump version to 1.14 --- src/texts.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/texts.scm b/src/texts.scm index dc7ff17..2ee52b7 100644 --- a/src/texts.scm +++ b/src/texts.scm @@ -39,7 +39,7 @@ (chicken format)) ;; Short banner - (define banner-line "HackerBase 1.13 (c) 2023 Brmlab, z.s.") + (define banner-line "HackerBase 1.14 (c) 2023 Brmlab, z.s.") ;; Banner source with numbers for ANSI CSI SGR (define banner-source " From 12e957fedda5e17fb7c00878a8124bcf35991c43 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Wed, 6 Dec 2023 21:41:19 +0100 Subject: [PATCH 11/95] Fix missing licences and typos. --- src/configuration.scm | 2 +- src/gendoc.scm | 24 ++++++++++++++++++++++++ src/util-bst-bdict.scm | 24 ++++++++++++++++++++++++ src/util-bst-ldict.scm | 24 ++++++++++++++++++++++++ src/util-bst-lset.scm | 24 ++++++++++++++++++++++++ src/util-bst.scm | 24 ++++++++++++++++++++++++ 6 files changed, 121 insertions(+), 1 deletion(-) diff --git a/src/configuration.scm b/src/configuration.scm index 7b9b7af..3518efc 100644 --- a/src/configuration.scm +++ b/src/configuration.scm @@ -1,5 +1,5 @@ ;; -;; configuraiton.scm +;; configuration.scm ;; ;; Configuration parameters used by various modules. ;; diff --git a/src/gendoc.scm b/src/gendoc.scm index e5afddc..2ffd3ac 100644 --- a/src/gendoc.scm +++ b/src/gendoc.scm @@ -1,3 +1,27 @@ +;; +;; gendoc.scm +;; +;; Generate documentation for all documented modules dynamically. +;; +;; ISC License +;; +;; Copyright 2023 Brmlab, z.s. +;; Dominik Pantůček +;; +;; 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. +;; (import duck-extract) diff --git a/src/util-bst-bdict.scm b/src/util-bst-bdict.scm index 1a2c6a7..bf198de 100644 --- a/src/util-bst-bdict.scm +++ b/src/util-bst-bdict.scm @@ -1,3 +1,27 @@ +;; +;; util-bst-bdict.scm +;; +;; BST-based number dictionary. +;; +;; ISC License +;; +;; Copyright 2023 Brmlab, z.s. +;; Dominik Pantůček +;; +;; 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 util-bst-bdict)) diff --git a/src/util-bst-ldict.scm b/src/util-bst-ldict.scm index 1810793..99d0393 100644 --- a/src/util-bst-ldict.scm +++ b/src/util-bst-ldict.scm @@ -1,3 +1,27 @@ +;; +;; util-bst-ldict.scm +;; +;; BST-based symbol dictionary. +;; +;; ISC License +;; +;; Copyright 2023 Brmlab, z.s. +;; Dominik Pantůček +;; +;; 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 util-bst-ldict)) diff --git a/src/util-bst-lset.scm b/src/util-bst-lset.scm index 48bf226..b8a035f 100644 --- a/src/util-bst-lset.scm +++ b/src/util-bst-lset.scm @@ -1,3 +1,27 @@ +;; +;; util-bst-lset.scm +;; +;; BST-based set implementation. +;; +;; ISC License +;; +;; Copyright 2023 Brmlab, z.s. +;; Dominik Pantůček +;; +;; 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 util-bst-lset)) diff --git a/src/util-bst.scm b/src/util-bst.scm index 93f97a7..c27d518 100644 --- a/src/util-bst.scm +++ b/src/util-bst.scm @@ -1,3 +1,27 @@ +;; +;; util-bst.scm +;; +;; Underlying BST implementation for sets and dictionaries. +;; +;; ISC License +;; +;; Copyright 2023 Brmlab, z.s. +;; Dominik Pantůček +;; +;; 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 util-bst)) From c00b0f82834435e50cdb04cb16cd642bf5464c07 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Mon, 18 Dec 2023 10:42:29 +0100 Subject: [PATCH 12/95] Increase membership fees starting 2024-01. --- src/specification.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/specification.scm b/src/specification.scm index 310d8d4..b2bc5bf 100644 --- a/src/specification.scm +++ b/src/specification.scm @@ -39,7 +39,8 @@ ;; Convert into lookups - a list of (list period regular student) (define member-fees-lookup-table (make-cal-period-lookup-table - '(((2010 1) 500 250)))) + '(((2010 1) 500 250) + ((2024 1) 1000 250)))) ;; Exchange rates (define exchange-rates-lookup-table From 259a2664a00e058c85d1aa04492f6fba0af9066f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Mon, 18 Dec 2023 22:39:52 +0100 Subject: [PATCH 13/95] Parse feestart/feestop as generic start/stop. --- src/brmember-parser.scm | 15 +++++++++++---- src/members-print.scm | 2 +- 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/src/brmember-parser.scm b/src/brmember-parser.scm index 8068404..4ad58a4 100644 --- a/src/brmember-parser.scm +++ b/src/brmember-parser.scm @@ -59,7 +59,8 @@ councilstart councilstop revisionstart revisionstop grantstart grantstop - joined destroyed)) + joined destroyed + feestart feestop)) (define ignored-keys '(mail2)) (define known-keys (append mandatory-keys optional-keys)) @@ -83,6 +84,9 @@ (joined member start) (destroyed member stop) + + (feestart fee start) + (feestop fee stop) )) (define start-stop-markers (map car start-stop-markers-lookup)) @@ -109,7 +113,7 @@ (info ,(lambda (mr output key value) (case key - ((student suspend member revision chair council grant) + ((student suspend member revision chair council grant fee) (let* ((res (period-markers->cal-periods value)) (ok? (car res)) (periods (cadr res)) @@ -159,7 +163,10 @@ mr0 (cdr value) "Whitespace not allowed in nick" 3 'error) mr0))) (else - (brmember-sub-set mr output key (car value)))))))) + (brmember-sub-set mr output key (car value)))))) + (fee + ,(lambda (mr output key value) + mr)))) ;; Pass 4: Final checks - add defaults (define (member-schema-finalize mr) @@ -253,7 +260,7 @@ (caar passes) (interpreter-pass mr pass-name (ldict-ref mr prev-name) pass-proc))))))) - ;; Loads member file source. Performs passes 0, 1 and 2. + ;; Loads member file source. Performs passes 0-4 (define (load-brmember-file mr) (let* ((mrif (brmember-input-file mr)) (source (read-lines mrif)) diff --git a/src/members-print.scm b/src/members-print.scm index 86e14c1..adf90c4 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -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 fee) (let* ((pdata (cons (list "Since" "Until") (map (lambda (p) From 055f7ba030a035c54d1c946aa3d87394f2ef2dd4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Mon, 18 Dec 2023 22:56:23 +0100 Subject: [PATCH 14/95] Parsing of amount in fee period specification. --- src/brmember-parser.scm | 31 ++++++++++++++++++++++--------- src/cal-period.scm | 10 ++++++++++ 2 files changed, 32 insertions(+), 9 deletions(-) diff --git a/src/brmember-parser.scm b/src/brmember-parser.scm index 4ad58a4..71e5637 100644 --- a/src/brmember-parser.scm +++ b/src/brmember-parser.scm @@ -116,7 +116,23 @@ ((student suspend member revision chair council grant fee) (let* ((res (period-markers->cal-periods value)) (ok? (car res)) - (periods (cadr res)) + (periods0 (cadr res)) + (periods + (if (eq? key 'fee) + (let ((ps + (map + (lambda (p) + (let* ((sc (cal-period-scomment p)) + (scp (string-first+rest sc)) + (amts (car scp)) + (amt (string->number amts)) + (rc (cdr scp))) + (set-cal-period-scomment + p + (list amt rc)))) + periods0))) + ps) + periods0)) (msg (caddr res)) (line-number (cadddr res)) (mr1 (brmember-sub-set mr output key periods))) @@ -125,10 +141,10 @@ (brmember-add-highlight mr1 line-number msg 3 'error)))) ((card desfire) (brmember-sub-set mr output key - (map - (lambda (rec) - (string-first+rest (car rec))) - value))) + (map + (lambda (rec) + (string-first+rest (car rec))) + value))) ((credit) (let loop ((mr mr) (src-credits value) @@ -163,10 +179,7 @@ mr0 (cdr value) "Whitespace not allowed in nick" 3 'error) mr0))) (else - (brmember-sub-set mr output key (car value)))))) - (fee - ,(lambda (mr output key value) - mr)))) + (brmember-sub-set mr output key (car value)))))))) ;; Pass 4: Final checks - add defaults (define (member-schema-finalize mr) diff --git a/src/cal-period.scm b/src/cal-period.scm index 74c6e15..48c29ba 100644 --- a/src/cal-period.scm +++ b/src/cal-period.scm @@ -43,6 +43,8 @@ cal-period-before cal-period-scomment cal-period-bcomment + + set-cal-period-scomment period-markers->cal-periods @@ -142,6 +144,14 @@ (define cal-period-scomment cadddr) (define cal-period-bcomment (compose cadddr cdr)) + ;; Direct updater + (define (set-cal-period-scomment p c) + (list TAG-CAL-PERIOD + (cal-period-since p) + (cal-period-before p) + c + (cal-period-bcomment p))) + ;; Type predicate (define (cal-period? p) (and (pair? p) From b9030db455a0e3c364e0c055cbd185384dee21c4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Mon, 18 Dec 2023 23:02:35 +0100 Subject: [PATCH 15/95] Formatting of new fee period amounts. --- src/members-print.scm | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/src/members-print.scm b/src/members-print.scm index adf90c4..cc16605 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -114,7 +114,7 @@ (caddr c))) (brmember-credit mr)) #:border '(((#:right light) ... none) ...)))) - ((suspend student member council chair revision grant fee) + ((suspend student member council chair revision grant) (let* ((pdata (cons (list "Since" "Until") (map (lambda (p) @@ -132,6 +132,27 @@ ;;(print pdata) ;;(write ptbl)(newline) (list k ptbl))) + ((fee) + (let* ((pdata + (cons + (list "Amount" "Since" "Until") + (map + (lambda (p) + (list + (format "\t~A" (car (cal-period-scomment p))) + (string-append (cal-day/month->string + (cal-period-since p)) " " + (or (cadr (cal-period-scomment p)) "")) + (string-append (cal-day/month->string + (cal-period-before p)) " " + (or (cal-period-bcomment p) "")))) + v))) + (ptbl (table->string + pdata + #:border '(((#:right light) ... none) ...)))) + ;;(print pdata) + ;;(write ptbl)(newline) + (list k ptbl))) (else (if v (list k v) From 28dd25998b2840ef938a2ef7504b80cc5c2729b3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sat, 23 Dec 2023 19:48:43 +0100 Subject: [PATCH 16/95] Match fee periods properly. --- src/brmember.scm | 14 ++++++++++++++ src/cal-period.scm | 15 +++++++++++++++ src/members-fees.scm | 6 +++++- 3 files changed, 34 insertions(+), 1 deletion(-) diff --git a/src/brmember.scm b/src/brmember.scm index 8603e36..51db8bd 100644 --- a/src/brmember.scm +++ b/src/brmember.scm @@ -85,6 +85,8 @@ brmember-mailman brmember-add-mailman + brmember-spec-fee + brmember-tests! ) @@ -478,6 +480,18 @@ (cons ml (brmember-mailman mr)))) + ;; Returns special fee for current month or #f if it should be default + (define (brmember-spec-fee mr) + (let ((fee-periods (brmember-info mr 'fee #f))) + (if fee-periods + (let ((fee-period (cal-month-find-period fee-periods))) + (if fee-period + (let () + (print fee-period) + #t) + #f)) + #f))) + ;; Self-tests (define (brmember-tests!) (run-tests diff --git a/src/cal-period.scm b/src/cal-period.scm index 48c29ba..ea1cf3d 100644 --- a/src/cal-period.scm +++ b/src/cal-period.scm @@ -53,6 +53,8 @@ cal-month-in-period? cal-month-in-periods? + cal-month-find-period + cal-day-in-period? cal-day-in-periods? @@ -265,6 +267,19 @@ #t (loop (cdr ps))))))) + ;; Returns true if given month is in at least one of the periods + ;; given. Defaults to current month. + (define (cal-month-find-period ps . ml) + (let ((m (if (null? ml) + (*current-month*) + (car ml)))) + (let loop ((ps ps)) + (if (null? ps) + #f + (if (cal-month-in-period? (car ps) m) + (car ps) + (loop (cdr ps))))))) + ;; Checks whether given day belongs to day or month period (define (cal-day-in-period? p . dl) (let ((d (if (null? dl) diff --git a/src/members-fees.scm b/src/members-fees.scm index 1d92ab9..6659fcb 100644 --- a/src/members-fees.scm +++ b/src/members-fees.scm @@ -85,7 +85,11 @@ (cons (list cm (with-current-month cm - (brmember-flags mr))) + (brmember-flags mr)) + ;; TODO: the following needs to be handled everywhere + (with-current-month + cm + (brmember-spec-fee mr))) cal)))))) ;; Returns the first month of the calendar From c987ac6c8104e5c96e2c42be8b3d67f3eb56300e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sat, 23 Dec 2023 19:57:40 +0100 Subject: [PATCH 17/95] Use specific fee in all computations. --- src/brmember.scm | 3 +-- src/members-fees.scm | 9 ++++++--- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/src/brmember.scm b/src/brmember.scm index 51db8bd..fb9e07e 100644 --- a/src/brmember.scm +++ b/src/brmember.scm @@ -487,8 +487,7 @@ (let ((fee-period (cal-month-find-period fee-periods))) (if fee-period (let () - (print fee-period) - #t) + (car (cal-period-scomment fee-period))) #f)) #f))) diff --git a/src/members-fees.scm b/src/members-fees.scm index 6659fcb..a77affd 100644 --- a/src/members-fees.scm +++ b/src/members-fees.scm @@ -86,7 +86,6 @@ (with-current-month cm (brmember-flags mr)) - ;; TODO: the following needs to be handled everywhere (with-current-month cm (brmember-spec-fee mr))) @@ -115,7 +114,9 @@ (ansi-string #:bgblack "\xc2\xa0\xc2\xa0") ; Destroyed (if (member 'student (cadr e)) (ansi-string #:bgyellow "\xc2\xa0\xc2\xa0") ; Student - (ansi-string #:bggreen "\xc2\xa0\xc2\xa0")))) ; Normal + (if (caddr e) + (ansi-string #:bgblue (format "~a" (caddr e))) + (ansi-string #:bggreen "\xc2\xa0\xc2\xa0"))))) ; Normal "\xc2\xa0\xc2\xa0") ; Nonexistent - should not happen "\xc2\xa0\xc2\xa0")) ; Nonexistent @@ -129,7 +130,9 @@ 0 ; Destroyed (if (member 'student (cadr e)) (lookup-member-fee 'student) ; Student - (lookup-member-fee 'regular)))) ; Normal + (if (caddr e) + (caddr e) + (lookup-member-fee 'regular))))) ; Normal 0) ; Nonexistent - should not happen 0)) ; Nonexistent From af5976ad436b7313a83d2200266d8103ccfe0873 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sat, 23 Dec 2023 20:52:01 +0100 Subject: [PATCH 18/95] Add changelog. --- CHANGELOG.md | 136 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 136 insertions(+) create mode 100644 CHANGELOG.md diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..6c593ff --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,136 @@ +ChangeLog +========= + +1.15 +---- + +* increase membership fees starting 2024-01 (specification.rkt) +* add support for explicit fee amounts for specified period + +1.14 +---- + +* add support for dynamic terminal size +* use table cell formatting instead of paragraph formatting everywhere +* fix sqlite3 database locking issue +* allow limiting -fees output to -active only + +1.13 +---- + +* add dokuwiki problems to summary emails +* handle more SEPA payments + +1.12 +---- + +* switch to eggs: srfi-1, sqlite3 +* semi-automatic export for brmdoor +* improvements of summary emails for council +* redirect dokuwiki plugin to login page if not logged in +* sync council and revision mailing lists + +1.11 +---- + +* add support for CC in emails +* update manual page +* setup new cron jobs + +1.10 +---- + +* direct access of mailman 3 database + +1.9 +--- + +* implement support for mailman 3 +* add total debt to long-term debtors listings + +1.8 +--- + +* remove old compatibility static web pages generator +* update documentation +* update Fio fetcher to handle new limits imposed by the bank +* output plain list of active members (used by BrmBar project) + +1.7 +--- + +* include current month in stats +* right-alignment in table cells +* functionality improvements of dokuwiki plugin +* checking council group between dokuwiki and members database + +1.6 +--- + +* dokuwiki plugin +* delete generated files for destroyed members +* verify dokuwiki users information + +1.5 +--- + +* improved table renderer +* show membership fees and payments balances history +* improved generator of static web pages + +1.4 +--- + +* vim and joe syntax highlighting support +* improved Fio bank statement fetcher and merger + +1.3 +--- + +* organizational bodies membership + +1.2 +--- + +* split configuration and action command-line options +* support for git annotate +* show suspended members that are about to expire +* optimized utf-8 support + +1.1 +--- + +* support for suppressing output (used in cron jobs) +* sorted members in notifications +* report missing keys in member files +* internal ML membership synchronization + +1.0 +--- + +This was the first oficially released version which contains all the +functionality required to take over the original solution. + +* parsing and interpreting member files with specified grammar +* basic support for start/stop periods +* command-line arguments support with integrated help display +* static builds +* cards export for BrmDoor project +* data validation and error reporting +* improved manual credit handling +* member id validation and generation +* export of gnuplot-compatible statistics +* static web data generation +* table formatting with color support +* member fees and payments accounting +* support for multiple join/destroy periods +* period-based exchange rates lookups +* unpaired transactions handling +* internal ML membership check +* notifications for both council and members with debts +* universal Fio bank account statement fetcher +* preliminary SEPA payment parsing +* programming modules documentation +* git status support +* sample configuration +* manual page From 0b70563b101ff7b12dcc0748b3563f2e82817841 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sun, 24 Dec 2023 21:25:22 +0100 Subject: [PATCH 19/95] Support for multiple phones. --- src/brmember-parser.scm | 7 ++++--- src/members-print.scm | 2 +- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/src/brmember-parser.scm b/src/brmember-parser.scm index 71e5637..4c35225 100644 --- a/src/brmember-parser.scm +++ b/src/brmember-parser.scm @@ -48,7 +48,7 @@ cal-day) ;; Pass 2: known keys - (define mandatory-keys '(nick name mail phone)) + (define mandatory-keys '(nick name mail)) (define optional-keys '(born)) (define known-multikeys '(card desfire @@ -60,7 +60,8 @@ revisionstart revisionstop grantstart grantstop joined destroyed - feestart feestop)) + feestart feestop + phone)) (define ignored-keys '(mail2)) (define known-keys (append mandatory-keys optional-keys)) @@ -139,7 +140,7 @@ (if ok? mr1 (brmember-add-highlight mr1 line-number msg 3 'error)))) - ((card desfire) + ((card desfire phone) (brmember-sub-set mr output key (map (lambda (rec) diff --git a/src/members-print.scm b/src/members-print.scm index cc16605..fad53e6 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -97,7 +97,7 @@ (body (map (lambda (k) (let ((v (ldict-ref info k))) (case k - ((card desfire) + ((card desfire phone) (list k (table->string (map From 4f59fbc6cf1c4b68b96b3d4520510e0c33f3ae38 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sun, 24 Dec 2023 21:27:36 +0100 Subject: [PATCH 20/95] Document member file format changes. --- doc/formats.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/doc/formats.md b/doc/formats.md index ac5ccb8..36f8a73 100644 --- a/doc/formats.md +++ b/doc/formats.md @@ -56,7 +56,6 @@ Processed source is scanned for known keys. Known keys are: * nick * name * mail -* phone * born Multiple instances of single key are considered an error. @@ -83,6 +82,7 @@ line numbers as the value for such key. Multikeys are: * revisionstop * grantstart * grantstop +* phone The result is a valid dictionary of keys and multikeys. @@ -104,7 +104,8 @@ periods. The joined key is converted into a month value. Card and desfire lists are parsed to get lists of card id and optional -comment. +comment. The same processing is used for phone to support multiple +phone numbers. Credit list is parsed to get a list of amounts and optional comments. From 5f03e0c251bdf790a7cf9ad2c130f32d5ee5e5d7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sun, 24 Dec 2023 21:33:53 +0100 Subject: [PATCH 21/95] Another SEPA parser. --- src/members-payments.scm | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/src/members-payments.scm b/src/members-payments.scm index bf2c416..8c8fc41 100644 --- a/src/members-payments.scm +++ b/src/members-payments.scm @@ -90,12 +90,21 @@ (substring msg 0 ci2) msg)) (ci3 (substring-index "NULL" msg)) - (vs3 (if ci3 + (vs3 (if (and ci3 + (>= (string-length msg) (+ ci3 8))) (substring msg (+ ci3 4) (+ ci3 4 4)) - msg))) + msg)) + (ci4 (substring-index "VS" msg)) + (vs4 (if (and ci4 + (>= (string-length msg) (+ ci4 6))) + (substring msg (+ ci4 2) (+ ci4 6)) + msg)) + ) (or (string->number vs1) (string->number vs2) - (string->number vs3)))))) + (string->number vs3) + (string->number vs4) + ))))) varsym-id))) ;; Special comparator (originally with JendaSAP hack) From 778f89717f31ab02db866ad6d08570c1fee349f1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sun, 24 Dec 2023 21:35:38 +0100 Subject: [PATCH 22/95] Bump version to 1.15 --- src/texts.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/texts.scm b/src/texts.scm index 2ee52b7..6108737 100644 --- a/src/texts.scm +++ b/src/texts.scm @@ -39,7 +39,7 @@ (chicken format)) ;; Short banner - (define banner-line "HackerBase 1.14 (c) 2023 Brmlab, z.s.") + (define banner-line "HackerBase 1.15 (c) 2023 Brmlab, z.s.") ;; Banner source with numbers for ANSI CSI SGR (define banner-source " From 0e82221c165e7aeafa6f41f35866b4c5b790d47e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 2 Jan 2024 12:59:33 +0100 Subject: [PATCH 23/95] Fix current month setting for members-fees calculation. --- src/members-fees.scm | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/src/members-fees.scm b/src/members-fees.scm index a77affd..7fe3dc8 100644 --- a/src/members-fees.scm +++ b/src/members-fees.scm @@ -122,19 +122,21 @@ ;; Converts the entry into the fee (define (member-calendar-entry->fee e) - (if e - (if (member 'existing (cadr e)) - (if (member 'suspended (cadr e)) - 0 ; Suspended - (if (member 'destroyed (cadr e)) - 0 ; Destroyed - (if (member 'student (cadr e)) - (lookup-member-fee 'student) ; Student - (if (caddr e) - (caddr e) - (lookup-member-fee 'regular))))) ; Normal - 0) ; Nonexistent - should not happen - 0)) ; Nonexistent + (with-current-month + (car e) + (if e + (if (member 'existing (cadr e)) + (if (member 'suspended (cadr e)) + 0 ; Suspended + (if (member 'destroyed (cadr e)) + 0 ; Destroyed + (if (member 'student (cadr e)) + (lookup-member-fee 'student) ; Student + (if (caddr e) + (caddr e) + (lookup-member-fee 'regular))))) ; Normal + 0) ; Nonexistent - should not happen + 0))) ; Nonexistent ;; Converts the calendar into a table where rows represent years and ;; contain the year in the first cell and 12 cells for months after From 3b68a9f834b4701d15314c2dbed8c1ee159bda9a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 2 Jan 2024 13:01:57 +0100 Subject: [PATCH 24/95] Fix info without loaded ML. --- src/hackerbase.scm | 35 ++++++++++++++++++----------------- 1 file changed, 18 insertions(+), 17 deletions(-) diff --git a/src/hackerbase.scm b/src/hackerbase.scm index 24552d1..fcaa90a 100644 --- a/src/hackerbase.scm +++ b/src/hackerbase.scm @@ -288,23 +288,24 @@ (define* (check-mailing-list mls name #:pred? (pred? #f)) (define ml (find-mailman-list mls name)) - (let-values (((missing surplus) - (mailman-compare-members ml - (mbase-active-emails MB - #:suspended #t - #: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))))))) + (when ml + (let-values (((missing surplus) + (mailman-compare-members ml + (mbase-active-emails MB + #:suspended #t + #: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) From 9b165490e57727c2b9a61b9f4895942a28d4e45c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 2 Jan 2024 13:02:15 +0100 Subject: [PATCH 25/95] Bump version to 1.15.1 --- src/texts.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/texts.scm b/src/texts.scm index 6108737..fbcb67e 100644 --- a/src/texts.scm +++ b/src/texts.scm @@ -39,7 +39,7 @@ (chicken format)) ;; Short banner - (define banner-line "HackerBase 1.15 (c) 2023 Brmlab, z.s.") + (define banner-line "HackerBase 1.15.1 (c) 2023 Brmlab, z.s.") ;; Banner source with numbers for ANSI CSI SGR (define banner-source " From 2baffe570be6f4c1e49fa0672aed2809e4144b5c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 2 Jan 2024 13:12:50 +0100 Subject: [PATCH 26/95] Update changelog for 1.15.1 --- CHANGELOG.md | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6c593ff..7428ca4 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,13 @@ ChangeLog ========= +1.15.1 +------ + +* fix calculating historical membership fee (was erroneously based on + current date) +* fix showing basic information without MLs loaded + 1.15 ---- From a64ab232c679be0dc9d879677aa42b2fa22a8436 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 16 Jan 2024 21:50:13 +0100 Subject: [PATCH 27/95] Fix tests. --- src/brmember.scm | 4 ++-- src/util-bst.scm | 10 ++++++---- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/src/brmember.scm b/src/brmember.scm index fb9e07e..e83c9dd 100644 --- a/src/brmember.scm +++ b/src/brmember.scm @@ -499,8 +499,8 @@ (ldict-equal? (make-brmember '|1234| "members/1234" '(|member|)) (make-ldict - `((file-name . |1234|) - (TAG . ,TAG-BRMEMBER) + `((TAG . ,TAG-BRMEMBER) + (file-name . |1234|) (file-path . "members/1234") (symlinks |member|) (id . 1234))))) diff --git a/src/util-bst.scm b/src/util-bst.scm index c27d518..236fdd3 100644 --- a/src/util-bst.scm +++ b/src/util-bst.scm @@ -286,10 +286,12 @@ (call/cc (lambda (cc) (set! break cc) - (if resume - (resume '()) - (bst-iter-kv bst yield)) - #f))))) + (cond (resume + (resume '()) + (break #f)) + (else + (bst-iter-kv bst yield) + (break #f)))))))) (define/doc (bst-keys bst) ("Returns all the keys contained in given dictionary.") From 939af54e8786e29e6c4eea3dc191738f9e3c07c9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 16 Jan 2024 21:54:10 +0100 Subject: [PATCH 28/95] Sync mlcheck with mlsync. --- src/hackerbase.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/hackerbase.scm b/src/hackerbase.scm index fcaa90a..0cd8438 100644 --- a/src/hackerbase.scm +++ b/src/hackerbase.scm @@ -286,13 +286,13 @@ (print " " (car keys) ": " (length (ldict-ref status (car keys))))) (loop (cdr keys))))))) -(define* (check-mailing-list mls name #:pred? (pred? #f)) +(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 #t + #:suspended suspended #:pred? pred? )))) (if (null? (cdr ml)) @@ -323,7 +323,7 @@ (let () (print-members-base-table MB) (newline) - (check-mailing-list MLS "internal") + (check-mailing-list MLS "internal" #:suspended #t) (check-mailing-list MLS "rada" #:pred? rada-ml-pred?) (check-mailing-list MLS "rk" #:pred? brmember-revision?) From 65c7155ba3bff39749e03c0c1246f86fe25f94ff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 16 Jan 2024 21:58:30 +0100 Subject: [PATCH 29/95] Log exception details. --- src/dokuwiki.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/dokuwiki.scm b/src/dokuwiki.scm index db944ce..c246fe7 100644 --- a/src/dokuwiki.scm +++ b/src/dokuwiki.scm @@ -74,8 +74,8 @@ (handle-exceptions exn (let () - (log-warning "DokuWiki: cannot open ~A" fname) - (stdout-printf "DokuWiki: cannot open ~A" fname) + (log-warning "DokuWiki (~A) exception ~A" fname exn) + (stdout-printf "DokuWiki (~A) exception ~A" fname exn) '()) (with-input-from-file fname parse-dokuwiki-users-auth))) From 3629844743395c30fe420bddcea65f4b273f6de2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 16 Jan 2024 22:01:27 +0100 Subject: [PATCH 30/95] Convert condition to list. --- src/dokuwiki.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/dokuwiki.scm b/src/dokuwiki.scm index c246fe7..ca6d6e3 100644 --- a/src/dokuwiki.scm +++ b/src/dokuwiki.scm @@ -74,8 +74,8 @@ (handle-exceptions exn (let () - (log-warning "DokuWiki (~A) exception ~A" fname exn) - (stdout-printf "DokuWiki (~A) exception ~A" fname exn) + (log-warning "DokuWiki (~A) exception ~A" fname (condition->list exn)) + (stdout-printf "DokuWiki (~A) exception ~A" fname (condition->list exn)) '()) (with-input-from-file fname parse-dokuwiki-users-auth))) From 2674f086740683ee1f485dd89cde71e326ad779a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 16 Jan 2024 22:03:32 +0100 Subject: [PATCH 31/95] Print line-by-line for debugging. --- src/dokuwiki.scm | 1 + 1 file changed, 1 insertion(+) diff --git a/src/dokuwiki.scm b/src/dokuwiki.scm index ca6d6e3..f57a85e 100644 --- a/src/dokuwiki.scm +++ b/src/dokuwiki.scm @@ -55,6 +55,7 @@ (if (null? lines) users (let ((line (parser-preprocess-line (car lines)))) + (print line) (if (equal? line "") (loop (cdr lines) users) From ba2c7531095dde132bf02f8dbd27c4cdaa520426 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 16 Jan 2024 22:10:56 +0100 Subject: [PATCH 32/95] Allow parsing config lines without comments. --- src/Makefile | 2 +- src/dokuwiki.scm | 3 +-- src/util-parser.scm | 6 ++++-- 3 files changed, 6 insertions(+), 5 deletions(-) diff --git a/src/Makefile b/src/Makefile index c71d1ff..9ce79b5 100644 --- a/src/Makefile +++ b/src/Makefile @@ -291,7 +291,7 @@ util-io.o: util-io.import.scm util-io.import.scm: $(UTIL-IO-SOURCES) UTIL-PARSER-SOURCES=util-parser.scm testing.import.scm \ - duck.import.scm + duck.import.scm racket-kwargs.import.scm util-parser.o: util-parser.import.scm util-parser.import.scm: $(UTIL-PARSER-SOURCES) diff --git a/src/dokuwiki.scm b/src/dokuwiki.scm index f57a85e..40c2585 100644 --- a/src/dokuwiki.scm +++ b/src/dokuwiki.scm @@ -54,8 +54,7 @@ (users '())) (if (null? lines) users - (let ((line (parser-preprocess-line (car lines)))) - (print line) + (let ((line (parser-preprocess-line (car lines) #:strip-comments? #f))) (if (equal? line "") (loop (cdr lines) users) diff --git a/src/util-parser.scm b/src/util-parser.scm index 789827f..40f49ac 100644 --- a/src/util-parser.scm +++ b/src/util-parser.scm @@ -39,11 +39,12 @@ member file parsers. All functions are UTF-8 aware.") (import scheme (chicken base) + racket-kwargs testing) ;; Pass 0: Removes any comments and removes any leading and trailing ;; whitespace. - (define/doc (parser-preprocess-line line) + (define*/doc (parser-preprocess-line line #:strip-comments? (strip-comments? #t)) ("* ```line``` - a string with contents of one source line If the input ```line``` contains the ```#``` character, the rest of @@ -62,7 +63,8 @@ Returns a string representing the preprocessed line.") (ploop (add1 pidx))))) (hpos (let hloop ((hidx ppos)) (if (or (= hidx llen) - (eq? (string-ref line hidx) #\#)) + (and strip-comments? + (eq? (string-ref line hidx) #\#))) hidx (hloop (add1 hidx))))) (spos (let sloop ((sidx (sub1 hpos))) From 707bb1d61ecad8a07585fbf27f4cf420295bf05d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 16 Jan 2024 22:13:17 +0100 Subject: [PATCH 33/95] More debugging. --- src/dokuwiki.scm | 1 + 1 file changed, 1 insertion(+) diff --git a/src/dokuwiki.scm b/src/dokuwiki.scm index 40c2585..e8b01ba 100644 --- a/src/dokuwiki.scm +++ b/src/dokuwiki.scm @@ -55,6 +55,7 @@ (if (null? lines) users (let ((line (parser-preprocess-line (car lines) #:strip-comments? #f))) + (print line) (if (equal? line "") (loop (cdr lines) users) From 6282a934c676102db548eb45df5038db03fb9471 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 16 Jan 2024 22:14:41 +0100 Subject: [PATCH 34/95] Always handle lines starting with # as comment. --- src/util-parser.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/util-parser.scm b/src/util-parser.scm index 40f49ac..24e05ed 100644 --- a/src/util-parser.scm +++ b/src/util-parser.scm @@ -63,7 +63,8 @@ Returns a string representing the preprocessed line.") (ploop (add1 pidx))))) (hpos (let hloop ((hidx ppos)) (if (or (= hidx llen) - (and strip-comments? + (and (or strip-comments? + (= hidx 0)) (eq? (string-ref line hidx) #\#))) hidx (hloop (add1 hidx))))) From d0771e130aba7624047073df4f4054eeff81b957 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 16 Jan 2024 22:16:51 +0100 Subject: [PATCH 35/95] Remove debug output, bump version to -dev. --- src/dokuwiki.scm | 1 - src/texts.scm | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/src/dokuwiki.scm b/src/dokuwiki.scm index e8b01ba..40c2585 100644 --- a/src/dokuwiki.scm +++ b/src/dokuwiki.scm @@ -55,7 +55,6 @@ (if (null? lines) users (let ((line (parser-preprocess-line (car lines) #:strip-comments? #f))) - (print line) (if (equal? line "") (loop (cdr lines) users) diff --git a/src/texts.scm b/src/texts.scm index fbcb67e..e48b9e1 100644 --- a/src/texts.scm +++ b/src/texts.scm @@ -39,7 +39,7 @@ (chicken format)) ;; Short banner - (define banner-line "HackerBase 1.15.1 (c) 2023 Brmlab, z.s.") + (define banner-line "HackerBase 1.16-dev (c) 2023 Brmlab, z.s.") ;; Banner source with numbers for ANSI CSI SGR (define banner-source " From ed55660c80e39d9f0ea30bc27faa170e62ca25ae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 16 Jan 2024 22:26:18 +0100 Subject: [PATCH 36/95] Add finished issues to changelog for next version. --- CHANGELOG.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 7428ca4..4ca8353 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,12 @@ ChangeLog ========= +1.16 +---- + +* handle # character at weird positions in DokuWiki users.auth.php +* unify -mlsync and -mlcheck handling of member predicates + 1.15.1 ------ From dc3044026c5da188787fa99831b8f18adf594a3c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 8 Feb 2024 21:05:08 +0100 Subject: [PATCH 37/95] Fix utf-8 3-byte handling. --- src/util-utf8.scm | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/util-utf8.scm b/src/util-utf8.scm index 14a4c6b..0deef64 100644 --- a/src/util-utf8.scm +++ b/src/util-utf8.scm @@ -120,13 +120,13 @@ of the string and a list of remaining bytes (as integers).") (define/doc (utf8-bytes->lists chars) ("The same as above but accepts a list of bytes (as integers).") (let loop ((bytes chars) - (rpending '()) + (rpending chars) (pending 0) (expected #f) (res '())) (if (null? bytes) (values (reverse res) - (reverse rpending)) + rpending) (let ((byte (car bytes))) (cond (expected ;; Decode UTF-8 sequence @@ -135,14 +135,14 @@ of the string and a list of remaining bytes (as integers).") (let ((char (integer->char (bitwise-ior pending (bitwise-and byte #b111111))))) (loop (cdr bytes) - '() + (cdr bytes) 0 #f (cons char res)))) (else ;; Intermediate bytes (loop (cdr bytes) - (cons byte rpending) + rpending (arithmetic-shift (bitwise-ior pending (bitwise-and byte #b111111)) 6) (sub1 expected) @@ -152,7 +152,7 @@ of the string and a list of remaining bytes (as integers).") (cond ((= (bitwise-and byte #b10000000) 0) ;; ASCII (loop (cdr bytes) - '() + (cdr bytes) 0 #f (cons (integer->char byte) res))) @@ -160,20 +160,20 @@ of the string and a list of remaining bytes (as integers).") ;; First byte of UTF-8 sequence (let-values (((first-byte char-bytes) - (cond ((= (bitwise-and byte #b11000000) #b11000000) + (cond ((= (bitwise-and byte #b11100000) #b11000000) (values (bitwise-and byte #b11111) 2)) - ((= (bitwise-and byte #b11100000) #b11100000) + ((= (bitwise-and byte #b11110000) #b11100000) (values (bitwise-and byte #b1111) 3)) - ((= (bitwise-and byte #b11110000) #b11110000) + ((= (bitwise-and byte #b11111000) #b11110000) (values (bitwise-and byte #b111) 4)) (else ;; Should not happen (values 0 0))))) (loop (cdr bytes) - (list byte) + bytes (arithmetic-shift first-byte 6) (sub1 char-bytes) res)))))))))) From 15888b7e3e29a992462a5b4c33f03f5ed9379abc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 9 Feb 2024 14:28:17 +0100 Subject: [PATCH 38/95] Fix computing expected income based on actual fees and discounts. --- src/members-fees.scm | 17 ++++++++------ src/members-print.scm | 52 +++++++++++++++++++++++++------------------ 2 files changed, 40 insertions(+), 29 deletions(-) diff --git a/src/members-fees.scm b/src/members-fees.scm index 7fe3dc8..a79aa0e 100644 --- a/src/members-fees.scm +++ b/src/members-fees.scm @@ -30,6 +30,7 @@ ( lookup-member-fee member-calendar + make-member-calendar-entry member-calendar-first-month member-calendar-last-month member-calendar-query @@ -82,15 +83,17 @@ (if (cal-month>? cm last-month) (reverse cal) (loop (cal-month-add cm) - (cons (list cm - (with-current-month - cm - (brmember-flags mr)) - (with-current-month - cm - (brmember-spec-fee mr))) + (cons (with-current-month + cm + (make-member-calendar-entry mr)) cal)))))) + ;; Assumes current-month is specified correctly + (define (make-member-calendar-entry mr) + (list (*current-month*) + (brmember-flags mr) + (brmember-spec-fee mr))) + ;; Returns the first month of the calendar (define (member-calendar-first-month mc) (caar mc)) diff --git a/src/members-print.scm b/src/members-print.scm index fad53e6..b470e13 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -500,7 +500,17 @@ (null? (cdr dsa))) #f (cadr dsa)))) - (let* ((members ;; Pass 1 + (let* ((raw-members + (sort + (if destroyed? + (find-members-by-predicate MB (lambda x #t)) + (if only-active? + (find-members-by-predicate MB (lambda (mr) + (brmember-active? mr))) + (find-members-by-predicate MB (lambda (mr) + (not (brmember-destroyed? mr)))))) + brmemberfee make-member-calendar-entry) + (filter brmember-active? raw-members))) + (amts (sort (delete-duplicates flst) <)) + (sums + (map + (lambda (amt) + (cons amt + (length (filter (lambda (v) (= v amt)) flst)))) + amts)) + ) (print "Expected income: " - (+ (* (lookup-member-fee 'normal) full) - (* (lookup-member-fee 'student) students)) - " (" full " full members + " students " students)")) - ) - )) + (string-intersperse (map + (lambda (p) + (format "~A*~A" (cdr p) (car p))) + sums) + " + ") + " = " + (foldl + 0 (map (lambda (p) (* (car p) (cdr p))) sums))))))) (define (unpaired-table mb . args) (apply From dcf6d8937fdd6ca550860c0509584adb22d67c6d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 9 Feb 2024 14:30:06 +0100 Subject: [PATCH 39/95] Update changelog. --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 4ca8353..f98a821 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,8 @@ ChangeLog * handle # character at weird positions in DokuWiki users.auth.php * unify -mlsync and -mlcheck handling of member predicates +* handle unicode characters with 3-byte UTF-8 representation correctly +* calculate expected income with respect to discounts granted 1.15.1 ------ From c458dc39009927ed7635ec9615ad5759a5ea3922 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 9 Feb 2024 14:44:24 +0100 Subject: [PATCH 40/95] Use the same algorithm for expected income in summary emails. --- src/members-fees.scm | 23 +++++++++++++++++++++++ src/members-print.scm | 20 +------------------- src/notifications.scm | 4 +--- 3 files changed, 25 insertions(+), 22 deletions(-) diff --git a/src/members-fees.scm b/src/members-fees.scm index a79aa0e..5a3b0c3 100644 --- a/src/members-fees.scm +++ b/src/members-fees.scm @@ -41,12 +41,14 @@ member-calendar->table members-summary member-calendar-entry->fee + get-expected-income-string ) (import scheme (chicken base) (chicken format) (chicken sort) + (chicken string) srfi-1 configuration brmember @@ -205,5 +207,26 @@ (+ (cdr acc) (if (brmember-student? mr) 0 1)))) (cons 0 0) members))) + + (define (get-expected-income-string mb) + (let* ((flst + (map (compose member-calendar-entry->fee make-member-calendar-entry) + (find-members-by-predicate mb brmember-active?))) + (amts (sort (delete-duplicates flst) <)) + (sums + (map + (lambda (amt) + (cons amt + (length (filter (lambda (v) (= v amt)) flst)))) + amts))) + (string-append + "Expected income: " + (string-intersperse (map + (lambda (p) + (format "~A*~A" (cdr p) (car p))) + sums) + " + ") + " = " + (number->string (foldl + 0 (map (lambda (p) (* (car p) (cdr p))) sums)))))) ) diff --git a/src/members-print.scm b/src/members-print.scm index b470e13..2591238 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -600,25 +600,7 @@ (map (lambda (member) (min 0 (list-ref member 5))) members))) - (let* ((flst - (map (compose member-calendar-entry->fee make-member-calendar-entry) - (filter brmember-active? raw-members))) - (amts (sort (delete-duplicates flst) <)) - (sums - (map - (lambda (amt) - (cons amt - (length (filter (lambda (v) (= v amt)) flst)))) - amts)) - ) - (print "Expected income: " - (string-intersperse (map - (lambda (p) - (format "~A*~A" (cdr p) (car p))) - sums) - " + ") - " = " - (foldl + 0 (map (lambda (p) (* (car p) (cdr p))) sums))))))) + (print (get-expected-income-string MB))))) (define (unpaired-table mb . args) (apply diff --git a/src/notifications.scm b/src/notifications.scm index afe2835..bd31e9e 100644 --- a/src/notifications.scm +++ b/src/notifications.scm @@ -149,9 +149,7 @@ (income (+ (* (lookup-member-fee 'normal) full) (* (lookup-member-fee 'student) students))) (income-lst - (list (format "Expected income: ~A CZK" income) - (format " ~A full members" full) - (format " ~A students" students))) + (list (get-expected-income-string mb))) (unpaired (mbase-unpaired mb)) (unpaired-lst (if (null? unpaired) From a9f5fc74e4e6cf3c9576a63960618bd719bc2841 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 9 Feb 2024 14:51:26 +0100 Subject: [PATCH 41/95] Add members expiring soon to the summary email. --- src/notifications.scm | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/src/notifications.scm b/src/notifications.scm index bd31e9e..7c13482 100644 --- a/src/notifications.scm +++ b/src/notifications.scm @@ -158,6 +158,23 @@ (list "" "Unpaired transactions:") (unpaired-table mb #:border-style 'ascii)))) + (soonexps (sort + (find-members-by-predicate + mb + (brmember-suspended-for 21 24)) + brmember Date: Fri, 9 Feb 2024 14:53:34 +0100 Subject: [PATCH 42/95] Update the changelog. --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index f98a821..7f9440d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,6 +8,7 @@ ChangeLog * unify -mlsync and -mlcheck handling of member predicates * handle unicode characters with 3-byte UTF-8 representation correctly * calculate expected income with respect to discounts granted +* report soon-expiring members in the summary emails 1.15.1 ------ From fabb387ba18b4ad643b7f6dac4ddabc672764b1e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 9 Feb 2024 15:01:21 +0100 Subject: [PATCH 43/95] Split out mailinglist check base. --- src/Makefile | 11 ++++++-- src/hackerbase.scm | 30 ++++----------------- src/mailinglist.scm | 63 +++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 77 insertions(+), 27 deletions(-) create mode 100644 src/mailinglist.scm diff --git a/src/Makefile b/src/Makefile index 9ce79b5..bf542ff 100644 --- a/src/Makefile +++ b/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) diff --git a/src/hackerbase.scm b/src/hackerbase.scm index 0cd8438..08b9b80 100644 --- a/src/hackerbase.scm +++ b/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) diff --git a/src/mailinglist.scm b/src/mailinglist.scm new file mode 100644 index 0000000..9f227f4 --- /dev/null +++ b/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 +;; +;; 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)))))))) + + ) From d24b7c4136d5d84be122e23a2d5328b4c021c40e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 9 Feb 2024 15:05:49 +0100 Subject: [PATCH 44/95] Move more to the new mailinglist module. --- src/Makefile | 3 ++- src/hackerbase.scm | 10 +--------- src/mailinglist.scm | 15 ++++++++++++++- 3 files changed, 17 insertions(+), 11 deletions(-) diff --git a/src/Makefile b/src/Makefile index bf542ff..f7f288c 100644 --- a/src/Makefile +++ b/src/Makefile @@ -553,7 +553,8 @@ 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 + mailman.import.scm mbase.import.scm util-string.import.scm \ + brmember.import.scm mailinglist.o: mailinglist.import.scm mailinglist.import.scm: $(MAILINGLIST-SOURCES) diff --git a/src/hackerbase.scm b/src/hackerbase.scm index 08b9b80..d19c31c 100644 --- a/src/hackerbase.scm +++ b/src/hackerbase.scm @@ -287,11 +287,6 @@ (print " " (car keys) ": " (length (ldict-ref status (car keys))))) (loop (cdr keys))))))) -(define (rada-ml-pred? mr) - (or (brmember-council? mr) - (brmember-chair? mr) - (brmember-revision? mr))) - ;; Perform requested action (case (-action-) ((print-info) @@ -303,10 +298,7 @@ (let () (print-members-base-table MB) (newline) - (check-mailing-list MB MLS "internal" #:suspended #t) - (check-mailing-list MB MLS "rada" - #:pred? rada-ml-pred?) - (check-mailing-list MB MLS "rk" #:pred? brmember-revision?) + (print-mailing-list-checks MB MLS) (print-git-status))) (newline)) ((print-stats) diff --git a/src/mailinglist.scm b/src/mailinglist.scm index 9f227f4..8fa8aa8 100644 --- a/src/mailinglist.scm +++ b/src/mailinglist.scm @@ -29,6 +29,7 @@ mailinglist ( check-mailing-list + print-mailing-list-checks ) (import scheme @@ -37,7 +38,8 @@ racket-kwargs mailman mbase - util-string) + util-string + brmember) (define* (check-mailing-list MB mls name #:pred? (pred? #f) #:suspended (suspended #f)) (define ml (find-mailman-list mls name)) @@ -60,4 +62,15 @@ (when (not (null? surplus)) (print " Outsiders: " surplus)))))))) + (define (print-mailing-list-checks MB MLS) + (check-mailing-list MB MLS "internal" #:suspended #t) + (check-mailing-list MB MLS "rada" + #:pred? rada-ml-pred?) + (check-mailing-list MB MLS "rk" #:pred? brmember-revision?)) + + (define (rada-ml-pred? mr) + (or (brmember-council? mr) + (brmember-chair? mr) + (brmember-revision? mr))) + ) From 6947dd37b33eb5be76639134fde2d0ff7eb9b438 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 9 Feb 2024 15:13:09 +0100 Subject: [PATCH 45/95] Report ML check status in summary emails. --- CHANGELOG.md | 1 + src/Makefile | 3 ++- src/hackerbase.scm | 4 ++-- src/notifications.scm | 25 +++++++++++++++++-------- 4 files changed, 22 insertions(+), 11 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 7f9440d..c2301f2 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,7 @@ ChangeLog * handle unicode characters with 3-byte UTF-8 representation correctly * calculate expected income with respect to discounts granted * report soon-expiring members in the summary emails +* report mailing lists check status in summary emails 1.15.1 ------ diff --git a/src/Makefile b/src/Makefile index f7f288c..010c646 100644 --- a/src/Makefile +++ b/src/Makefile @@ -333,7 +333,8 @@ NOTIFICATIONS-SOURCES=notifications.scm brmember.import.scm \ brmember-format.import.scm configuration.import.scm \ util-time.import.scm members-fees.import.scm mbase.import.scm \ members-print.import.scm table.import.scm \ - bank-account.import.scm logging.import.scm + bank-account.import.scm logging.import.scm \ + mailinglist.import.scm notifications.o: notifications.import.scm notifications.import.scm: $(NOTIFICATIONS-SOURCES) diff --git a/src/hackerbase.scm b/src/hackerbase.scm index d19c31c..6579723 100644 --- a/src/hackerbase.scm +++ b/src/hackerbase.scm @@ -396,8 +396,8 @@ (print-git-status)) ((summary) (if (-send-emails-) - (make+send-summary-email MB) - (make+print-summary-email MB))) + (make+send-summary-email MB MLS) + (make+print-summary-email MB MLS))) ((list) (for-each (lambda (mr) (print (brmember-nick mr))) diff --git a/src/notifications.scm b/src/notifications.scm index 7c13482..91e37a0 100644 --- a/src/notifications.scm +++ b/src/notifications.scm @@ -40,6 +40,7 @@ (chicken format) (chicken string) (chicken sort) + (chicken port) brmember util-mail util-bst-ldict @@ -54,7 +55,8 @@ table bank-account logging - srfi-1) + srfi-1 + mailinglist) ;; Prints email to the console (define (print-notification-email em) @@ -142,7 +144,7 @@ (send-notification-email em))) ;; Summary email of membership fees payments - (define (summary-email-body mb) + (define (summary-email-body mb mls) (let* ((mbs (members-summary mb)) (students (car mbs)) (full (cdr mbs)) @@ -175,6 +177,12 @@ (brmember-format "~N (~S)" mr)) soonexps) ","))))) + (mlcheck-lst + (string-split + (with-output-to-string + (lambda () + (print-mailing-list-checks mb mls))) + "\n")) (debtors (sort (members-to-notify mb 1) brmember Date: Fri, 9 Feb 2024 15:14:46 +0100 Subject: [PATCH 46/95] Fix spacing and bump version. --- src/notifications.scm | 11 ++++++----- src/texts.scm | 2 +- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/src/notifications.scm b/src/notifications.scm index 91e37a0..86c888a 100644 --- a/src/notifications.scm +++ b/src/notifications.scm @@ -178,11 +178,12 @@ soonexps) ","))))) (mlcheck-lst - (string-split - (with-output-to-string - (lambda () - (print-mailing-list-checks mb mls))) - "\n")) + (cons "" + (string-split + (with-output-to-string + (lambda () + (print-mailing-list-checks mb mls))) + "\n"))) (debtors (sort (members-to-notify mb 1) brmember Date: Fri, 9 Feb 2024 15:18:24 +0100 Subject: [PATCH 47/95] Improve changelog for 1.16. --- CHANGELOG.md | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index c2301f2..9349e1b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,8 +1,8 @@ ChangeLog ========= -1.16 ----- +1.16 - released 2024-02-09 +-------------------------- * handle # character at weird positions in DokuWiki users.auth.php * unify -mlsync and -mlcheck handling of member predicates @@ -11,21 +11,21 @@ ChangeLog * report soon-expiring members in the summary emails * report mailing lists check status in summary emails -1.15.1 ------- +1.15.1 - released 2024-01-02 +---------------------------- * fix calculating historical membership fee (was erroneously based on current date) * fix showing basic information without MLs loaded -1.15 ----- +1.15 - released 2024-12-24 +-------------------------- * increase membership fees starting 2024-01 (specification.rkt) * add support for explicit fee amounts for specified period -1.14 ----- +1.14 - released 2024-12-06 +-------------------------- * add support for dynamic terminal size * use table cell formatting instead of paragraph formatting everywhere From e1bb1885b2ec74181537247d5ad286a72c8036e8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 2 Apr 2024 19:43:27 +0200 Subject: [PATCH 48/95] Add EUR account. --- src/export-web-static.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/export-web-static.scm b/src/export-web-static.scm index fb2bed2..8ed8abc 100644 --- a/src/export-web-static.scm +++ b/src/export-web-static.scm @@ -101,7 +101,7 @@ (print "
Member ID, Variable Symbol for Payments
(Členské číslo, variabilní symbol plateb)
" (brmember-id mr) "
") (print "
Balance in CZK
(Zůstatek v Kč)
" (caar (reverse bhs)) "
") - (print "
Account for Payments
(Účet pro platbu příspěvků)
2500079551/2010
") + (print "
Account for Payments
(Účet pro platbu příspěvků)
CZK: 2500079551/2010
EUR: CZ93 2010 0000 0021 0007 9552
") (print "") (print "") (print "
") From 2a7fb0d735719a66e7df63ae854c318eff834c33 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 2 Apr 2024 19:45:57 +0200 Subject: [PATCH 49/95] Release 1.16.1 --- CHANGELOG.md | 5 +++++ src/texts.scm | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 9349e1b..c4d5d27 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,11 @@ ChangeLog ========= +1.16.1 - released 2024-04-02 +---------------------------- + +* add EUR account for paying membership fees to member's page + 1.16 - released 2024-02-09 -------------------------- diff --git a/src/texts.scm b/src/texts.scm index d266666..e65d687 100644 --- a/src/texts.scm +++ b/src/texts.scm @@ -39,7 +39,7 @@ (chicken format)) ;; Short banner - (define banner-line "HackerBase 1.16 (c) 2023 Brmlab, z.s.") + (define banner-line "HackerBase 1.16.1 (c) 2023 Brmlab, z.s.") ;; Banner source with numbers for ANSI CSI SGR (define banner-source " From 8b6e1955ef47c91732b26157827ab201764124cc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 7 May 2024 20:24:00 +0200 Subject: [PATCH 50/95] Export rada-ml-pred? for backwards compatibility. --- src/mailinglist.scm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/mailinglist.scm b/src/mailinglist.scm index 8fa8aa8..73f3e5b 100644 --- a/src/mailinglist.scm +++ b/src/mailinglist.scm @@ -30,6 +30,8 @@ ( check-mailing-list print-mailing-list-checks + + rada-ml-pred? ) (import scheme From 85af3fcff333cf2ba725f7d37b951df792204ea7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 7 May 2024 20:27:07 +0200 Subject: [PATCH 51/95] Release 1.16.2 with -mlsync fix. --- CHANGELOG.md | 5 +++++ src/texts.scm | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index c4d5d27..03cbc12 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,11 @@ ChangeLog ========= +1.16.2 - released 2024-05-07 +---------------------------- + +* fix rada-ml-pred? in -mlsync + 1.16.1 - released 2024-04-02 ---------------------------- diff --git a/src/texts.scm b/src/texts.scm index e65d687..2bd8193 100644 --- a/src/texts.scm +++ b/src/texts.scm @@ -39,7 +39,7 @@ (chicken format)) ;; Short banner - (define banner-line "HackerBase 1.16.1 (c) 2023 Brmlab, z.s.") + (define banner-line "HackerBase 1.16.2 (c) 2023-2024 Brmlab, z.s.") ;; Banner source with numbers for ANSI CSI SGR (define banner-source " From ce74a8962db38042647c385a6cfe4a297c282363 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 11 Jun 2024 20:12:16 +0200 Subject: [PATCH 52/95] Add current fee column. --- src/members-print.scm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/members-print.scm b/src/members-print.scm index 2591238..1957047 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -541,6 +541,7 @@ (cons (list (ansi-string #:bgblue #:brightyellow #:bold "Member") (ansi-string #:bgblue #:brightyellow #:bold "Status") + (ansi-string #:bgblue #:brightyellow #:bold "Current") (ansi-string #:bgblue #:brightyellow #:bold "Fees") (ansi-string #:bgblue #:brightyellow #:bold "Credit") (ansi-string #:bgblue #:brightyellow #:bold "Payments") @@ -551,6 +552,7 @@ (let ((total (list-ref member 5))) (list (list-ref member 0) (list-ref member 1) + "---" (sprintf "\t~A" (list-ref member 2)) (sprintf "\t~A" (list-ref member 3)) (sprintf "\t~A" (list-ref member 4)) From 8a3c81279793c8cb7a8d48f08e36feef41662022 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 11 Jun 2024 20:21:05 +0200 Subject: [PATCH 53/95] One more column. --- src/members-print.scm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/members-print.scm b/src/members-print.scm index 1957047..360e316 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -553,6 +553,7 @@ (list (list-ref member 0) (list-ref member 1) "---" + (sprintf "\t~A" (list-ref member 2)) (sprintf "\t~A" (list-ref member 3)) (sprintf "\t~A" (list-ref member 4)) @@ -571,6 +572,7 @@ (payment (foldl + 0 (map (lambda (b) (ldict-ref b 'payment)) balances))) (total (- (+ credit payment) fees))) (list (list (ansi-string #:bold "Total") + "" "" (ansi-string "\t" #:bold (sprintf "~A" fees)) (ansi-string "\t" #:bold (sprintf "~A" credit)) From 0906f9d27c93a7504b2f1e3ffdc60cddfebcd625 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 11 Jun 2024 21:23:15 +0200 Subject: [PATCH 54/95] List spec fee. --- src/members-print.scm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/members-print.scm b/src/members-print.scm index 360e316..211fd54 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -531,6 +531,10 @@ payment total balance + (let ((spec-fee (brmember-spec-fee mr))) + (if spec-fee + spec-fee + "normal")) ))) raw-members)) (balances (map (lambda (m) @@ -552,8 +556,7 @@ (let ((total (list-ref member 5))) (list (list-ref member 0) (list-ref member 1) - "---" - + (sprintf "\t~A" (list-ref member 5)) (sprintf "\t~A" (list-ref member 2)) (sprintf "\t~A" (list-ref member 3)) (sprintf "\t~A" (list-ref member 4)) From 90930391d0f314d53c162579ca7591e0b7055478 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 11 Jun 2024 21:25:25 +0200 Subject: [PATCH 55/95] Wrong list ref. --- src/members-print.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/members-print.scm b/src/members-print.scm index 211fd54..ef70c01 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -556,7 +556,7 @@ (let ((total (list-ref member 5))) (list (list-ref member 0) (list-ref member 1) - (sprintf "\t~A" (list-ref member 5)) + (sprintf "\t~A" (list-ref member 7)) (sprintf "\t~A" (list-ref member 2)) (sprintf "\t~A" (list-ref member 3)) (sprintf "\t~A" (list-ref member 4)) From 079551e41a890fd8c3d8bc1c9e88bf3faa0c955b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 11 Jun 2024 21:29:06 +0200 Subject: [PATCH 56/95] Proper lookup. --- src/members-print.scm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/members-print.scm b/src/members-print.scm index ef70c01..47478dc 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -534,7 +534,10 @@ (let ((spec-fee (brmember-spec-fee mr))) (if spec-fee spec-fee - "normal")) + (member-calendar-entry->fee + (list (*current-month*) + (brmember-flags mr) + spec-fee)))) ))) raw-members)) (balances (map (lambda (m) From bc5db8db9966909841950ac963ab586d913318d2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 11 Jun 2024 21:33:12 +0200 Subject: [PATCH 57/95] Current totals. --- src/members-print.scm | 5 +++-- src/texts.scm | 2 +- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/src/members-print.scm b/src/members-print.scm index 47478dc..33d0869 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -576,10 +576,11 @@ (let* ((fees (foldl + 0 (map (lambda (b) (ldict-ref b 'fees)) balances))) (credit (foldl + 0 (map (lambda (b) (ldict-ref b 'credit)) balances))) (payment (foldl + 0 (map (lambda (b) (ldict-ref b 'payment)) balances))) - (total (- (+ credit payment) fees))) + (total (- (+ credit payment) fees)) + (current-total (foldl + 0 (map (lambda (m) (list-ref m 7)) members)))) (list (list (ansi-string #:bold "Total") "" - "" + (ansi-string "\t" #:bold (sprintf "~A" current-total)) (ansi-string "\t" #:bold (sprintf "~A" fees)) (ansi-string "\t" #:bold (sprintf "~A" credit)) (ansi-string "\t" #:bold (sprintf "~A" payment)) diff --git a/src/texts.scm b/src/texts.scm index 2bd8193..d6781f4 100644 --- a/src/texts.scm +++ b/src/texts.scm @@ -39,7 +39,7 @@ (chicken format)) ;; Short banner - (define banner-line "HackerBase 1.16.2 (c) 2023-2024 Brmlab, z.s.") + (define banner-line "HackerBase 1.17-dev (c) 2023-2024 Brmlab, z.s.") ;; Banner source with numbers for ANSI CSI SGR (define banner-source " From 1840f5675beaf78e43383527ce89e64023c29f35 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 2 Jul 2024 20:21:33 +0200 Subject: [PATCH 58/95] Fix erroneous newline when sending notifications. --- src/duck-extract.scm | 6 ------ src/hackerbase.scm | 2 +- src/members-print.scm | 5 ----- src/sgr-block.scm | 1 - src/table-processor.scm | 2 -- src/table.scm | 1 - 6 files changed, 1 insertion(+), 16 deletions(-) diff --git a/src/duck-extract.scm b/src/duck-extract.scm index 3948e2d..968621b 100644 --- a/src/duck-extract.scm +++ b/src/duck-extract.scm @@ -135,18 +135,12 @@ res)))))) (define (print-duck-signature sig) - ;;(print sig) (let* ((curry-depth (get-curry-depth sig)) (name (get-signature-name sig)) (nameline (format " ~A~A" (make-string curry-depth #\() name)) (spaceline (make-string (add1 (string-length nameline)) #\space)) (args (gather-signature-arguments sig)) (eargs (expand-signature-arguments args))) - ;;(print " curry depth = " curry-depth) - ;;(print " name = " name) - ;;(print " args = " args) - ;;(printf " eargs = ~S" eargs) - ;;(newline) (if (null? eargs) (print nameline ")") (let loop ((args eargs) diff --git a/src/hackerbase.scm b/src/hackerbase.scm index 6579723..0633a49 100644 --- a/src/hackerbase.scm +++ b/src/hackerbase.scm @@ -378,7 +378,7 @@ (print "Mailman synchronization disabled with manually specified current month.")))) ((notify) (let ((nmembers (members-to-notify MB (-notify-months-)))) - (newline) + (stdout-newline) (if (null? nmembers) (print "Everyone paid on time.") (let () diff --git a/src/members-print.scm b/src/members-print.scm index 33d0869..4d5b2dd 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -129,8 +129,6 @@ (ptbl (table->string pdata #:border '(((#:right light) ... none) ...)))) - ;;(print pdata) - ;;(write ptbl)(newline) (list k ptbl))) ((fee) (let* ((pdata @@ -150,8 +148,6 @@ (ptbl (table->string pdata #:border '(((#:right light) ... none) ...)))) - ;;(print pdata) - ;;(write ptbl)(newline) (list k ptbl))) (else (if v @@ -182,7 +178,6 @@ (list (list (ansi-string #:red "DokuWiki") (ansi-string #:red "---"))))) (result (filter identity (append head body mailman dokuwiki)))) - ;;(write result)(newline) (table->string result #:border '(((#:bottom #:right light) ... (#:bottom light)) ... diff --git a/src/sgr-block.scm b/src/sgr-block.scm index d3c2bbc..f8e1f8a 100644 --- a/src/sgr-block.scm +++ b/src/sgr-block.scm @@ -366,7 +366,6 @@ slw)) state))) (let ((sln (sgr-list-neutralize sl))) - ;;(write sln)(newline) (values (list sln) initial-state)))) ;; Renders all the lines and appends the resulting blocks diff --git a/src/table-processor.scm b/src/table-processor.scm index 956d9fd..ff79d9f 100644 --- a/src/table-processor.scm +++ b/src/table-processor.scm @@ -204,8 +204,6 @@ (tbl1 (render-cells-widths ptbl col-widths)) ;;(_ (print tbl1)) (tbl2 (map expand-row-height tbl1))) - ;;(write tbl1)(newline) - ;;(write tbl2)(newline) ;; Just return the result - both the table and cached column widths (values tbl2 col-widths)))) diff --git a/src/table.scm b/src/table.scm index 43041ff..719fb1a 100644 --- a/src/table.scm +++ b/src/table.scm @@ -88,7 +88,6 @@ (borders (expand-table-style border-spec num-columns num-rows)) (col-separators (table-col-separators? borders)) (rows (merge-rows ptbl borders col-separators unicode?))) - ;;(write rows)(newline) (let loop ((rows rows) (borders borders) (res '()) From 8c436f6910c5acc7d49a00dfcf3397447da86189 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 2 Jul 2024 20:31:49 +0200 Subject: [PATCH 59/95] Update historical changelog. --- CHANGELOG.md | 77 ++++++++++++++++++++++++++++++++-------------------- 1 file changed, 47 insertions(+), 30 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 03cbc12..8a86fbd 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -28,13 +28,13 @@ ChangeLog current date) * fix showing basic information without MLs loaded -1.15 - released 2024-12-24 +1.15 - released 2023-12-24 -------------------------- * increase membership fees starting 2024-01 (specification.rkt) * add support for explicit fee amounts for specified period -1.14 - released 2024-12-06 +1.14 - released 2023-12-06 -------------------------- * add support for dynamic terminal size @@ -42,14 +42,14 @@ ChangeLog * fix sqlite3 database locking issue * allow limiting -fees output to -active only -1.13 ----- +1.13 - released 2023-12-05 +-------------------------- * add dokuwiki problems to summary emails * handle more SEPA payments -1.12 ----- +1.12 - released 2023-11-16 +-------------------------- * switch to eggs: srfi-1, sqlite3 * semi-automatic export for brmdoor @@ -57,83 +57,100 @@ ChangeLog * redirect dokuwiki plugin to login page if not logged in * sync council and revision mailing lists -1.11 ----- +1.11 - released 2023-09-23 +-------------------------- * add support for CC in emails * update manual page * setup new cron jobs -1.10 ----- +1.10 - released 2023-09-17 +-------------------------- * direct access of mailman 3 database -1.9 ---- +1.9 - released 2023-09-16 +------------------------- * implement support for mailman 3 * add total debt to long-term debtors listings -1.8 ---- +1.8 - released 2023-07-29 +------------------------ * remove old compatibility static web pages generator * update documentation * update Fio fetcher to handle new limits imposed by the bank * output plain list of active members (used by BrmBar project) -1.7 ---- +1.7 - released 2023-07-04 +------------------------- * include current month in stats * right-alignment in table cells * functionality improvements of dokuwiki plugin * checking council group between dokuwiki and members database -1.6 ---- +1.6.2 - released 2023-06-29 +--------------------------- + +* fix passing members to remove_members mailman binary + +1.6.1 - released 2023-06-27 +--------------------------- + +* fix ML removal +* fix sync re-read + +1.6 - released 2023-06-27 +------------------------- * dokuwiki plugin * delete generated files for destroyed members * verify dokuwiki users information -1.5 ---- +1.5 - released 2023-06-19 +------------------------- * improved table renderer * show membership fees and payments balances history * improved generator of static web pages -1.4 ---- +1.4 - released 2023-05-26 +------------------------- * vim and joe syntax highlighting support * improved Fio bank statement fetcher and merger -1.3 ---- +1.3 - released 2023-05-22 +------------------------- * organizational bodies membership -1.2 ---- +1.2.1 - released 2023-05-19 +--------------------------- + +* fix email string argument passing +* use bi-directional mailman communication + +1.2 - released 2023-05-19 +------------------------- * split configuration and action command-line options * support for git annotate * show suspended members that are about to expire * optimized utf-8 support -1.1 ---- +1.1 - released 2023-05-14 +------------------------- * support for suppressing output (used in cron jobs) * sorted members in notifications * report missing keys in member files * internal ML membership synchronization -1.0 ---- +1.0 - released 2023-04-23 +------------------------- This was the first oficially released version which contains all the functionality required to take over the original solution. From 7d1101657f7a18cefc7dc0f9a5a80bd417474028 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 2 Jul 2024 20:50:43 +0200 Subject: [PATCH 60/95] Add support for full email addresses. --- src/util-mail.scm | 38 ++++++++++++++++++++++++++------------ 1 file changed, 26 insertions(+), 12 deletions(-) diff --git a/src/util-mail.scm b/src/util-mail.scm index 8a7e8b5..8e5fb4f 100644 --- a/src/util-mail.scm +++ b/src/util-mail.scm @@ -39,6 +39,7 @@ (chicken base) (chicken keyword) (chicken string) + (chicken irregex) util-io util-utf8 util-string @@ -61,6 +62,14 @@ sent to the address stored within.") "?=") subj)) + ;; Extracts only usernam@domain from given full RFC email address + (define (extract-email-email str) + (let* ((irr (irregex "(?:\"?([^\"]*)\"?\\s)?(?:]+)>?)")) + (em (irregex-match irr str)) + (name (irregex-match-substring em 1)) + (email (irregex-match-substring em 2))) + email)) + ;; Sends an email using the UNIX mail(1) utility. (define*/doc (send-mail body-lines #:from (from #f) @@ -83,17 +92,22 @@ Sends email using mail(1) command. The arguments ```#:to``` and tos)) (header-args (flatten - (map - (lambda (h) (list "-a" h)) - headers)))) - (apply process-send/recv - "mail" - (append (if from - (list "-r" from) - '()) - (list "-s" (encode-subject subject)) - real-tos - header-args) - body-lines))) + (append + (if from (list (sprintf "From: ~A" from)) '()) + (map + (lambda (h) (list "-a" h)) + headers))))) + (let ((from-email (if from + (extract-email-email from) + #f))) + (apply process-send/recv + "mail" + (append (if from + (list "-r" from-email) + '()) + (list "-s" (encode-subject subject)) + real-tos + header-args) + body-lines)))) ) From 6a8282162667790edaa9c17a999658aed0f82f5d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 2 Jul 2024 20:52:27 +0200 Subject: [PATCH 61/95] Start writing down 1.17 changes. --- CHANGELOG.md | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8a86fbd..526d15d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,14 @@ ChangeLog ========= +1.17 +---- + +* add "Current Fee" column to -fees to see special discounts +* add EUR account to members page +* fix erroneous newlines in cronjobs +* add support for full RFC email addresses in *email-from* configuration + 1.16.2 - released 2024-05-07 ---------------------------- From 661d7540838bdc1821c2d56f228070a203533b5c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 2 Jul 2024 20:58:11 +0200 Subject: [PATCH 62/95] Missing format import. --- src/util-mail.scm | 1 + 1 file changed, 1 insertion(+) diff --git a/src/util-mail.scm b/src/util-mail.scm index 8e5fb4f..31680d5 100644 --- a/src/util-mail.scm +++ b/src/util-mail.scm @@ -40,6 +40,7 @@ (chicken keyword) (chicken string) (chicken irregex) + (chicken format) util-io util-utf8 util-string From dbc52833f06ca059822e2de5a59e6a35aa1c2288 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 2 Jul 2024 21:40:38 +0200 Subject: [PATCH 63/95] Update relevant copyright years. --- README.md | 2 +- src/util-mail.scm | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 9fcb37f..48798c6 100644 --- a/README.md +++ b/README.md @@ -9,7 +9,7 @@ License ISC License -Copyright 2023 Brmlab, z.s. +Copyright 2023-2024 Brmlab, z.s. Dominik Pantůček Permission to use, copy, modify, and/or distribute this software diff --git a/src/util-mail.scm b/src/util-mail.scm index 31680d5..9ab448c 100644 --- a/src/util-mail.scm +++ b/src/util-mail.scm @@ -5,7 +5,7 @@ ;; ;; ISC License ;; -;; Copyright 2023 Brmlab, z.s. +;; Copyright 2023-2024 Brmlab, z.s. ;; Dominik Pantůček ;; ;; Permission to use, copy, modify, and/or distribute this software From 065d406e9c86f2deaccdf2a2623c3e9ca2f00be9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 10 Sep 2024 18:42:19 +0200 Subject: [PATCH 64/95] Coerce suspend start to month when calculating suspended months. --- src/brmember.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/brmember.scm b/src/brmember.scm index e83c9dd..496dc96 100644 --- a/src/brmember.scm +++ b/src/brmember.scm @@ -423,7 +423,8 @@ (if (brmember-suspended? mr) (let ((period (cal-periods-match (brmember-info mr 'suspend)))) (if period - (cal-month-diff (cal-period-since period) (*current-month*)) + (cal-month-diff (cal-ensure-month (cal-period-since period)) + (*current-month*)) 0)) 0)) From 488499cf23cca23529d02abddfa9770c078cf19a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 10 Sep 2024 18:49:19 +0200 Subject: [PATCH 65/95] When creating cal-period, ensure months for periods. --- src/cal-period.scm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/cal-period.scm b/src/cal-period.scm index ea1cf3d..e88954c 100644 --- a/src/cal-period.scm +++ b/src/cal-period.scm @@ -138,7 +138,10 @@ (not (null? (cdr args)))) (cadr args) #f))) - (list TAG-CAL-PERIOD since before scomment bcomment))) + (list TAG-CAL-PERIOD + (if since (cal-ensure-month since) since) + (if before (cal-ensure-month before) before) + scomment bcomment))) ;; Simple accessors (define cal-period-since cadr) From f95f7a05433356d3cc4538a53ec93821d4f76204 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 10 Sep 2024 18:54:55 +0200 Subject: [PATCH 66/95] Revert "When creating cal-period, ensure months for periods." This reverts commit 488499cf23cca23529d02abddfa9770c078cf19a. --- src/cal-period.scm | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/cal-period.scm b/src/cal-period.scm index e88954c..ea1cf3d 100644 --- a/src/cal-period.scm +++ b/src/cal-period.scm @@ -138,10 +138,7 @@ (not (null? (cdr args)))) (cadr args) #f))) - (list TAG-CAL-PERIOD - (if since (cal-ensure-month since) since) - (if before (cal-ensure-month before) before) - scomment bcomment))) + (list TAG-CAL-PERIOD since before scomment bcomment))) ;; Simple accessors (define cal-period-since cadr) From 09b971ad9347222fb292f365e6e5b1701c68c7eb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 10 Sep 2024 20:20:33 +0200 Subject: [PATCH 67/95] Fix soon expires list append. --- src/notifications.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/notifications.scm b/src/notifications.scm index 86c888a..52d11f8 100644 --- a/src/notifications.scm +++ b/src/notifications.scm @@ -167,7 +167,7 @@ brmember Date: Tue, 1 Oct 2024 20:34:44 +0200 Subject: [PATCH 68/95] Fix handling members without any fees or payments. --- src/export-web-static.scm | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/export-web-static.scm b/src/export-web-static.scm index 8ed8abc..4b0b15d 100644 --- a/src/export-web-static.scm +++ b/src/export-web-static.scm @@ -44,7 +44,8 @@ cal-day util-git configuration - texts) + texts + logging) ;; HTML entities (define (sanitize-html str) @@ -100,7 +101,11 @@ (brmember-nick mr) "") (print "
Member ID, Variable Symbol for Payments
(Členské číslo, variabilní symbol plateb)
" (brmember-id mr) "
") - (print "
Balance in CZK
(Zůstatek v Kč)
" (caar (reverse bhs)) "
") + (print "
Balance in CZK
(Zůstatek v Kč)
" + (if (null? bhs) + "0" + (caar (reverse bhs))) + "
") (print "
Account for Payments
(Účet pro platbu příspěvků)
CZK: 2500079551/2010
EUR: CZ93 2010 0000 0021 0007 9552
") (print "") (print "
") From a86063e7221d998005e2764b01998430cc350922 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 1 Oct 2024 20:36:28 +0200 Subject: [PATCH 69/95] Release 1.17. --- CHANGELOG.md | 5 +++-- src/texts.scm | 2 +- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 526d15d..32d0c05 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,13 +1,14 @@ ChangeLog ========= -1.17 ----- +1.17 - released 2024-10-01 +-------------------------- * add "Current Fee" column to -fees to see special discounts * add EUR account to members page * fix erroneous newlines in cronjobs * add support for full RFC email addresses in *email-from* configuration +* handling of members without any fees or payments 1.16.2 - released 2024-05-07 ---------------------------- diff --git a/src/texts.scm b/src/texts.scm index d6781f4..6771016 100644 --- a/src/texts.scm +++ b/src/texts.scm @@ -39,7 +39,7 @@ (chicken format)) ;; Short banner - (define banner-line "HackerBase 1.17-dev (c) 2023-2024 Brmlab, z.s.") + (define banner-line "HackerBase 1.17 (c) 2023-2024 Brmlab, z.s.") ;; Banner source with numbers for ANSI CSI SGR (define banner-source " From eff186cb4cdd993b4c98019ffb286decb82a6d5b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 26 Dec 2024 20:11:01 +0100 Subject: [PATCH 70/95] Start work on attendance sheet. --- src/Makefile | 11 ++++- src/export-sheet.scm | 97 ++++++++++++++++++++++++++++++++++++++++++++ src/hackerbase.scm | 10 ++++- 3 files changed, 115 insertions(+), 3 deletions(-) create mode 100644 src/export-sheet.scm diff --git a/src/Makefile b/src/Makefile index 010c646..624aa68 100644 --- a/src/Makefile +++ b/src/Makefile @@ -42,7 +42,8 @@ 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 mailinglist.import.scm + dokuwiki.import.scm mailinglist.import.scm \ + export-sheet.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 \ @@ -60,7 +61,7 @@ HACKERBASE-OBJS=hackerbase.o testing.o listing.o cal-month.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 \ - mailinglist.o + mailinglist.o export-sheet.o GENDOC-SOURCES=gendoc.scm duck-extract.import.scm \ util-time.import.scm util-csv.import.scm util-git.import.scm \ @@ -559,3 +560,9 @@ MAILINGLIST-SOURCES=mailinglist.scm racket-kwargs.import.scm \ mailinglist.o: mailinglist.import.scm mailinglist.import.scm: $(MAILINGLIST-SOURCES) + +EXPORT-SHEET-SOURCES=export-sheet.scm mbase.import.scm \ + brmember.import.scm + +export-sheet.o: export-sheet.import.scm +export-sheet.import.scm: $(EXPORT-SHEET-SOURCES) diff --git a/src/export-sheet.scm b/src/export-sheet.scm new file mode 100644 index 0000000..5b4fd3c --- /dev/null +++ b/src/export-sheet.scm @@ -0,0 +1,97 @@ +;; +;; export-sheet.scm +;; +;; Export attendance sheet as MarkDown document. +;; +;; ISC License +;; +;; Copyright 2024 Brmlab, z.s. +;; Dominik Pantůček +;; +;; 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 export-sheet)) + +(module + export-sheet + ( + print-attendance-sheet + ) + + (import scheme + (chicken base) + (chicken string) + (chicken format) + mbase + brmember + brmember-format + util-bst-ldict) + + (define (print-attendance-sheet MB) + (print "\\documentclass[11pt]{article}") + (print "\\usepackage[top=1cm,left=2cm,right=2cm,bottom=2cm]{geometry}") + (print "\\begin{document}") + (print "\\begin{center}") + (print + (format + "Prezenční listina ~A. Valné Hromady brmlab z.s. konané ~A v sídle spolku" + 666 + "1.2.3456")) + (newline) + (print "\\vskip1em") + (newline) + (define colnames + '((id) Nick Name Surname (Balance) (Active) Signature)) + (print + (format + "\\begin{tabular}{|~A|}" + (string-intersperse + (map + (lambda (x) + "l") + colnames) + "|"))) + (print + (string-intersperse + (map + (lambda (x) + (format + "\\textbf{~A}" + (if (symbol? x) + (symbol->string x) + (symbol->string (car x))))) + colnames) + "&") + "\\\\") + (print "\\hline") + (let loop ((mrs (find-members-by-predicate + MB (lambda (mr) + (brmember-active? mr))))) + (when (not (null? mrs)) + (let* ((mr (car mrs)) + (info (ldict-ref mr 'info)) + (name (ldict-ref info 'name "ERROR"))) + (print + (brmember-id mr) + " & " + "name" + " \\\\") + (loop (cdr mrs))))) + (print "\\end{tabular}") + (print "\\end{center}") + (print "\\end{document}")) + + ) diff --git a/src/hackerbase.scm b/src/hackerbase.scm index 0633a49..3e67d50 100644 --- a/src/hackerbase.scm +++ b/src/hackerbase.scm @@ -51,7 +51,8 @@ dokuwiki racket-kwargs util-string - mailinglist) + mailinglist + export-sheet) ;; Command-line options and configurable parameters (define -needs-bank- (make-parameter #f)) @@ -182,6 +183,10 @@ (-stats (file:gnuplot-data) "Get stats for all months" (-action- 'print-stats) (-fname- file:gnuplot-data)) + (-sheet (filename) "Generate attendance sheet" + (-needs-bank- #t) + (-action- 'gen-sheet)) + "" "Mailman Actions:" (-mlsync () "Synchronize internal ML" @@ -354,6 +359,9 @@ ((genweb) (log-info "Generating static web files") (gen-html-members MB (-web-dir-))) + ((gen-sheet) + (log-info "Generating attendance sheet") + (print-attendance-sheet MB)) ((edit) (if mr (let () From 9eb835fa723ab86aaf259895e11e55669634eed6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 26 Dec 2024 20:26:41 +0100 Subject: [PATCH 71/95] Names cleanup, alignment and amount formatting. --- src/export-sheet.scm | 37 +++++++++++++++++++++++++++++++++---- 1 file changed, 33 insertions(+), 4 deletions(-) diff --git a/src/export-sheet.scm b/src/export-sheet.scm index 5b4fd3c..d0dd141 100644 --- a/src/export-sheet.scm +++ b/src/export-sheet.scm @@ -38,7 +38,9 @@ mbase brmember brmember-format - util-bst-ldict) + util-bst-ldict + members-payments + util-format) (define (print-attendance-sheet MB) (print "\\documentclass[11pt]{article}") @@ -61,9 +63,11 @@ (string-intersperse (map (lambda (x) - "l") + (if (symbol? x) + "l" "r")) colnames) "|"))) + (print "\\hline") (print (string-intersperse (map @@ -83,12 +87,37 @@ (when (not (null? mrs)) (let* ((mr (car mrs)) (info (ldict-ref mr 'info)) - (name (ldict-ref info 'name "ERROR"))) + (name (ldict-ref info 'name "ERROR")) + (name* (string-translate* + name + '(("_" . " ")))) + (namel (string-split name*)) + (sname (car (reverse namel))) + (fname + (string-intersperse + (reverse + (cdr + (reverse namel))) + " "))) (print (brmember-id mr) " & " - "name" + (string-translate* + (brmember-nick mr) + '(("_" . "\\_"))) + " & " + fname + " & " + sname + " & " + (format-amount + (member-total-balance mr)) + " & " + "?" + " & " + "~ ~ ~ ~ ~" " \\\\") + (print "\\hline") (loop (cdr mrs))))) (print "\\end{tabular}") (print "\\end{center}") From fe42315cd9af3dc322bec89a6bd33e6d1ed6a96f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 26 Dec 2024 20:58:14 +0100 Subject: [PATCH 72/95] Number of active months. --- src/export-sheet.scm | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/src/export-sheet.scm b/src/export-sheet.scm index d0dd141..b8e9804 100644 --- a/src/export-sheet.scm +++ b/src/export-sheet.scm @@ -40,7 +40,9 @@ brmember-format util-bst-ldict members-payments - util-format) + util-format + members-fees + srfi-1) (define (print-attendance-sheet MB) (print "\\documentclass[11pt]{article}") @@ -98,7 +100,19 @@ (reverse (cdr (reverse namel))) - " "))) + " ")) + (cal (member-calendar mr)) + (rcal (reverse cal)) + (rcal12 + (if (> (length rcal) 12) + (take rcal 12) + rcal)) + (acal12 (map cadr rcal12)) + (acal12* (map (lambda (f) (if (memq 'active f) 1 0)) acal12)) + (numactive (foldl + 0 acal12*)) + ) + (display acal12* (current-error-port)) + (newline (current-error-port)) (print (brmember-id mr) " & " @@ -113,7 +127,7 @@ (format-amount (member-total-balance mr)) " & " - "?" + numactive " & " "~ ~ ~ ~ ~" " \\\\") From 51a108ce64a3bd39858374a7d8f53819c57f571e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 26 Dec 2024 21:08:28 +0100 Subject: [PATCH 73/95] Generate file based on command-line argument. --- src/Makefile | 7 +++++-- src/export-sheet.scm | 18 +++++++++++++----- src/hackerbase.scm | 4 +++- 3 files changed, 21 insertions(+), 8 deletions(-) diff --git a/src/Makefile b/src/Makefile index 624aa68..8707242 100644 --- a/src/Makefile +++ b/src/Makefile @@ -561,8 +561,11 @@ MAILINGLIST-SOURCES=mailinglist.scm racket-kwargs.import.scm \ mailinglist.o: mailinglist.import.scm mailinglist.import.scm: $(MAILINGLIST-SOURCES) -EXPORT-SHEET-SOURCES=export-sheet.scm mbase.import.scm \ - brmember.import.scm +EXPORT-SHEET-SOURCES=export-sheet.scm mbase.import.scm \ + brmember.import.scm brmember-format.import.scm \ + util-bst-ldict.import.scm members-payments.import.scm \ + util-format.import.scm members-fees.import.scm \ + cal-period.import.scm export-sheet.o: export-sheet.import.scm export-sheet.import.scm: $(EXPORT-SHEET-SOURCES) diff --git a/src/export-sheet.scm b/src/export-sheet.scm index b8e9804..90ac1d9 100644 --- a/src/export-sheet.scm +++ b/src/export-sheet.scm @@ -35,6 +35,7 @@ (chicken base) (chicken string) (chicken format) + srfi-1 mbase brmember brmember-format @@ -42,10 +43,10 @@ members-payments util-format members-fees - srfi-1) + cal-period) (define (print-attendance-sheet MB) - (print "\\documentclass[11pt]{article}") + (print "\\documentclass[10pt]{article}") (print "\\usepackage[top=1cm,left=2cm,right=2cm,bottom=2cm]{geometry}") (print "\\begin{document}") (print "\\begin{center}") @@ -58,7 +59,7 @@ (print "\\vskip1em") (newline) (define colnames - '((id) Nick Name Surname (Balance) (Active) Signature)) + '((id) Nick Name Surname (Fee) (Balance) (Active) Signature)) (print (format "\\begin{tabular}{|~A|}" @@ -110,9 +111,14 @@ (acal12 (map cadr rcal12)) (acal12* (map (lambda (f) (if (memq 'active f) 1 0)) acal12)) (numactive (foldl + 0 acal12*)) + (spec-fee (brmember-spec-fee mr)) + (current-fee (if spec-fee + spec-fee + (member-calendar-entry->fee + (list (*current-month*) + (brmember-flags mr) + spec-fee)))) ) - (display acal12* (current-error-port)) - (newline (current-error-port)) (print (brmember-id mr) " & " @@ -124,6 +130,8 @@ " & " sname " & " + (format-amount current-fee) + " & " (format-amount (member-total-balance mr)) " & " diff --git a/src/hackerbase.scm b/src/hackerbase.scm index 3e67d50..9758e93 100644 --- a/src/hackerbase.scm +++ b/src/hackerbase.scm @@ -185,6 +185,7 @@ (-fname- file:gnuplot-data)) (-sheet (filename) "Generate attendance sheet" (-needs-bank- #t) + (-fname- filename) (-action- 'gen-sheet)) "" @@ -361,7 +362,8 @@ (gen-html-members MB (-web-dir-))) ((gen-sheet) (log-info "Generating attendance sheet") - (print-attendance-sheet MB)) + (parameterize ((current-output-port (open-output-file (-fname-)))) + (print-attendance-sheet MB))) ((edit) (if mr (let () From 53be61d3457609c55a9f8b14a0a89d64b7e2157e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 26 Dec 2024 21:21:31 +0100 Subject: [PATCH 74/95] Generate date and GM number. --- src/export-sheet.scm | 14 +++++++++----- src/hackerbase.scm | 6 ++++-- 2 files changed, 13 insertions(+), 7 deletions(-) diff --git a/src/export-sheet.scm b/src/export-sheet.scm index 90ac1d9..31c217f 100644 --- a/src/export-sheet.scm +++ b/src/export-sheet.scm @@ -43,18 +43,22 @@ members-payments util-format members-fees - cal-period) + cal-period + cal-day) - (define (print-attendance-sheet MB) + (define (print-attendance-sheet MB number) (print "\\documentclass[10pt]{article}") (print "\\usepackage[top=1cm,left=2cm,right=2cm,bottom=2cm]{geometry}") (print "\\begin{document}") (print "\\begin{center}") (print (format - "Prezenční listina ~A. Valné Hromady brmlab z.s. konané ~A v sídle spolku" - 666 - "1.2.3456")) + "Prezenční listina ~A. Valné Hromady brmlab z.s. konané ~A. ~A. ~A v sídle spolku" + number + (cal-day-day (*current-day*)) + (cal-day-month (*current-day*)) + (cal-day-year (*current-day*)) + )) (newline) (print "\\vskip1em") (newline) diff --git a/src/hackerbase.scm b/src/hackerbase.scm index 9758e93..7074d1e 100644 --- a/src/hackerbase.scm +++ b/src/hackerbase.scm @@ -67,6 +67,7 @@ (define -show-only-active- (make-parameter #f)) (define -notify-months- (make-parameter 1)) (define -send-emails- (make-parameter #f)) +(define -number- (make-parameter #f)) ;; Arguments parsing (command-line @@ -183,9 +184,10 @@ (-stats (file:gnuplot-data) "Get stats for all months" (-action- 'print-stats) (-fname- file:gnuplot-data)) - (-sheet (filename) "Generate attendance sheet" + (-sheet (filename gmnum) "Generate attendance sheet for given GM number" (-needs-bank- #t) (-fname- filename) + (-number- gmnum) (-action- 'gen-sheet)) "" @@ -363,7 +365,7 @@ ((gen-sheet) (log-info "Generating attendance sheet") (parameterize ((current-output-port (open-output-file (-fname-)))) - (print-attendance-sheet MB))) + (print-attendance-sheet MB (-number-)))) ((edit) (if mr (let () From e02853edc7638ee2207ce2a384afc8d04a57eb69 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 26 Dec 2024 22:20:17 +0100 Subject: [PATCH 75/95] Preliminary version of attendance sheet. --- src/export-sheet.scm | 44 +++++++++++++++++++++++++++++++++++++++----- 1 file changed, 39 insertions(+), 5 deletions(-) diff --git a/src/export-sheet.scm b/src/export-sheet.scm index 31c217f..3dc9c29 100644 --- a/src/export-sheet.scm +++ b/src/export-sheet.scm @@ -48,7 +48,7 @@ (define (print-attendance-sheet MB number) (print "\\documentclass[10pt]{article}") - (print "\\usepackage[top=1cm,left=2cm,right=2cm,bottom=2cm]{geometry}") + (print "\\usepackage[top=1cm,left=1cm,right=2cm,bottom=2cm]{geometry}") (print "\\begin{document}") (print "\\begin{center}") (print @@ -63,7 +63,7 @@ (print "\\vskip1em") (newline) (define colnames - '((id) Nick Name Surname (Fee) (Balance) (Active) Signature)) + '((id) Nick Name Surname (Fee) (Balance) B (Active) A OK? Signature)) (print (format "\\begin{tabular}{|~A|}" @@ -88,6 +88,9 @@ "&") "\\\\") (print "\\hline") + (define valid-voters 0) + (define ok-balances 0) + (define ok-actives 0) (let loop ((mrs (find-members-by-predicate MB (lambda (mr) (brmember-active? mr))))) @@ -122,7 +125,17 @@ (list (*current-month*) (brmember-flags mr) spec-fee)))) + (balance-ok? (>= (member-total-balance mr) + (- current-fee))) + (active-ok? (>= numactive 9)) + (vote-ok? (and balance-ok? active-ok?)) ) + (when balance-ok? + (set! ok-balances (+ ok-balances 1))) + (when active-ok? + (set! ok-actives (+ ok-actives 1))) + (when vote-ok? + (set! valid-voters (+ valid-voters 1))) (print (brmember-id mr) " & " @@ -134,19 +147,40 @@ " & " sname " & " - (format-amount current-fee) + current-fee " & " - (format-amount + (format-amount-tex (member-total-balance mr)) " & " + (if balance-ok? + "Y" + "--") + " & " numactive " & " + (if active-ok? + "Y" + "--") + " & " + (if vote-ok? + "Y" + "--") + " & " "~ ~ ~ ~ ~" " \\\\") (print "\\hline") (loop (cdr mrs))))) (print "\\end{tabular}") (print "\\end{center}") - (print "\\end{document}")) + (print "\\end{document}") + (print "% valid-voters = " valid-voters) + (print "% valid-balances = " ok-balances) + (print "% valid-actives = " ok-actives) + ) + + (define (format-amount-tex amt) + (string-translate* + (format-amount amt) + '(("--" . "--{}--")))) ) From b25fbd407dc38a23cd2f7289410d76cb881fbba1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 2 Jan 2025 15:06:32 +0100 Subject: [PATCH 76/95] Split out mbase-stats into separate query module. --- src/Makefile | 11 +++++- src/hackerbase.scm | 3 +- src/mbase-query.scm | 92 ++++++++++++++++++++++++++++++++++++++++++++ src/mbase.scm | 43 --------------------- src/members-fees.scm | 14 +++++++ 5 files changed, 117 insertions(+), 46 deletions(-) create mode 100644 src/mbase-query.scm diff --git a/src/Makefile b/src/Makefile index 8707242..cd59f87 100644 --- a/src/Makefile +++ b/src/Makefile @@ -43,7 +43,7 @@ HACKERBASE-DEPS=hackerbase.scm cal-month.import.scm \ progress.import.scm cal-period.import.scm \ util-stdout.import.scm export-web-static.import.scm \ dokuwiki.import.scm mailinglist.import.scm \ - export-sheet.import.scm + export-sheet.import.scm mbase-query.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 \ @@ -61,7 +61,7 @@ HACKERBASE-OBJS=hackerbase.o testing.o listing.o cal-month.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 \ - mailinglist.o export-sheet.o + mailinglist.o export-sheet.o mbase-query.o GENDOC-SOURCES=gendoc.scm duck-extract.import.scm \ util-time.import.scm util-csv.import.scm util-git.import.scm \ @@ -569,3 +569,10 @@ EXPORT-SHEET-SOURCES=export-sheet.scm mbase.import.scm \ export-sheet.o: export-sheet.import.scm export-sheet.import.scm: $(EXPORT-SHEET-SOURCES) + +MBASE-QUERY-SOURCES=mbase-query.scm mbase.import.scm \ + brmember.import.scm util-bst-ldict.scm primes.import.scm \ + cal-period.import.scm cal-month.import.scm + +mbase-query.o: mbase-query.import.scm +mbase-query.import.scm: $(MBASE-QUERY-SOURCES) diff --git a/src/hackerbase.scm b/src/hackerbase.scm index 7074d1e..ce6c781 100644 --- a/src/hackerbase.scm +++ b/src/hackerbase.scm @@ -52,7 +52,8 @@ racket-kwargs util-string mailinglist - export-sheet) + export-sheet + mbase-query) ;; Command-line options and configurable parameters (define -needs-bank- (make-parameter #f)) diff --git a/src/mbase-query.scm b/src/mbase-query.scm new file mode 100644 index 0000000..c9e3e4c --- /dev/null +++ b/src/mbase-query.scm @@ -0,0 +1,92 @@ +;; +;; mbase-query.scm +;; +;; Queries of various mbase derived attributes. +;; +;; ISC License +;; +;; Copyright 2023-2025 Brmlab, z.s. +;; Dominik Pantůček +;; +;; 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 mbase-query)) + +(module + mbase-query + ( + mbase-info + mbase-stats + ) + + (import scheme + (chicken base) + srfi-1 + mbase + brmember + util-bst-ldict + primes + cal-period + cal-month) + + (define (members-base-oldest-month mb) + (make-cal-month 2015 1)) + + ;; Returns dictionary with statistics about the members base. + (define (mbase-info mb-arg) + (let* ((members (find-members-by-predicate mb-arg brmember-usable?)) + (di0 (make-ldict)) + (di1 (ldict-set di0 'invalid + (filter (compose not is-4digit-prime? brmember-id) members))) + (di2 (ldict-set di1 'active + (filter brmember-active? members))) + (di3 (ldict-set di2 'suspended + (filter brmember-suspended? members))) + (di4 (ldict-set di3 'students + (filter brmember-student? members))) + (di5 (ldict-set di4 'destroyed + (filter brmember-destroyed? members))) + (di6 (ldict-set di5 'month (*current-month*))) + (di7 (ldict-set di6 'total members)) + (di8 (ldict-set di7 'problems + (find-members-by-predicate mb-arg brmember-has-problems?))) + ;; add expected income + ;; add total balance of all members (including destroyed) + ;; add total balance of all active members (-only-active -like) + ;; add average age of active members + + ) + di8)) + + ;; Returns a list two lists: keys, data. + ;; Each data record contains values for all keys. + (define (mbase-stats mb) + (let ((keys '(month total active suspended students destroyed invalid))) + (let mloop ((data '()) + (month (members-base-oldest-month mb))) + (if (cal-month<=? month (*current-month*)) + (let ((bi (with-current-month month + (mbase-info mb)))) + (let kloop ((row (list (ldict-ref bi 'month))) + (keys (cdr keys))) + (if (null? keys) + (mloop (cons (reverse row) data) + (cal-month-add month 1)) + (kloop (cons (length (ldict-ref bi (car keys))) row) + (cdr keys))))) + (list keys (reverse data)))))) + + ) diff --git a/src/mbase.scm b/src/mbase.scm index 3412306..f2f12bb 100644 --- a/src/mbase.scm +++ b/src/mbase.scm @@ -50,8 +50,6 @@ mbase-update-by-id mbase-update - mbase-stats - mbase-add-unpaired mbase-unpaired @@ -207,47 +205,6 @@ (proc mr) mr))))) - ;; Returns dictionary with statistics about the members base. - (define (mbase-info mb-arg) - (let* ((members (find-members-by-predicate mb-arg brmember-usable?)) - (di0 (make-ldict)) - (di1 (ldict-set di0 'invalid - (filter (compose not is-4digit-prime? brmember-id) members))) - (di2 (ldict-set di1 'active - (filter brmember-active? members))) - (di3 (ldict-set di2 'suspended - (filter brmember-suspended? members))) - (di4 (ldict-set di3 'students - (filter brmember-student? members))) - (di5 (ldict-set di4 'destroyed - (filter brmember-destroyed? members))) - (di6 (ldict-set di5 'month (*current-month*))) - (di7 (ldict-set di6 'total members)) - (di8 (ldict-set di7 'problems - (find-members-by-predicate mb-arg brmember-has-problems?)))) - di8)) - - (define (members-base-oldest-month mb) - (make-cal-month 2015 1)) - - ;; Returns a list two lists: keys, data. - ;; Each data record contains values for all keys. - (define (mbase-stats mb) - (let ((keys '(month total active suspended students destroyed invalid))) - (let mloop ((data '()) - (month (members-base-oldest-month mb))) - (if (cal-month<=? month (*current-month*)) - (let ((bi (with-current-month month - (mbase-info mb)))) - (let kloop ((row (list (ldict-ref bi 'month))) - (keys (cdr keys))) - (if (null? keys) - (mloop (cons (reverse row) data) - (cal-month-add month 1)) - (kloop (cons (length (ldict-ref bi (car keys))) row) - (cdr keys))))) - (list keys (reverse data)))))) - ;; Adds unpaired transaction to given members-base (define (mbase-add-unpaired mb tr) (ldict-set mb 'unpaired diff --git a/src/members-fees.scm b/src/members-fees.scm index 5a3b0c3..7373497 100644 --- a/src/members-fees.scm +++ b/src/members-fees.scm @@ -41,6 +41,7 @@ member-calendar->table members-summary member-calendar-entry->fee + get-expected-income get-expected-income-string ) @@ -208,6 +209,19 @@ (cons 0 0) members))) + (define (get-expected-income mb) + (let* ((flst + (map (compose member-calendar-entry->fee make-member-calendar-entry) + (find-members-by-predicate mb brmember-active?))) + (amts (sort (delete-duplicates flst) <)) + (sums + (map + (lambda (amt) + (cons amt + (length (filter (lambda (v) (= v amt)) flst)))) + amts))) + (number->string (foldl + 0 (map (lambda (p) (* (car p) (cdr p))) sums))))) + (define (get-expected-income-string mb) (let* ((flst (map (compose member-calendar-entry->fee make-member-calendar-entry) From 0e9cfd546bb7ff327d1195933535c351cf0bdfd2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 2 Jan 2025 15:18:53 +0100 Subject: [PATCH 77/95] Add data for graph of expected income. --- src/Makefile | 3 ++- src/mbase-query.scm | 21 +++++++++++++++------ src/members-fees.scm | 2 +- 3 files changed, 18 insertions(+), 8 deletions(-) diff --git a/src/Makefile b/src/Makefile index cd59f87..b8d623d 100644 --- a/src/Makefile +++ b/src/Makefile @@ -572,7 +572,8 @@ export-sheet.import.scm: $(EXPORT-SHEET-SOURCES) MBASE-QUERY-SOURCES=mbase-query.scm mbase.import.scm \ brmember.import.scm util-bst-ldict.scm primes.import.scm \ - cal-period.import.scm cal-month.import.scm + cal-period.import.scm cal-month.import.scm \ + members-fees.import.scm mbase-query.o: mbase-query.import.scm mbase-query.import.scm: $(MBASE-QUERY-SOURCES) diff --git a/src/mbase-query.scm b/src/mbase-query.scm index c9e3e4c..d54449e 100644 --- a/src/mbase-query.scm +++ b/src/mbase-query.scm @@ -40,7 +40,8 @@ util-bst-ldict primes cal-period - cal-month) + cal-month + members-fees) (define (members-base-oldest-month mb) (make-cal-month 2015 1)) @@ -63,18 +64,22 @@ (di7 (ldict-set di6 'total members)) (di8 (ldict-set di7 'problems (find-members-by-predicate mb-arg brmember-has-problems?))) - ;; add expected income + (di9 (ldict-set di8 'expected + (get-expected-income mb-arg))) ;; add total balance of all members (including destroyed) ;; add total balance of all active members (-only-active -like) ;; add average age of active members - ) - di8)) + di9)) ;; Returns a list two lists: keys, data. ;; Each data record contains values for all keys. (define (mbase-stats mb) - (let ((keys '(month total active suspended students destroyed invalid))) + (let ((keys + '(month + total active suspended students destroyed invalid + expected + ))) (let mloop ((data '()) (month (members-base-oldest-month mb))) (if (cal-month<=? month (*current-month*)) @@ -85,7 +90,11 @@ (if (null? keys) (mloop (cons (reverse row) data) (cal-month-add month 1)) - (kloop (cons (length (ldict-ref bi (car keys))) row) + (kloop (cons (let ((val (ldict-ref bi (car keys)))) + (if (list? val) + (length val) + val)) + row) (cdr keys))))) (list keys (reverse data)))))) diff --git a/src/members-fees.scm b/src/members-fees.scm index 7373497..1782f62 100644 --- a/src/members-fees.scm +++ b/src/members-fees.scm @@ -220,7 +220,7 @@ (cons amt (length (filter (lambda (v) (= v amt)) flst)))) amts))) - (number->string (foldl + 0 (map (lambda (p) (* (car p) (cdr p))) sums))))) + (foldl + 0 (map (lambda (p) (* (car p) (cdr p))) sums)))) (define (get-expected-income-string mb) (let* ((flst From 7dbdd3ea6e1a8e1298135180945d79c584268ebd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 2 Jan 2025 16:10:00 +0100 Subject: [PATCH 78/95] Balance summaries for all members over time. --- src/Makefile | 2 +- src/hackerbase.scm | 1 + src/mbase-query.scm | 17 +++++++++++------ 3 files changed, 13 insertions(+), 7 deletions(-) diff --git a/src/Makefile b/src/Makefile index b8d623d..827b386 100644 --- a/src/Makefile +++ b/src/Makefile @@ -573,7 +573,7 @@ export-sheet.import.scm: $(EXPORT-SHEET-SOURCES) MBASE-QUERY-SOURCES=mbase-query.scm mbase.import.scm \ brmember.import.scm util-bst-ldict.scm primes.import.scm \ cal-period.import.scm cal-month.import.scm \ - members-fees.import.scm + members-fees.import.scm members-payments.import.scm mbase-query.o: mbase-query.import.scm mbase-query.import.scm: $(MBASE-QUERY-SOURCES) diff --git a/src/hackerbase.scm b/src/hackerbase.scm index ce6c781..9f29a94 100644 --- a/src/hackerbase.scm +++ b/src/hackerbase.scm @@ -184,6 +184,7 @@ (-action- 'genweb)) (-stats (file:gnuplot-data) "Get stats for all months" (-action- 'print-stats) + (-needs-bank- #t) (-fname- file:gnuplot-data)) (-sheet (filename gmnum) "Generate attendance sheet for given GM number" (-needs-bank- #t) diff --git a/src/mbase-query.scm b/src/mbase-query.scm index d54449e..d801a2f 100644 --- a/src/mbase-query.scm +++ b/src/mbase-query.scm @@ -41,7 +41,8 @@ primes cal-period cal-month - members-fees) + members-fees + members-payments) (define (members-base-oldest-month mb) (make-cal-month 2015 1)) @@ -52,8 +53,9 @@ (di0 (make-ldict)) (di1 (ldict-set di0 'invalid (filter (compose not is-4digit-prime? brmember-id) members))) + (active-members (filter brmember-active? members)) (di2 (ldict-set di1 'active - (filter brmember-active? members))) + active-members)) (di3 (ldict-set di2 'suspended (filter brmember-suspended? members))) (di4 (ldict-set di3 'students @@ -66,11 +68,14 @@ (find-members-by-predicate mb-arg brmember-has-problems?))) (di9 (ldict-set di8 'expected (get-expected-income mb-arg))) - ;; add total balance of all members (including destroyed) - ;; add total balance of all active members (-only-active -like) + (mbals (map member-total-balance active-members)) + (di10 (ldict-set di9 'balance + (foldl + 0 mbals))) + ;; advance payments + ;; debts of fees ;; add average age of active members ) - di9)) + di10)) ;; Returns a list two lists: keys, data. ;; Each data record contains values for all keys. @@ -78,7 +83,7 @@ (let ((keys '(month total active suspended students destroyed invalid - expected + expected balance ))) (let mloop ((data '()) (month (members-base-oldest-month mb))) From 227787597d5b48985913a7df995f0bca8d973992 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 2 Jan 2025 16:22:37 +0100 Subject: [PATCH 79/95] Finish stats for debts. --- src/mbase-query.scm | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/src/mbase-query.scm b/src/mbase-query.scm index d801a2f..af7ed30 100644 --- a/src/mbase-query.scm +++ b/src/mbase-query.scm @@ -71,11 +71,20 @@ (mbals (map member-total-balance active-members)) (di10 (ldict-set di9 'balance (foldl + 0 mbals))) - ;; advance payments + (di11 (ldict-set di10 'advance + (foldl + 0 + (map (lambda (v) + (max 0 v)) + mbals)))) + (di12 (ldict-set di11 'debt + (foldl + 0 + (map (lambda (v) + (min 0 v)) + mbals)))) ;; debts of fees ;; add average age of active members ) - di10)) + di12)) ;; Returns a list two lists: keys, data. ;; Each data record contains values for all keys. @@ -83,7 +92,7 @@ (let ((keys '(month total active suspended students destroyed invalid - expected balance + expected balance advance debt ))) (let mloop ((data '()) (month (members-base-oldest-month mb))) From 6cfdf705c8d45e2b74a32dcdaf22e20251187742 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 2 Jan 2025 16:58:41 +0100 Subject: [PATCH 80/95] Finish new stats. --- src/brmember.scm | 14 + src/cal-period.scm | 888 ++++++++++++++++++++++---------------------- src/mbase-query.scm | 14 +- 3 files changed, 471 insertions(+), 445 deletions(-) diff --git a/src/brmember.scm b/src/brmember.scm index 496dc96..cb065f4 100644 --- a/src/brmember.scm +++ b/src/brmember.scm @@ -87,6 +87,8 @@ brmember-spec-fee + brmember-age + brmember-tests! ) @@ -492,6 +494,18 @@ #f)) #f))) + (define (brmember-age mr) + (let ((born (brmember-info mr 'born #f))) + (if born + (let ((lst (string-split born "-"))) + (if (null? lst) + #f + (let ((y (string->number (car lst)))) + (if y + (- (current-year) y) + #f)))) + #f))) + ;; Self-tests (define (brmember-tests!) (run-tests diff --git a/src/cal-period.scm b/src/cal-period.scm index ea1cf3d..447f563 100644 --- a/src/cal-period.scm +++ b/src/cal-period.scm @@ -26,460 +26,464 @@ (declare (unit cal-period)) (module - cal-period - ( - *current-month* - *current-day* - - set-current-month! - set-current-day! - - with-current-month - with-current-day - - make-cal-period - - cal-period-since - cal-period-before - cal-period-scomment - cal-period-bcomment - - set-cal-period-scomment - - period-markers->cal-periods - - cal-periods-duration - - cal-month-in-period? - cal-month-in-periods? - - cal-month-find-period - - cal-day-in-period? - cal-day-in-periods? - - cal-periods->string - cal-periods-match - - make-cal-period-lookup-table - lookup-by-cal-period - - cal-ensure-month - cal-ensure-day - - cal-period-tests! - ) - - (import scheme - (chicken base) - (chicken sort) - (chicken time) - (chicken time posix) - (chicken format) - (chicken string) - cal-month - testing - util-tag - cal-day) - - ;; Type tag - (define TAG-CAL-PERIOD (make-tag CAL-PERIOD)) - - ;; Current month - if changed, we get the actual state for given month. - (define *current-month* - (make-parameter - (let ((d (seconds->local-time (current-seconds)))) - (make-cal-month (+ 1900 (vector-ref d 5)) - (+ (vector-ref d 4) 1))))) - - ;; Current month - if changed, we get the actual state for given month. - (define *current-day* - (make-parameter - (let ((d (seconds->local-time (current-seconds)))) - (make-cal-day (+ 1900 (vector-ref d 5)) - (+ (vector-ref d 4) 1) - (vector-ref d 3))))) - - ;; Changes both current-month and current-day based on given month - (define (set-current-month! m) - (*current-month* m) - (*current-day* (cal-ensure-day m))) - - ;; Changes both current-day and current-month based on given day - (define (set-current-day! d) - (*current-day* d) - (*current-month* (cal-ensure-month d))) - - ;; Parameterizes both current-month and current-day based on given - ;; month - (define-syntax with-current-month - (syntax-rules () - ((_ ms body ...) - (let ((m ms)) - (parameterize ((*current-month* m) - (*current-day* (cal-ensure-day m))) - body ...))))) - - ;; Parameterizes both current-day and current-month based on given - ;; day - (define-syntax with-current-day - (syntax-rules () - ((_ ds body ...) - (let ((d ds)) - (parameterize ((*current-day* d) - (*current-month* (cal-ensure-month d))) - body ...))))) - - ;; Creates a new period value with optional since and before - ;; comments. - (define (make-cal-period since before . args) - (let ((scomment (if (not (null? args)) (car args) #f)) - (bcomment (if (and (not (null? args)) - (not (null? (cdr args)))) - (cadr args) - #f))) - (list TAG-CAL-PERIOD since before scomment bcomment))) - - ;; Simple accessors - (define cal-period-since cadr) - (define cal-period-before caddr) - (define cal-period-scomment cadddr) - (define cal-period-bcomment (compose cadddr cdr)) - - ;; Direct updater - (define (set-cal-period-scomment p c) - (list TAG-CAL-PERIOD - (cal-period-since p) - (cal-period-before p) - c - (cal-period-bcomment p))) - - ;; Type predicate - (define (cal-period? p) - (and (pair? p) - (eq? (car p) - TAG-CAL-PERIOD))) - - ;; Month subtype predicate - (define (cal-period-month? p) - (and (cal-period? p) - (cal-month? (cal-period-since p)) - (cal-month? (cal-period-before p)))) - - ;; Day subtype predicate - (define (cal-period-day? p) - (and (cal-period? p) - (cal-day? (cal-period-since p)) - (cal-day? (cal-period-before p)))) - - ;; Validation - (define (cal-period-valid? p) - (and (pair? p) - (eq? (car p) - TAG-CAL-PERIOD) - (let ((since (cal-period-since p)) - (before (cal-period-before p))) - (or (and (cal-month? since) - (cal-month? before) - (cal-month<=? since before)) - (and (cal-day? since) - (cal-day? before) - (cal-day<=? since before)))))) - - ;; Sorts period markers (be it start or end) chronologically and - ;; returns the sorted list. - (define (sort-period-markers l) - (sort l - (lambda (a b) - (cal-day/monthcal-periods l) - (let loop ((l (sort-period-markers l)) - (ps '()) - (cb #f)) - (if (null? l) - (list #t - (if cb - (reverse (cons (make-cal-period (car cb) #f (cadr cb)) ps)) - (reverse ps)) - "" - -1) - (let* ((marker (car l)) - (rmt (if cb 'stop 'start)) - (mtype (car marker)) - (month (cadr marker)) - (line-number (if (null? (cddr marker)) - #f - (caddr marker))) - (comment (if (and line-number - (not (null? (cdddr marker)))) - (cadddr marker) - #f))) - (if (eq? mtype rmt) - (if cb - (loop (cdr l) - (cons (make-cal-period (car cb) month (cadr cb) comment) ps) - #f) - (loop (cdr l) - ps - (list month comment))) - (list #f - (reverse ps) - (sprintf "Invalid start/stop sequence marker ~A" marker) - line-number)))))) - - ;; Returns duration of period in months. Start is included, end is - ;; not. The period contains the month just before the specified end. - (define (cal-period->duration p) - (let* ((b (cal-period-since p)) - (e (cal-period-before p)) - (e- (if e e (*current-month*)))) - (cal-month-diff b e-))) - - ;; Returns sum of periods lengths. - (define (cal-periods-duration l) - (apply + (map cal-period->duration l))) - - ;; True if month belongs to given month period - start inclusive, end - ;; exclusive. - (define (cal-month-in-period? p . ml) - (let ((m (if (null? ml) - (*current-month*) - (cal-ensure-month (car ml)))) - (before (cal-ensure-month (cal-period-before p) #t)) - (since (cal-ensure-month (cal-period-since p)))) - (and (or (not before) - (cal-monthstring p) - (sprintf "~A..~A" - (cal-day/month->string (cal-period-since p)) - (cal-day/month->string (cal-period-before p)))) - - ;; Returns a string representing a list of periods. - (define (cal-periods->string ps) - (string-intersperse - (map cal-period->string ps) - ", ")) - - ;; Finds a period the month matches and returns it. If no period - ;; matches, it returns #f. - (define (cal-periods-match ps . ml) - (let ((m (if (null? ml) (*current-month*) (car ml)))) - (let loop ((ps ps)) - (if (null? ps) - #f - (if (cal-month-in-period? (car ps) m) - (car ps) - (loop (cdr ps))))))) - - ;; Creates lookup table from definition source - (define (make-cal-period-lookup-table source) - (let loop ((lst source) - (res '()) - (prev #f)) - (if (null? lst) - (reverse - (cons (cons (make-cal-period (apply make-cal-month (car prev)) #f) - (cdr prev)) - res)) - (loop (cdr lst) - (if prev - (cons (cons (make-cal-period (apply make-cal-month (car prev)) - (apply make-cal-month (caar lst))) - (cdr prev)) - res) - res) - (car lst))))) - - ;; Looks up current month and returns associated definitions - (define (lookup-by-cal-period table) - (let loop ((lst table)) - (if (null? lst) - #f - (if (cal-month-in-period? (caar lst)) - (cdar lst) - (loop (cdr lst)))))) - - ;; Wrapper that accepts either day or month and returns testable month - (define (cal-ensure-month v . stop?s) - (if v - (if (cal-month? v) - v - (if (cal-day? v) - (apply cal-day->month v stop?s) - #f)) - #f)) - - ;; Ensures day for checking the periods - (define (cal-ensure-day v) - (if v - (if (cal-day? v) - v - (if (cal-month? v) - (make-cal-day (cal-month-year v) - (cal-month-month v) - 1) - #f)) - #f)) - - ;; Performs self-tests of the period module. - (define (cal-period-tests!) - (run-tests cal-period - (test-equal? sort-period-markers - (sort-period-markers - `((start ,(make-cal-month 2023 1)) - (stop ,(make-cal-month 2022 10)) - (start ,(make-cal-month 2022 3)))) - `((start ,(make-cal-month 2022 3)) - (stop ,(make-cal-month 2022 10)) - (start ,(make-cal-month 2023 1)))) - (test-equal? period-markers->cal-periods - (period-markers->cal-periods + ( + current-year + *current-month* + *current-day* + + set-current-month! + set-current-day! + + with-current-month + with-current-day + + make-cal-period + + cal-period-since + cal-period-before + cal-period-scomment + cal-period-bcomment + + set-cal-period-scomment + + period-markers->cal-periods + + cal-periods-duration + + cal-month-in-period? + cal-month-in-periods? + + cal-month-find-period + + cal-day-in-period? + cal-day-in-periods? + + cal-periods->string + cal-periods-match + + make-cal-period-lookup-table + lookup-by-cal-period + + cal-ensure-month + cal-ensure-day + + cal-period-tests! + ) + + (import scheme + (chicken base) + (chicken sort) + (chicken time) + (chicken time posix) + (chicken format) + (chicken string) + cal-month + testing + util-tag + cal-day) + + ;; Type tag + (define TAG-CAL-PERIOD (make-tag CAL-PERIOD)) + + (define (current-year) + (cal-month-year (*current-month*))) + + ;; Current month - if changed, we get the actual state for given month. + (define *current-month* + (make-parameter + (let ((d (seconds->local-time (current-seconds)))) + (make-cal-month (+ 1900 (vector-ref d 5)) + (+ (vector-ref d 4) 1))))) + + ;; Current month - if changed, we get the actual state for given month. + (define *current-day* + (make-parameter + (let ((d (seconds->local-time (current-seconds)))) + (make-cal-day (+ 1900 (vector-ref d 5)) + (+ (vector-ref d 4) 1) + (vector-ref d 3))))) + + ;; Changes both current-month and current-day based on given month + (define (set-current-month! m) + (*current-month* m) + (*current-day* (cal-ensure-day m))) + + ;; Changes both current-day and current-month based on given day + (define (set-current-day! d) + (*current-day* d) + (*current-month* (cal-ensure-month d))) + + ;; Parameterizes both current-month and current-day based on given + ;; month + (define-syntax with-current-month + (syntax-rules () + ((_ ms body ...) + (let ((m ms)) + (parameterize ((*current-month* m) + (*current-day* (cal-ensure-day m))) + body ...))))) + + ;; Parameterizes both current-day and current-month based on given + ;; day + (define-syntax with-current-day + (syntax-rules () + ((_ ds body ...) + (let ((d ds)) + (parameterize ((*current-day* d) + (*current-month* (cal-ensure-month d))) + body ...))))) + + ;; Creates a new period value with optional since and before + ;; comments. + (define (make-cal-period since before . args) + (let ((scomment (if (not (null? args)) (car args) #f)) + (bcomment (if (and (not (null? args)) + (not (null? (cdr args)))) + (cadr args) + #f))) + (list TAG-CAL-PERIOD since before scomment bcomment))) + + ;; Simple accessors + (define cal-period-since cadr) + (define cal-period-before caddr) + (define cal-period-scomment cadddr) + (define cal-period-bcomment (compose cadddr cdr)) + + ;; Direct updater + (define (set-cal-period-scomment p c) + (list TAG-CAL-PERIOD + (cal-period-since p) + (cal-period-before p) + c + (cal-period-bcomment p))) + + ;; Type predicate + (define (cal-period? p) + (and (pair? p) + (eq? (car p) + TAG-CAL-PERIOD))) + + ;; Month subtype predicate + (define (cal-period-month? p) + (and (cal-period? p) + (cal-month? (cal-period-since p)) + (cal-month? (cal-period-before p)))) + + ;; Day subtype predicate + (define (cal-period-day? p) + (and (cal-period? p) + (cal-day? (cal-period-since p)) + (cal-day? (cal-period-before p)))) + + ;; Validation + (define (cal-period-valid? p) + (and (pair? p) + (eq? (car p) + TAG-CAL-PERIOD) + (let ((since (cal-period-since p)) + (before (cal-period-before p))) + (or (and (cal-month? since) + (cal-month? before) + (cal-month<=? since before)) + (and (cal-day? since) + (cal-day? before) + (cal-day<=? since before)))))) + + ;; Sorts period markers (be it start or end) chronologically and + ;; returns the sorted list. + (define (sort-period-markers l) + (sort l + (lambda (a b) + (cal-day/monthcal-periods l) + (let loop ((l (sort-period-markers l)) + (ps '()) + (cb #f)) + (if (null? l) + (list #t + (if cb + (reverse (cons (make-cal-period (car cb) #f (cadr cb)) ps)) + (reverse ps)) + "" + -1) + (let* ((marker (car l)) + (rmt (if cb 'stop 'start)) + (mtype (car marker)) + (month (cadr marker)) + (line-number (if (null? (cddr marker)) + #f + (caddr marker))) + (comment (if (and line-number + (not (null? (cdddr marker)))) + (cadddr marker) + #f))) + (if (eq? mtype rmt) + (if cb + (loop (cdr l) + (cons (make-cal-period (car cb) month (cadr cb) comment) ps) + #f) + (loop (cdr l) + ps + (list month comment))) + (list #f + (reverse ps) + (sprintf "Invalid start/stop sequence marker ~A" marker) + line-number)))))) + + ;; Returns duration of period in months. Start is included, end is + ;; not. The period contains the month just before the specified end. + (define (cal-period->duration p) + (let* ((b (cal-period-since p)) + (e (cal-period-before p)) + (e- (if e e (*current-month*)))) + (cal-month-diff b e-))) + + ;; Returns sum of periods lengths. + (define (cal-periods-duration l) + (apply + (map cal-period->duration l))) + + ;; True if month belongs to given month period - start inclusive, end + ;; exclusive. + (define (cal-month-in-period? p . ml) + (let ((m (if (null? ml) + (*current-month*) + (cal-ensure-month (car ml)))) + (before (cal-ensure-month (cal-period-before p) #t)) + (since (cal-ensure-month (cal-period-since p)))) + (and (or (not before) + (cal-monthstring p) + (sprintf "~A..~A" + (cal-day/month->string (cal-period-since p)) + (cal-day/month->string (cal-period-before p)))) + + ;; Returns a string representing a list of periods. + (define (cal-periods->string ps) + (string-intersperse + (map cal-period->string ps) + ", ")) + + ;; Finds a period the month matches and returns it. If no period + ;; matches, it returns #f. + (define (cal-periods-match ps . ml) + (let ((m (if (null? ml) (*current-month*) (car ml)))) + (let loop ((ps ps)) + (if (null? ps) + #f + (if (cal-month-in-period? (car ps) m) + (car ps) + (loop (cdr ps))))))) + + ;; Creates lookup table from definition source + (define (make-cal-period-lookup-table source) + (let loop ((lst source) + (res '()) + (prev #f)) + (if (null? lst) + (reverse + (cons (cons (make-cal-period (apply make-cal-month (car prev)) #f) + (cdr prev)) + res)) + (loop (cdr lst) + (if prev + (cons (cons (make-cal-period (apply make-cal-month (car prev)) + (apply make-cal-month (caar lst))) + (cdr prev)) + res) + res) + (car lst))))) + + ;; Looks up current month and returns associated definitions + (define (lookup-by-cal-period table) + (let loop ((lst table)) + (if (null? lst) + #f + (if (cal-month-in-period? (caar lst)) + (cdar lst) + (loop (cdr lst)))))) + + ;; Wrapper that accepts either day or month and returns testable month + (define (cal-ensure-month v . stop?s) + (if v + (if (cal-month? v) + v + (if (cal-day? v) + (apply cal-day->month v stop?s) + #f)) + #f)) + + ;; Ensures day for checking the periods + (define (cal-ensure-day v) + (if v + (if (cal-day? v) + v + (if (cal-month? v) + (make-cal-day (cal-month-year v) + (cal-month-month v) + 1) + #f)) + #f)) + + ;; Performs self-tests of the period module. + (define (cal-period-tests!) + (run-tests + cal-period + (test-equal? sort-period-markers + (sort-period-markers + `((start ,(make-cal-month 2023 1)) + (stop ,(make-cal-month 2022 10)) + (start ,(make-cal-month 2022 3)))) `((start ,(make-cal-month 2022 3)) (stop ,(make-cal-month 2022 10)) - (start ,(make-cal-month 2023 1)) - (stop ,(make-cal-month 2023 4)))) - `(#t - (,(make-cal-period (make-cal-month 2022 3) - (make-cal-month 2022 10) #f #f) - ,(make-cal-period (make-cal-month 2023 1) - (make-cal-month 2023 4) #f #f)) - "" - -1)) - (test-equal? period-markers->cal-periods-open - (period-markers->cal-periods - `((start ,(make-cal-month 2022 3)) - (stop ,(make-cal-month 2022 10)) - (start ,(make-cal-month 2023 1)) - (stop ,(make-cal-month 2023 4)) - (start ,(make-cal-month 2023 5)))) - `(#t - (,(make-cal-period (make-cal-month 2022 3) - (make-cal-month 2022 10) #f #f) - ,(make-cal-period (make-cal-month 2023 1) - (make-cal-month 2023 4) #f #f) - ,(make-cal-period (make-cal-month 2023 5) #f #f #f)) - "" - -1)) - (test-eq? cal-period->duration - (cal-period->duration (make-cal-period (make-cal-month 2023 1) - (make-cal-month 2023 4) #f #f)) - 3) - (parameterize ((*current-month* (make-cal-month 2023 4))) - (test-eq? cal-period->duration - (cal-period->duration (make-cal-period (make-cal-month 2023 1) #f #f #f)) - 3)) - (test-eq? cal-periods-duration - (cal-periods-duration `(,(make-cal-period (make-cal-month 2022 3) - (make-cal-month 2022 10) #f #f) - ,(make-cal-period (make-cal-month 2023 1) - (make-cal-month 2023 4) #f #f))) - 10) - (test-true cal-month-in-period? - (cal-month-in-period? (make-cal-period (make-cal-month 2022 1) - (make-cal-month 2022 4) #f #f) - (make-cal-month 2022 3))) - (test-false cal-month-in-period? + (start ,(make-cal-month 2023 1)))) + (test-equal? period-markers->cal-periods + (period-markers->cal-periods + `((start ,(make-cal-month 2022 3)) + (stop ,(make-cal-month 2022 10)) + (start ,(make-cal-month 2023 1)) + (stop ,(make-cal-month 2023 4)))) + `(#t + (,(make-cal-period (make-cal-month 2022 3) + (make-cal-month 2022 10) #f #f) + ,(make-cal-period (make-cal-month 2023 1) + (make-cal-month 2023 4) #f #f)) + "" + -1)) + (test-equal? period-markers->cal-periods-open + (period-markers->cal-periods + `((start ,(make-cal-month 2022 3)) + (stop ,(make-cal-month 2022 10)) + (start ,(make-cal-month 2023 1)) + (stop ,(make-cal-month 2023 4)) + (start ,(make-cal-month 2023 5)))) + `(#t + (,(make-cal-period (make-cal-month 2022 3) + (make-cal-month 2022 10) #f #f) + ,(make-cal-period (make-cal-month 2023 1) + (make-cal-month 2023 4) #f #f) + ,(make-cal-period (make-cal-month 2023 5) #f #f #f)) + "" + -1)) + (test-eq? cal-period->duration + (cal-period->duration (make-cal-period (make-cal-month 2023 1) + (make-cal-month 2023 4) #f #f)) + 3) + (parameterize ((*current-month* (make-cal-month 2023 4))) + (test-eq? cal-period->duration + (cal-period->duration (make-cal-period (make-cal-month 2023 1) #f #f #f)) + 3)) + (test-eq? cal-periods-duration + (cal-periods-duration `(,(make-cal-period (make-cal-month 2022 3) + (make-cal-month 2022 10) #f #f) + ,(make-cal-period (make-cal-month 2023 1) + (make-cal-month 2023 4) #f #f))) + 10) + (test-true cal-month-in-period? (cal-month-in-period? (make-cal-period (make-cal-month 2022 1) (make-cal-month 2022 4) #f #f) - (make-cal-month 2022 5))) - (test-true cal-month-in-periods? - (cal-month-in-periods? `(,(make-cal-period (make-cal-month 2022 1) - (make-cal-month 2022 4) #f #f) - ,(make-cal-period (make-cal-month 2023 5) - (make-cal-month 2023 10) #f #f)) (make-cal-month 2022 3))) - (test-true cal-month-in-periods? - (cal-month-in-periods? `(,(make-cal-period (make-cal-month 2022 1) - (make-cal-month 2022 4) #f #f) - ,(make-cal-period (make-cal-month 2023 5) - (make-cal-month 2023 10) #f #f)) - (make-cal-month 2023 7))) - (test-false cal-month-in-periods? + (test-false cal-month-in-period? + (cal-month-in-period? (make-cal-period (make-cal-month 2022 1) + (make-cal-month 2022 4) #f #f) + (make-cal-month 2022 5))) + (test-true cal-month-in-periods? (cal-month-in-periods? `(,(make-cal-period (make-cal-month 2022 1) (make-cal-month 2022 4) #f #f) ,(make-cal-period (make-cal-month 2023 5) (make-cal-month 2023 10) #f #f)) - (make-cal-month 2022 10))) - (test-equal? cal-period->string - (cal-period->string (make-cal-period (make-cal-month 2022 1) - (make-cal-month 2022 4) #f #f)) - "2022-01..2022-04") - (test-equal? cal-periods->string - (cal-periods->string `(,(make-cal-period (make-cal-month 2022 1) - (make-cal-month 2022 4) #f #f) - ,(make-cal-period (make-cal-month 2022 12) - (make-cal-month 2023 2) #f #f))) - "2022-01..2022-04, 2022-12..2023-02") - (test-false cal-periods-match - (cal-periods-match `(,(make-cal-period (make-cal-month 2022 1) - (make-cal-month 2022 4) #f #f) - ,(make-cal-period (make-cal-month 2022 12) - (make-cal-month 2023 2) #f #f)) - (make-cal-month 2022 5))) - (test-equal? cal-periods-match + (make-cal-month 2022 3))) + (test-true cal-month-in-periods? + (cal-month-in-periods? `(,(make-cal-period (make-cal-month 2022 1) + (make-cal-month 2022 4) #f #f) + ,(make-cal-period (make-cal-month 2023 5) + (make-cal-month 2023 10) #f #f)) + (make-cal-month 2023 7))) + (test-false cal-month-in-periods? + (cal-month-in-periods? `(,(make-cal-period (make-cal-month 2022 1) + (make-cal-month 2022 4) #f #f) + ,(make-cal-period (make-cal-month 2023 5) + (make-cal-month 2023 10) #f #f)) + (make-cal-month 2022 10))) + (test-equal? cal-period->string + (cal-period->string (make-cal-period (make-cal-month 2022 1) + (make-cal-month 2022 4) #f #f)) + "2022-01..2022-04") + (test-equal? cal-periods->string + (cal-periods->string `(,(make-cal-period (make-cal-month 2022 1) + (make-cal-month 2022 4) #f #f) + ,(make-cal-period (make-cal-month 2022 12) + (make-cal-month 2023 2) #f #f))) + "2022-01..2022-04, 2022-12..2023-02") + (test-false cal-periods-match (cal-periods-match `(,(make-cal-period (make-cal-month 2022 1) (make-cal-month 2022 4) #f #f) ,(make-cal-period (make-cal-month 2022 12) (make-cal-month 2023 2) #f #f)) - (make-cal-month 2022 2)) - (make-cal-period (make-cal-month 2022 1) - (make-cal-month 2022 4) #f #f)) - )) + (make-cal-month 2022 5))) + (test-equal? cal-periods-match + (cal-periods-match `(,(make-cal-period (make-cal-month 2022 1) + (make-cal-month 2022 4) #f #f) + ,(make-cal-period (make-cal-month 2022 12) + (make-cal-month 2023 2) #f #f)) + (make-cal-month 2022 2)) + (make-cal-period (make-cal-month 2022 1) + (make-cal-month 2022 4) #f #f)) + )) - ) + ) diff --git a/src/mbase-query.scm b/src/mbase-query.scm index af7ed30..df560af 100644 --- a/src/mbase-query.scm +++ b/src/mbase-query.scm @@ -47,6 +47,13 @@ (define (members-base-oldest-month mb) (make-cal-month 2015 1)) + (define (members-average-age mrs) + (let* ((ages (map brmember-age mrs)) + (valid (filter (lambda (x) x) ages)) + (num (length valid)) + (sum (foldl + 0 valid))) + (exact->inexact (/ sum num)))) + ;; Returns dictionary with statistics about the members base. (define (mbase-info mb-arg) (let* ((members (find-members-by-predicate mb-arg brmember-usable?)) @@ -81,10 +88,10 @@ (map (lambda (v) (min 0 v)) mbals)))) - ;; debts of fees - ;; add average age of active members + (di13 (ldict-set di12 'age + (members-average-age active-members))) ) - di12)) + di13)) ;; Returns a list two lists: keys, data. ;; Each data record contains values for all keys. @@ -93,6 +100,7 @@ '(month total active suspended students destroyed invalid expected balance advance debt + age ))) (let mloop ((data '()) (month (members-base-oldest-month mb))) From c8c71f84657d8f613e869eb9a9a8194eaacde666 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 2 Jan 2025 17:42:13 +0100 Subject: [PATCH 81/95] Preliminary longtable version of attendance sheet. --- src/export-sheet.scm | 47 +++++++++++++++++++++++++++++++------------- 1 file changed, 33 insertions(+), 14 deletions(-) diff --git a/src/export-sheet.scm b/src/export-sheet.scm index 3dc9c29..a88dd33 100644 --- a/src/export-sheet.scm +++ b/src/export-sheet.scm @@ -35,6 +35,7 @@ (chicken base) (chicken string) (chicken format) + (chicken sort) srfi-1 mbase brmember @@ -47,31 +48,42 @@ cal-day) (define (print-attendance-sheet MB number) - (print "\\documentclass[10pt]{article}") - (print "\\usepackage[top=1cm,left=1cm,right=2cm,bottom=2cm]{geometry}") - (print "\\begin{document}") - (print "\\begin{center}") + (print "\\documentclass{article}") + (print "\\usepackage{fancyhdr}") + (print "\\usepackage{longtable}") + (print "\\usepackage{lastpage}") + (print "\\usepackage[top=3cm,left=1cm,right=2cm,bottom=3cm]{geometry}") + (print "\\lhead{}") (print (format - "Prezenční listina ~A. Valné Hromady brmlab z.s. konané ~A. ~A. ~A v sídle spolku" + "\\chead{Prezenční listina ~A. Valné Hromady brmlab z.s. konané ~A. ~A. ~A v sídle spolku}" number (cal-day-day (*current-day*)) (cal-day-month (*current-day*)) (cal-day-year (*current-day*)) )) + (print "\\rhead{}") + (print "\\renewcommand{\\headrulewidth}{0pt}") + (print "\\lfoot{}") + (print "\\cfoot{Strana \\thepage{} ze \\pageref*{LastPage}}") + (print "\\rfoot{}") + (print "\\pagestyle{fancy}") + (print "\\begin{document}") + (print "\\begin{center}") (newline) (print "\\vskip1em") (newline) (define colnames - '((id) Nick Name Surname (Fee) (Balance) B (Active) A OK? Signature)) + '((id) Nick "Jméno" "Příjmení" (Fee) (Balance) B (Active) A OK? Signature)) + (print "\\renewcommand\\arraystretch{2.0}") (print (format - "\\begin{tabular}{|~A|}" + "\\begin{longtable}{|~A|}" (string-intersperse (map (lambda (x) - (if (symbol? x) - "l" "r")) + (if (list? x) + "r" "l")) colnames) "|"))) (print "\\hline") @@ -83,17 +95,24 @@ "\\textbf{~A}" (if (symbol? x) (symbol->string x) - (symbol->string (car x))))) + (if (string? x) + x + (symbol->string (car x)))))) colnames) "&") "\\\\") (print "\\hline") + (print "\\endhead") (define valid-voters 0) (define ok-balances 0) (define ok-actives 0) - (let loop ((mrs (find-members-by-predicate - MB (lambda (mr) - (brmember-active? mr))))) + (let loop ((mrs (sort + (find-members-by-predicate + MB (lambda (mr) + (brmember-active? mr))) + (lambda (a b) + (string Date: Thu, 2 Jan 2025 18:09:03 +0100 Subject: [PATCH 82/95] Typography improvements. --- src/export-sheet.scm | 36 +++++++++++++++++++++++++----------- 1 file changed, 25 insertions(+), 11 deletions(-) diff --git a/src/export-sheet.scm b/src/export-sheet.scm index a88dd33..5bc94cb 100644 --- a/src/export-sheet.scm +++ b/src/export-sheet.scm @@ -74,8 +74,8 @@ (print "\\vskip1em") (newline) (define colnames - '((id) Nick "Jméno" "Příjmení" (Fee) (Balance) B (Active) A OK? Signature)) - (print "\\renewcommand\\arraystretch{2.0}") + '((id) Nick "Jméno" "Příjmení" (Fee) (Bilance) ("\\begin{minipage}{15mm}\\begin{center}Aktivní\\\\Měsíce\\end{center}\\end{minipage}") OK? Podpis)) + (print "\\renewcommand\\arraystretch{2.1}") (print (format "\\begin{longtable}{|~A|}" @@ -97,7 +97,9 @@ (symbol->string x) (if (string? x) x - (symbol->string (car x)))))) + (if (string? (car x)) + (car x) + (symbol->string (car x))))))) colnames) "&") "\\\\") @@ -168,24 +170,36 @@ " & " current-fee " & " + "\\begin{minipage}{15mm}\\begin{flushright}" (format-amount-tex (member-total-balance mr)) - " & " + "\\\\" (if balance-ok? - "Y" - "--") - " & " - numactive + "Bez~dluhu" + "---~~~~~~") + "\\end{flushright}\\end{minipage}" " & " + ;(if balance-ok? + ; "Y" + ; "--") + ;" & " + "\\begin{minipage}{12mm}\\begin{center}" + numactive "/" 12 + "\\\\" (if active-ok? - "Y" - "--") + "Splněno" + "\\phantom{Sp}---\\phantom{Sp}") + "\\end{center}\\end{minipage}" " & " + ;(if active-ok? + ; "Y" + ; "--") + ;" & " (if vote-ok? "Y" "--") " & " - "~ ~ ~ ~ ~" + "~\\hskip24mm~" " \\\\") (print "\\hline") (loop (cdr mrs))))) From cebe6a6cf7e0befc47f070e17c5474298b936ff4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 2 Jan 2025 19:34:13 +0100 Subject: [PATCH 83/95] Finish almost final version of attendance sheet. --- src/export-sheet.scm | 29 ++++++++++++++++++----------- 1 file changed, 18 insertions(+), 11 deletions(-) diff --git a/src/export-sheet.scm b/src/export-sheet.scm index 5bc94cb..a907129 100644 --- a/src/export-sheet.scm +++ b/src/export-sheet.scm @@ -74,7 +74,9 @@ (print "\\vskip1em") (newline) (define colnames - '((id) Nick "Jméno" "Příjmení" (Fee) (Bilance) ("\\begin{minipage}{15mm}\\begin{center}Aktivní\\\\Měsíce\\end{center}\\end{minipage}") OK? Podpis)) + '((id) Nick "Jméno" "Příjmení" (Fee) (Bilance) + ("\\raisebox{2pt}{\\begin{minipage}{15mm}\\begin{center}Aktivní\\\\Měsíce\\end{center}\\end{minipage}}") + ((Hlas?)) Podpis)) (print "\\renewcommand\\arraystretch{2.1}") (print (format @@ -83,7 +85,10 @@ (map (lambda (x) (if (list? x) - "r" "l")) + (if (list? (car x)) + "c" + "r") + "l")) colnames) "|"))) (print "\\hline") @@ -99,7 +104,9 @@ x (if (string? (car x)) (car x) - (symbol->string (car x))))))) + (if (list? (car x)) + (symbol->string (caar x)) + (symbol->string (car x)))))))) colnames) "&") "\\\\") @@ -163,43 +170,43 @@ (string-translate* (brmember-nick mr) '(("_" . "\\_"))) - " & " + " & \\small " fname - " & " + " & \\small " sname " & " current-fee " & " - "\\begin{minipage}{15mm}\\begin{flushright}" + "\\raisebox{2pt}{\\begin{minipage}{15mm}\\begin{flushright}" (format-amount-tex (member-total-balance mr)) "\\\\" (if balance-ok? "Bez~dluhu" "---~~~~~~") - "\\end{flushright}\\end{minipage}" + "\\end{flushright}\\end{minipage}}" " & " ;(if balance-ok? ; "Y" ; "--") ;" & " - "\\begin{minipage}{12mm}\\begin{center}" + "\\raisebox{2pt}{\\begin{minipage}{12mm}\\begin{center}" numactive "/" 12 "\\\\" (if active-ok? "Splněno" "\\phantom{Sp}---\\phantom{Sp}") - "\\end{center}\\end{minipage}" + "\\end{center}\\end{minipage}}" " & " ;(if active-ok? ; "Y" ; "--") ;" & " (if vote-ok? - "Y" + "Ano" "--") " & " - "~\\hskip24mm~" + "~\\hskip28mm~" " \\\\") (print "\\hline") (loop (cdr mrs))))) From fa8466cfffa7f842599983fa61070d80ada1690d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 2 Jan 2025 20:42:29 +0100 Subject: [PATCH 84/95] Fix typo prolems. --- src/members-print.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/members-print.scm b/src/members-print.scm index 4d5b2dd..e8b6720 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -380,7 +380,7 @@ (members-table-row (ansi #:magenta #:bold) "Expire Soon:" soon-expire-mrs "~N (~S)")) (members-pred-table-row mb - (ansi-string #:red #:bold "Prolems:") + (ansi-string #:red #:bold "Problems:") brmember-has-problems? "~N~E ~A") (if (null? debtor-mrs) From 5052a8d46f9af2e8ef19491ca1df5097a1a81c84 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 2 Jan 2025 20:45:33 +0100 Subject: [PATCH 85/95] Start work on changelog and banner for 1.18 version. --- CHANGELOG.md | 7 +++++++ src/texts.scm | 2 +- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 32d0c05..5a45faf 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,13 @@ ChangeLog ========= +1.18 +---- + +* fix typo in members-print +* create LaTeX source of general meeting attendance sheet +* add expected income, cash flow and average age to stats + 1.17 - released 2024-10-01 -------------------------- diff --git a/src/texts.scm b/src/texts.scm index 6771016..53073dd 100644 --- a/src/texts.scm +++ b/src/texts.scm @@ -39,7 +39,7 @@ (chicken format)) ;; Short banner - (define banner-line "HackerBase 1.17 (c) 2023-2024 Brmlab, z.s.") + (define banner-line "HackerBase 1.18-dev (c) 2023-2024 Brmlab, z.s.") ;; Banner source with numbers for ANSI CSI SGR (define banner-source " From 826a5f1070202118717d977259dd52aea6a24922 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 2 Jan 2025 20:50:50 +0100 Subject: [PATCH 86/95] Update copyright years. --- src/texts.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/texts.scm b/src/texts.scm index 53073dd..5e384b0 100644 --- a/src/texts.scm +++ b/src/texts.scm @@ -39,7 +39,7 @@ (chicken format)) ;; Short banner - (define banner-line "HackerBase 1.18-dev (c) 2023-2024 Brmlab, z.s.") + (define banner-line "HackerBase 1.18-dev (c) 2023-2025 Brmlab, z.s.") ;; Banner source with numbers for ANSI CSI SGR (define banner-source " From 306b9cb20e20f14dca56be1e0ae8338ae1a19a02 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 3 Jan 2025 11:00:44 +0100 Subject: [PATCH 87/95] Initial import of QR payment implementation. --- src/Makefile | 10 ++++-- src/qr-payment.scm | 76 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 84 insertions(+), 2 deletions(-) create mode 100644 src/qr-payment.scm diff --git a/src/Makefile b/src/Makefile index 827b386..5d5cae0 100644 --- a/src/Makefile +++ b/src/Makefile @@ -43,7 +43,8 @@ HACKERBASE-DEPS=hackerbase.scm cal-month.import.scm \ progress.import.scm cal-period.import.scm \ util-stdout.import.scm export-web-static.import.scm \ dokuwiki.import.scm mailinglist.import.scm \ - export-sheet.import.scm mbase-query.import.scm + export-sheet.import.scm mbase-query.import.scm \ + qr-payment.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 \ @@ -61,7 +62,7 @@ HACKERBASE-OBJS=hackerbase.o testing.o listing.o cal-month.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 \ - mailinglist.o export-sheet.o mbase-query.o + mailinglist.o export-sheet.o mbase-query.o qr-payment.o GENDOC-SOURCES=gendoc.scm duck-extract.import.scm \ util-time.import.scm util-csv.import.scm util-git.import.scm \ @@ -577,3 +578,8 @@ MBASE-QUERY-SOURCES=mbase-query.scm mbase.import.scm \ mbase-query.o: mbase-query.import.scm mbase-query.import.scm: $(MBASE-QUERY-SOURCES) + +QR-PAYMENT-SOURCES=qr-payment.scm + +qr-payment.o: qr-payment.import.scm +qr-payment.import.scm: $(QR-PAYMENT-SOURCES) diff --git a/src/qr-payment.scm b/src/qr-payment.scm new file mode 100644 index 0000000..ed59c4f --- /dev/null +++ b/src/qr-payment.scm @@ -0,0 +1,76 @@ +;; +;; qr-payment.scm +;; +;; QR payment generator. +;; +;; ISC License +;; +;; Copyright 2023-2025 Brmlab, z.s. +;; Dominik Pantůček +;; +;; 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 qr-payment)) + +(module + qr-payment + ( + make-qrp + make-brmlab-qrp + ) + + (import scheme + (chicken format) + (chicken string) + (chicken base)) + + (define (make-empty-qrp . vs) + (let ((v (if (null? vs) "1.0" (car vs)))) + (list v "SPD"))) + + (define (add-field-to-qrp qrp key value) + (cons (format "~A:~A" key value) + qrp)) + + (define (serialize-qrp qrp) + (string-intersperse (reverse qrp) "*")) + + (define (ensure-amount-format amt) + (if (string? amt) + amt + amt)) + + (define (make-qrp iban amt cc vs msg) + (let loop ((keys '(ACC AM CC MSG X-CS)) + (vals (list iban (ensure-amount-format amt) cc msg vs)) + (qrp (make-empty-qrp))) + (if (null? keys) + (serialize-qrp qrp) + (loop (cdr keys) + (cdr vals) + (add-field-to-qrp qrp (car keys) (car vals)))))) + + (define (make-brmlab-qrp amt cc vs) + (let ((iban (if (equal? cc "CZK") + "CZ0520100000002500079551" + (if (equal? cc "EUR") + "CZ9320100000002100079552" + (error "Invalid currency!"))))) + (make-qrp iban amt cc vs "Brmlab"))) + + (print (make-brmlab-qrp 1000 "CZK" 1234)) + + ) From bbbc6527a0fec3330092a7f044009863913be29e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 3 Jan 2025 11:34:18 +0100 Subject: [PATCH 88/95] Ensure proper amount format and prepare for generating QR code. --- src/qr-payment.scm | 25 +++++++++++++++++++++---- 1 file changed, 21 insertions(+), 4 deletions(-) diff --git a/src/qr-payment.scm b/src/qr-payment.scm index ed59c4f..be79b50 100644 --- a/src/qr-payment.scm +++ b/src/qr-payment.scm @@ -30,6 +30,7 @@ ( make-qrp make-brmlab-qrp + make-brmlab-qrp-svg-string ) (import scheme @@ -49,9 +50,19 @@ (string-intersperse (reverse qrp) "*")) (define (ensure-amount-format amt) - (if (string? amt) - amt - amt)) + (let* ((n (if (string? amt) + (string->number amt) + amt)) + (s (number->string n)) + (f (string-split str ".")) + (i? (null? (cdr f)))) + (format "~A.~A" + (car f) + (if i? + ".00" + (substring + (string-append (cadr f) "0") + 0 2))))) (define (make-qrp iban amt cc vs msg) (let loop ((keys '(ACC AM CC MSG X-CS)) @@ -71,6 +82,12 @@ (error "Invalid currency!"))))) (make-qrp iban amt cc vs "Brmlab"))) - (print (make-brmlab-qrp 1000 "CZK" 1234)) + (define (qrp-create-svg-string qrps) + ;; qrencode -t svg -o - -l M + "TODO") + + (define (make-brmlab-qrp-svg-string amt cc vs) + (qrp-create-svg-string + (make-brmlab-qrp amt cc vs))) ) From 4d73afe3c5aee4c75c7eef286c7cc1cb8ce3cb17 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 3 Jan 2025 16:56:59 +0100 Subject: [PATCH 89/95] Preliminary QR code embedding. --- src/Makefile | 5 +++-- src/export-web-static.scm | 11 ++++++++++- src/qr-payment.scm | 21 ++++++++++++++++----- 3 files changed, 29 insertions(+), 8 deletions(-) diff --git a/src/Makefile b/src/Makefile index 5d5cae0..6e6d80e 100644 --- a/src/Makefile +++ b/src/Makefile @@ -475,7 +475,8 @@ box-drawing.import.scm: $(BOX-DRAWING-SOURCES) EXPORT-WEB-STATIC-SOURCES=export-web-static.scm brmember.import.scm \ util-dir.import.scm mbase.import.scm \ members-payments.import.scm cal-day.import.scm \ - util-git.import.scm configuration.import.scm texts.import.scm + util-git.import.scm configuration.import.scm texts.import.scm \ + members-fees.import.scm qr-payment.import.scm export-web-static.o: export-web-static.import.scm export-web-static.import.scm: $(EXPORT-WEB-STATIC-SOURCES) @@ -579,7 +580,7 @@ MBASE-QUERY-SOURCES=mbase-query.scm mbase.import.scm \ mbase-query.o: mbase-query.import.scm mbase-query.import.scm: $(MBASE-QUERY-SOURCES) -QR-PAYMENT-SOURCES=qr-payment.scm +QR-PAYMENT-SOURCES=qr-payment.scm util-io.import.scm qr-payment.o: qr-payment.import.scm qr-payment.import.scm: $(QR-PAYMENT-SOURCES) diff --git a/src/export-web-static.scm b/src/export-web-static.scm index 4b0b15d..6ac3a3d 100644 --- a/src/export-web-static.scm +++ b/src/export-web-static.scm @@ -45,7 +45,9 @@ util-git configuration texts - logging) + logging + qr-payment + members-fees) ;; HTML entities (define (sanitize-html str) @@ -110,6 +112,13 @@ (print "") (print "") (print "
") + (let ((fee (member-calendar-entry->fee + (make-member-calendar-entry mr)))) + (print "Fee: " fee) + (print (make-brmlab-qrp-svg-string + fee "CZK" (brmember-id mr)))) + (print "
") + (print "
") (print "

Payments History

") (print "") (print "") diff --git a/src/qr-payment.scm b/src/qr-payment.scm index be79b50..0c28ac6 100644 --- a/src/qr-payment.scm +++ b/src/qr-payment.scm @@ -36,7 +36,8 @@ (import scheme (chicken format) (chicken string) - (chicken base)) + (chicken base) + util-io) (define (make-empty-qrp . vs) (let ((v (if (null? vs) "1.0" (car vs)))) @@ -54,7 +55,7 @@ (string->number amt) amt)) (s (number->string n)) - (f (string-split str ".")) + (f (string-split s ".")) (i? (null? (cdr f)))) (format "~A.~A" (car f) @@ -65,7 +66,7 @@ 0 2))))) (define (make-qrp iban amt cc vs msg) - (let loop ((keys '(ACC AM CC MSG X-CS)) + (let loop ((keys '(ACC AM CC MSG X-VS)) (vals (list iban (ensure-amount-format amt) cc msg vs)) (qrp (make-empty-qrp))) (if (null? keys) @@ -83,8 +84,18 @@ (make-qrp iban amt cc vs "Brmlab"))) (define (qrp-create-svg-string qrps) - ;; qrencode -t svg -o - -l M - "TODO") + (let-values + (((ec ol) + (get-process-exit+output-lines + "qrencode" + "-t" "svg" + "--inline" + "-o" "-" + "-l" "M" + qrps))) + (if (eq? ec 0) + (string-intersperse ol "\n") + #f))) (define (make-brmlab-qrp-svg-string amt cc vs) (qrp-create-svg-string From 17ce5cc1264115753332cebd3ab29d9c2ef3c995 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Fri, 3 Jan 2025 17:08:16 +0100 Subject: [PATCH 90/95] Finish QR code integration. --- src/export-web-static.scm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/export-web-static.scm b/src/export-web-static.scm index 6ac3a3d..6647104 100644 --- a/src/export-web-static.scm +++ b/src/export-web-static.scm @@ -90,6 +90,8 @@ (print "dd+dt,dd+dt+dd{border-top:1px solid #8cacbb}") (print "dd{grid-column:2/3;font-weight:bold;margin:0px;padding-left:16px}") (print "footer{background:#dee7ec;border-top:1px solid #8cacbb;padding:16px}") + (print ".qr svg{width:100%;height:auto;max-width:10cm}") + (print ".qr{text-align: center}") (print "") (print "") (print "") @@ -111,10 +113,10 @@ (print "
Account for Payments
(Účet pro platbu příspěvků)
CZK: 2500079551/2010
EUR: CZ93 2010 0000 0021 0007 9552
") (print "") (print "") - (print "
") + (print "
") (let ((fee (member-calendar-entry->fee (make-member-calendar-entry mr)))) - (print "Fee: " fee) + (print "

Payment of membership fee " fee " CZK
(Platba členského příspěvku)

") (print (make-brmlab-qrp-svg-string fee "CZK" (brmember-id mr)))) (print "
") From 1d523a0495827af2e641594fe54ffe8de5e14ee7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Sat, 4 Jan 2025 17:45:16 +0100 Subject: [PATCH 91/95] Prepare release 1.18. --- CHANGELOG.md | 5 +++-- src/texts.scm | 4 ++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 5a45faf..a5bfc54 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,12 +1,13 @@ ChangeLog ========= -1.18 ----- +1.18 - released 2025-01-06 +-------------------------- * fix typo in members-print * create LaTeX source of general meeting attendance sheet * add expected income, cash flow and average age to stats +* add QR code payment in CZK on members' payments pages' 1.17 - released 2024-10-01 -------------------------- diff --git a/src/texts.scm b/src/texts.scm index 5e384b0..2125a12 100644 --- a/src/texts.scm +++ b/src/texts.scm @@ -5,7 +5,7 @@ ;; ;; ISC License ;; -;; Copyright 2023 Brmlab, z.s. +;; Copyright 2023-2025 Brmlab, z.s. ;; Dominik Pantůček ;; ;; Permission to use, copy, modify, and/or distribute this software @@ -39,7 +39,7 @@ (chicken format)) ;; Short banner - (define banner-line "HackerBase 1.18-dev (c) 2023-2025 Brmlab, z.s.") + (define banner-line "HackerBase 1.18 (c) 2023-2025 Brmlab, z.s.") ;; Banner source with numbers for ANSI CSI SGR (define banner-source " From b324516514e9e3510f9ed35ed5d2bda6794cb08a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 7 Jan 2025 11:42:21 +0100 Subject: [PATCH 92/95] Fix amount formatting for QR code for integer amounts. --- src/qr-payment.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/qr-payment.scm b/src/qr-payment.scm index 0c28ac6..1550cdb 100644 --- a/src/qr-payment.scm +++ b/src/qr-payment.scm @@ -60,7 +60,7 @@ (format "~A.~A" (car f) (if i? - ".00" + "00" (substring (string-append (cadr f) "0") 0 2))))) From ac83dd9c72d32acc3b675a06dfaecaaa99f6075d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 30 Jan 2025 21:39:51 +0100 Subject: [PATCH 93/95] Remove nonexistent option from manpage. --- doc/hackerbase.1 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/doc/hackerbase.1 b/doc/hackerbase.1 index 27a71c2..531e4cb 100644 --- a/doc/hackerbase.1 +++ b/doc/hackerbase.1 @@ -273,10 +273,6 @@ Specify member by nickname. .B \-destroyed Show destroyed members in \fB-fees\fR action as well. -.TP -.B \-ml-all -Load all mailman list memberships to show them in members info. - .SH "FILES" All the information about members is stored in in members file in the From 9f5877d3f0199f8d8f8d22f7878ba0a8a535ca97 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Thu, 30 Jan 2025 21:42:28 +0100 Subject: [PATCH 94/95] Remove mailman2 support. --- src/Makefile | 16 ++------ src/mailman.scm | 18 +++----- src/mailman2.scm | 104 ----------------------------------------------- 3 files changed, 9 insertions(+), 129 deletions(-) delete mode 100644 src/mailman2.scm diff --git a/src/Makefile b/src/Makefile index 6e6d80e..8a9a50b 100644 --- a/src/Makefile +++ b/src/Makefile @@ -60,7 +60,7 @@ HACKERBASE-OBJS=hackerbase.o testing.o listing.o cal-month.o \ table-style.o sgr-state.o util-utf8.o sgr-cell.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 \ + util-bst-bdict.o util-bst-ldict.o util-bst-lset.o \ mailman-common.o mailman3.o mailman3-sql.o tiocgwinsz.o \ mailinglist.o export-sheet.o mbase-query.o qr-payment.o @@ -260,13 +260,6 @@ ENVIRONMENT-SOURCES=environment.scm ansi.import.scm environment.o: environment.import.scm environment.import.scm: $(ENVIRONMENT-SOURCES) -MAILMAN2-SOURCES=mailman2.scm util-bst-lset.import.scm \ - util-io.import.scm mailman-common.import.scm \ - configuration.import.scm - -mailman2.o: mailman2.import.scm -mailman2.import.scm: $(MAILMAN2-SOURCES) - UTIL-TIME-SOURCES=util-time.scm duck.import.scm util-time.o: util-time.import.scm @@ -527,10 +520,9 @@ UTIL-BST-LSET-SOURCES=util-bst-lset.scm util-bst.import.scm \ util-bst-lset.o: util-bst-lset.import.scm util-bst-lset.import.scm: $(UTIL-BST-LSET-SOURCES) -MAILMAN-SOURCES=mailman.scm mailman2.import.scm \ - mailman-common.import.scm util-bst-lset.import.scm \ - configuration.import.scm mailman3.import.scm \ - progress.import.scm +MAILMAN-SOURCES=mailman.scm mailman-common.import.scm \ + util-bst-lset.import.scm configuration.import.scm \ + mailman3.import.scm progress.import.scm mailman.o: mailman.import.scm mailman.import.scm: $(MAILMAN-SOURCES) diff --git a/src/mailman.scm b/src/mailman.scm index 29bd842..a8c9788 100644 --- a/src/mailman.scm +++ b/src/mailman.scm @@ -49,7 +49,6 @@ (import scheme (chicken base) (chicken module) - mailman2 mailman-common util-bst-lset configuration @@ -59,24 +58,17 @@ ;; Syntax for simplifying export of case-version procedures (define-syntax define-mailman-proc (syntax-rules () - ((_ name proc2) + ((_ name proc3) (begin (export name) (define (name . args) (case (*mailman-version*) - ((2) (apply proc2 args)))))) - ((_ name proc2 proc3) - (begin - (export name) - (define (name . args) - (case (*mailman-version*) - ((2) (apply proc2 args)) ((3) (apply proc3 args)))))))) (define-mailman-proc list-mailman-lists - list-mailman2-lists list-mailman3-lists) + list-mailman3-lists) (define-mailman-proc list-mailman-list-members - list-mailman2-list-members list-mailman3-list-members) + list-mailman3-list-members) ;; Loads a single mailman list as mailman structure, if ;; unsuccessfull, returns only a list with ML name and no member @@ -112,9 +104,9 @@ (assoc name lsts)) (define-mailman-proc add-email-to-mailman-list - add-email-to-mailman2-list add-email-to-mailman3-list) + add-email-to-mailman3-list) (define-mailman-proc remove-email-from-mailman-list - remove-email-from-mailman2-list remove-email-from-mailman3-list) + remove-email-from-mailman3-list) ;; Ensures given email is in given ML (define (mailman-ensure-member ml email) diff --git a/src/mailman2.scm b/src/mailman2.scm deleted file mode 100644 index 5825165..0000000 --- a/src/mailman2.scm +++ /dev/null @@ -1,104 +0,0 @@ -;; -;; mailman2.scm -;; -;; Mailman management interface - Mailman version 2.x support -;; -;; ISC License -;; -;; Copyright 2023 Brmlab, z.s. -;; Dominik Pantůček -;; -;; 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 mailman2)) - -(module - mailman2 - ( - list-mailman2-lists - list-mailman2-list-members - - add-email-to-mailman2-list - remove-email-from-mailman2-list - ) - - (import scheme - (chicken base) - (chicken pathname) - (chicken string) - (chicken sort) - (chicken format) - srfi-1 - util-bst-lset - util-io - mailman-common - configuration) - - ;; Returns full path to given mailman binary - (define (mailman-bin bin) - (make-pathname (*mailman2-bin*) bin)) - - ;; Mailman-specific process output lines capture - (define (get-mailman-output-lines bin . args) - (apply - get-process-output-lines - (mailman-bin bin) - args)) - - ;; Sends all lines to the process - (define (mailman-send/recv bin args . lines) - (apply - process-send/recv - (mailman-bin bin) - args - lines)) - - ;; Returns the list of available lists - (define (list-mailman2-lists) - (get-mailman-output-lines "list_lists" "-b")) - - ;; Returns the list of members of given list - (define (list-mailman2-list-members lst) - (sort - (get-mailman-output-lines "list_members" lst) - string-ci Date: Thu, 30 Jan 2025 21:43:04 +0100 Subject: [PATCH 95/95] Bump version to 1.19-dev. --- src/texts.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/texts.scm b/src/texts.scm index 2125a12..a3383c6 100644 --- a/src/texts.scm +++ b/src/texts.scm @@ -39,7 +39,7 @@ (chicken format)) ;; Short banner - (define banner-line "HackerBase 1.18 (c) 2023-2025 Brmlab, z.s.") + (define banner-line "HackerBase 1.19-dev (c) 2023-2025 Brmlab, z.s.") ;; Banner source with numbers for ANSI CSI SGR (define banner-source "
DateTypeCommentAmountCurrencyAmount [CZK]Balance