diff --git a/CHANGELOG.md b/CHANGELOG.md
index 6c593ff..03cbc12 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,14 +1,41 @@
ChangeLog
=========
-1.15
-----
+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
+--------------------------
* 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
diff --git a/src/Makefile b/src/Makefile
index c71d1ff..010c646 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 \
@@ -291,7 +292,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)
@@ -332,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)
@@ -550,3 +552,10 @@ 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 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/dokuwiki.scm b/src/dokuwiki.scm
index db944ce..40c2585 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))))
+ (let ((line (parser-preprocess-line (car lines) #:strip-comments? #f)))
(if (equal? line "")
(loop (cdr lines)
users)
@@ -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 (condition->list exn))
+ (stdout-printf "DokuWiki (~A) exception ~A" fname (condition->list exn))
'())
(with-input-from-file fname
parse-dokuwiki-users-auth)))
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 "")
diff --git a/src/hackerbase.scm b/src/hackerbase.scm
index fcaa90a..6579723 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,32 +287,6 @@
(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)
@@ -323,10 +298,7 @@
(let ()
(print-members-base-table MB)
(newline)
- (check-mailing-list MLS "internal")
- (check-mailing-list MLS "rada"
- #:pred? rada-ml-pred?)
- (check-mailing-list MLS "rk" #:pred? brmember-revision?)
+ (print-mailing-list-checks MB MLS)
(print-git-status)))
(newline))
((print-stats)
@@ -424,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/mailinglist.scm b/src/mailinglist.scm
new file mode 100644
index 0000000..73f3e5b
--- /dev/null
+++ b/src/mailinglist.scm
@@ -0,0 +1,78 @@
+;;
+;; 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 7fe3dc8..5a3b0c3 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
@@ -40,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
@@ -82,15 +85,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))
@@ -202,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 fad53e6..2591238 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))))))
+ brmemberlists 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))))))))))