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 01/26] 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 02/26] 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 03/26] 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 04/26] 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 05/26] 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 06/26] 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 07/26] 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 08/26] 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 09/26] 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 10/26] 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 11/26] 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 12/26] 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 13/26] 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 14/26] 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 15/26] 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 16/26] 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 17/26] 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 18/26] 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 19/26] 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 20/26] 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 21/26] 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 22/26] 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 23/26] 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 24/26] 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 25/26] 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 26/26] 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 "