diff --git a/CHANGELOG.md b/CHANGELOG.md index 03cbc12..6c593ff 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,41 +1,14 @@ ChangeLog ========= -1.16.2 - released 2024-05-07 ----------------------------- - -* fix rada-ml-pred? in -mlsync - -1.16.1 - released 2024-04-02 ----------------------------- - -* add EUR account for paying membership fees to member's page - -1.16 - released 2024-02-09 --------------------------- - -* 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 -* report soon-expiring members in the summary emails -* report mailing lists check status in summary emails - -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 - released 2024-12-24 --------------------------- +1.15 +---- * 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 +---- * add support for dynamic terminal size * use table cell formatting instead of paragraph formatting everywhere diff --git a/src/Makefile b/src/Makefile index 010c646..c71d1ff 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 mailinglist.import.scm + dokuwiki.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,8 +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 tiocgwinsz.o \ - mailinglist.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 \ @@ -292,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 racket-kwargs.import.scm + duck.import.scm util-parser.o: util-parser.import.scm util-parser.import.scm: $(UTIL-PARSER-SOURCES) @@ -333,8 +332,7 @@ 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 \ - mailinglist.import.scm + bank-account.import.scm logging.import.scm notifications.o: notifications.import.scm notifications.import.scm: $(NOTIFICATIONS-SOURCES) @@ -552,10 +550,3 @@ 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 \ - brmember.import.scm - -mailinglist.o: mailinglist.import.scm -mailinglist.import.scm: $(MAILINGLIST-SOURCES) diff --git a/src/brmember.scm b/src/brmember.scm index e83c9dd..fb9e07e 100644 --- a/src/brmember.scm +++ b/src/brmember.scm @@ -499,8 +499,8 @@ (ldict-equal? (make-brmember '|1234| "members/1234" '(|member|)) (make-ldict - `((TAG . ,TAG-BRMEMBER) - (file-name . |1234|) + `((file-name . |1234|) + (TAG . ,TAG-BRMEMBER) (file-path . "members/1234") (symlinks |member|) (id . 1234))))) diff --git a/src/dokuwiki.scm b/src/dokuwiki.scm index 40c2585..db944ce 100644 --- a/src/dokuwiki.scm +++ b/src/dokuwiki.scm @@ -54,7 +54,7 @@ (users '())) (if (null? lines) users - (let ((line (parser-preprocess-line (car lines) #:strip-comments? #f))) + (let ((line (parser-preprocess-line (car lines)))) (if (equal? line "") (loop (cdr lines) users) @@ -74,8 +74,8 @@ (handle-exceptions exn (let () - (log-warning "DokuWiki (~A) exception ~A" fname (condition->list exn)) - (stdout-printf "DokuWiki (~A) exception ~A" fname (condition->list exn)) + (log-warning "DokuWiki: cannot open ~A" fname) + (stdout-printf "DokuWiki: cannot open ~A" fname) '()) (with-input-from-file fname parse-dokuwiki-users-auth))) diff --git a/src/export-web-static.scm b/src/export-web-static.scm index 8ed8abc..fb2bed2 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ů)
CZK: 2500079551/2010
EUR: CZ93 2010 0000 0021 0007 9552
") + (print "
Account for Payments
(Účet pro platbu příspěvků)
2500079551/2010
") (print "") (print "") (print "
") diff --git a/src/hackerbase.scm b/src/hackerbase.scm index 6579723..fcaa90a 100644 --- a/src/hackerbase.scm +++ b/src/hackerbase.scm @@ -50,8 +50,7 @@ export-web-static dokuwiki racket-kwargs - util-string - mailinglist) + util-string) ;; Command-line options and configurable parameters (define -needs-bank- (make-parameter #f)) @@ -287,6 +286,32 @@ (print " " (car keys) ": " (length (ldict-ref status (car keys))))) (loop (cdr keys))))))) +(define* (check-mailing-list mls name #:pred? (pred? #f)) + (define ml (find-mailman-list mls name)) + (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) + (brmember-chair? mr) + (brmember-revision? mr))) + ;; Perform requested action (case (-action-) ((print-info) @@ -298,7 +323,10 @@ (let () (print-members-base-table MB) (newline) - (print-mailing-list-checks MB MLS) + (check-mailing-list MLS "internal") + (check-mailing-list MLS "rada" + #:pred? rada-ml-pred?) + (check-mailing-list MLS "rk" #:pred? brmember-revision?) (print-git-status))) (newline)) ((print-stats) @@ -396,8 +424,8 @@ (print-git-status)) ((summary) (if (-send-emails-) - (make+send-summary-email MB MLS) - (make+print-summary-email MB MLS))) + (make+send-summary-email MB) + (make+print-summary-email MB))) ((list) (for-each (lambda (mr) (print (brmember-nick mr))) diff --git a/src/mailinglist.scm b/src/mailinglist.scm deleted file mode 100644 index 73f3e5b..0000000 --- a/src/mailinglist.scm +++ /dev/null @@ -1,78 +0,0 @@ -;; -;; 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 - print-mailing-list-checks - - rada-ml-pred? - ) - - (import scheme - (chicken base) - (chicken format) - racket-kwargs - mailman - mbase - util-string - brmember) - - (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)))))))) - - (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))) - - ) diff --git a/src/members-fees.scm b/src/members-fees.scm index 5a3b0c3..7fe3dc8 100644 --- a/src/members-fees.scm +++ b/src/members-fees.scm @@ -30,7 +30,6 @@ ( lookup-member-fee member-calendar - make-member-calendar-entry member-calendar-first-month member-calendar-last-month member-calendar-query @@ -41,14 +40,12 @@ 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 @@ -85,17 +82,15 @@ (if (cal-month>? cm last-month) (reverse cal) (loop (cal-month-add cm) - (cons (with-current-month - cm - (make-member-calendar-entry mr)) + (cons (list cm + (with-current-month + cm + (brmember-flags mr)) + (with-current-month + cm + (brmember-spec-fee 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)) @@ -207,26 +202,5 @@ (+ (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 2591238..fad53e6 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -500,17 +500,7 @@ (null? (cdr dsa))) #f (cadr dsa)))) - (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)))))) - brmemberlists chars) ("The same as above but accepts a list of bytes (as integers).") (let loop ((bytes chars) - (rpending chars) + (rpending '()) (pending 0) (expected #f) (res '())) (if (null? bytes) (values (reverse res) - rpending) + (reverse 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) - rpending + (cons byte 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 #b11100000) #b11000000) + (cond ((= (bitwise-and byte #b11000000) #b11000000) (values (bitwise-and byte #b11111) 2)) - ((= (bitwise-and byte #b11110000) #b11100000) + ((= (bitwise-and byte #b11100000) #b11100000) (values (bitwise-and byte #b1111) 3)) - ((= (bitwise-and byte #b11111000) #b11110000) + ((= (bitwise-and byte #b11110000) #b11110000) (values (bitwise-and byte #b111) 4)) (else ;; Should not happen (values 0 0))))) (loop (cdr bytes) - bytes + (list byte) (arithmetic-shift first-byte 6) (sub1 char-bytes) res))))))))))