Compare commits

..

No commits in common. "a86063e7221d998005e2764b01998430cc350922" and "8a3c81279793c8cb7a8d48f08e36feef41662022" have entirely different histories.

13 changed files with 69 additions and 108 deletions

View file

@ -1,15 +1,6 @@
ChangeLog ChangeLog
========= =========
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 1.16.2 - released 2024-05-07
---------------------------- ----------------------------
@ -37,13 +28,13 @@ ChangeLog
current date) current date)
* fix showing basic information without MLs loaded * fix showing basic information without MLs loaded
1.15 - released 2023-12-24 1.15 - released 2024-12-24
-------------------------- --------------------------
* increase membership fees starting 2024-01 (specification.rkt) * increase membership fees starting 2024-01 (specification.rkt)
* add support for explicit fee amounts for specified period * add support for explicit fee amounts for specified period
1.14 - released 2023-12-06 1.14 - released 2024-12-06
-------------------------- --------------------------
* add support for dynamic terminal size * add support for dynamic terminal size
@ -51,14 +42,14 @@ ChangeLog
* fix sqlite3 database locking issue * fix sqlite3 database locking issue
* allow limiting -fees output to -active only * allow limiting -fees output to -active only
1.13 - released 2023-12-05 1.13
-------------------------- ----
* add dokuwiki problems to summary emails * add dokuwiki problems to summary emails
* handle more SEPA payments * handle more SEPA payments
1.12 - released 2023-11-16 1.12
-------------------------- ----
* switch to eggs: srfi-1, sqlite3 * switch to eggs: srfi-1, sqlite3
* semi-automatic export for brmdoor * semi-automatic export for brmdoor
@ -66,100 +57,83 @@ ChangeLog
* redirect dokuwiki plugin to login page if not logged in * redirect dokuwiki plugin to login page if not logged in
* sync council and revision mailing lists * sync council and revision mailing lists
1.11 - released 2023-09-23 1.11
-------------------------- ----
* add support for CC in emails * add support for CC in emails
* update manual page * update manual page
* setup new cron jobs * setup new cron jobs
1.10 - released 2023-09-17 1.10
-------------------------- ----
* direct access of mailman 3 database * direct access of mailman 3 database
1.9 - released 2023-09-16 1.9
------------------------- ---
* implement support for mailman 3 * implement support for mailman 3
* add total debt to long-term debtors listings * add total debt to long-term debtors listings
1.8 - released 2023-07-29 1.8
------------------------ ---
* remove old compatibility static web pages generator * remove old compatibility static web pages generator
* update documentation * update documentation
* update Fio fetcher to handle new limits imposed by the bank * update Fio fetcher to handle new limits imposed by the bank
* output plain list of active members (used by BrmBar project) * output plain list of active members (used by BrmBar project)
1.7 - released 2023-07-04 1.7
------------------------- ---
* include current month in stats * include current month in stats
* right-alignment in table cells * right-alignment in table cells
* functionality improvements of dokuwiki plugin * functionality improvements of dokuwiki plugin
* checking council group between dokuwiki and members database * checking council group between dokuwiki and members database
1.6.2 - released 2023-06-29 1.6
--------------------------- ---
* 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 * dokuwiki plugin
* delete generated files for destroyed members * delete generated files for destroyed members
* verify dokuwiki users information * verify dokuwiki users information
1.5 - released 2023-06-19 1.5
------------------------- ---
* improved table renderer * improved table renderer
* show membership fees and payments balances history * show membership fees and payments balances history
* improved generator of static web pages * improved generator of static web pages
1.4 - released 2023-05-26 1.4
------------------------- ---
* vim and joe syntax highlighting support * vim and joe syntax highlighting support
* improved Fio bank statement fetcher and merger * improved Fio bank statement fetcher and merger
1.3 - released 2023-05-22 1.3
------------------------- ---
* organizational bodies membership * organizational bodies membership
1.2.1 - released 2023-05-19 1.2
--------------------------- ---
* fix email string argument passing
* use bi-directional mailman communication
1.2 - released 2023-05-19
-------------------------
* split configuration and action command-line options * split configuration and action command-line options
* support for git annotate * support for git annotate
* show suspended members that are about to expire * show suspended members that are about to expire
* optimized utf-8 support * optimized utf-8 support
1.1 - released 2023-05-14 1.1
------------------------- ---
* support for suppressing output (used in cron jobs) * support for suppressing output (used in cron jobs)
* sorted members in notifications * sorted members in notifications
* report missing keys in member files * report missing keys in member files
* internal ML membership synchronization * internal ML membership synchronization
1.0 - released 2023-04-23 1.0
------------------------- ---
This was the first oficially released version which contains all the This was the first oficially released version which contains all the
functionality required to take over the original solution. functionality required to take over the original solution.

View file

@ -9,7 +9,7 @@ License
ISC License ISC License
Copyright 2023-2024 Brmlab, z.s. Copyright 2023 Brmlab, z.s.
Dominik Pantůček <dominik.pantucek@trustica.cz> Dominik Pantůček <dominik.pantucek@trustica.cz>
Permission to use, copy, modify, and/or distribute this software Permission to use, copy, modify, and/or distribute this software

View file

@ -423,8 +423,7 @@
(if (brmember-suspended? mr) (if (brmember-suspended? mr)
(let ((period (cal-periods-match (brmember-info mr 'suspend)))) (let ((period (cal-periods-match (brmember-info mr 'suspend))))
(if period (if period
(cal-month-diff (cal-ensure-month (cal-period-since period)) (cal-month-diff (cal-period-since period) (*current-month*))
(*current-month*))
0)) 0))
0)) 0))

View file

@ -135,12 +135,18 @@
res)))))) res))))))
(define (print-duck-signature sig) (define (print-duck-signature sig)
;;(print sig)
(let* ((curry-depth (get-curry-depth sig)) (let* ((curry-depth (get-curry-depth sig))
(name (get-signature-name sig)) (name (get-signature-name sig))
(nameline (format " ~A~A" (make-string curry-depth #\() name)) (nameline (format " ~A~A" (make-string curry-depth #\() name))
(spaceline (make-string (add1 (string-length nameline)) #\space)) (spaceline (make-string (add1 (string-length nameline)) #\space))
(args (gather-signature-arguments sig)) (args (gather-signature-arguments sig))
(eargs (expand-signature-arguments args))) (eargs (expand-signature-arguments args)))
;;(print " curry depth = " curry-depth)
;;(print " name = " name)
;;(print " args = " args)
;;(printf " eargs = ~S" eargs)
;;(newline)
(if (null? eargs) (if (null? eargs)
(print nameline ")") (print nameline ")")
(let loop ((args eargs) (let loop ((args eargs)

View file

@ -44,8 +44,7 @@
cal-day cal-day
util-git util-git
configuration configuration
texts texts)
logging)
;; HTML entities ;; HTML entities
(define (sanitize-html str) (define (sanitize-html str)
@ -101,11 +100,7 @@
(brmember-nick mr) "</dd>") (brmember-nick mr) "</dd>")
(print "<dt>Member ID, Variable Symbol for Payments<br>(Členské číslo, variabilní symbol plateb)</dt><dd>" (print "<dt>Member ID, Variable Symbol for Payments<br>(Členské číslo, variabilní symbol plateb)</dt><dd>"
(brmember-id mr) "</dd>") (brmember-id mr) "</dd>")
(print "<dt>Balance in CZK<br>(Zůstatek v Kč)</dt><dd>" (print "<dt>Balance in CZK<br>(Zůstatek v Kč)</dt><dd>" (caar (reverse bhs)) "</dd>")
(if (null? bhs)
"0"
(caar (reverse bhs)))
"</dd>")
(print "<dt>Account for Payments<br>(Účet pro platbu příspěvků)</dt><dd>CZK: 2500079551/2010<br>EUR: CZ93 2010 0000 0021 0007 9552</dd>") (print "<dt>Account for Payments<br>(Účet pro platbu příspěvků)</dt><dd>CZK: 2500079551/2010<br>EUR: CZ93 2010 0000 0021 0007 9552</dd>")
(print "</dl>") (print "</dl>")
(print "</div>") (print "</div>")

View file

@ -378,7 +378,7 @@
(print "Mailman synchronization disabled with manually specified current month.")))) (print "Mailman synchronization disabled with manually specified current month."))))
((notify) ((notify)
(let ((nmembers (members-to-notify MB (-notify-months-)))) (let ((nmembers (members-to-notify MB (-notify-months-))))
(stdout-newline) (newline)
(if (null? nmembers) (if (null? nmembers)
(print "Everyone paid on time.") (print "Everyone paid on time.")
(let () (let ()

View file

@ -129,6 +129,8 @@
(ptbl (table->string (ptbl (table->string
pdata pdata
#:border '(((#:right light) ... none) ...)))) #:border '(((#:right light) ... none) ...))))
;;(print pdata)
;;(write ptbl)(newline)
(list k ptbl))) (list k ptbl)))
((fee) ((fee)
(let* ((pdata (let* ((pdata
@ -148,6 +150,8 @@
(ptbl (table->string (ptbl (table->string
pdata pdata
#:border '(((#:right light) ... none) ...)))) #:border '(((#:right light) ... none) ...))))
;;(print pdata)
;;(write ptbl)(newline)
(list k ptbl))) (list k ptbl)))
(else (else
(if v (if v
@ -178,6 +182,7 @@
(list (list (ansi-string #:red "DokuWiki") (list (list (ansi-string #:red "DokuWiki")
(ansi-string #:red "---"))))) (ansi-string #:red "---")))))
(result (filter identity (append head body mailman dokuwiki)))) (result (filter identity (append head body mailman dokuwiki))))
;;(write result)(newline)
(table->string result (table->string result
#:border '(((#:bottom #:right light) ... (#:bottom light)) #:border '(((#:bottom #:right light) ... (#:bottom light))
... ...
@ -526,13 +531,6 @@
payment payment
total total
balance balance
(let ((spec-fee (brmember-spec-fee mr)))
(if spec-fee
spec-fee
(member-calendar-entry->fee
(list (*current-month*)
(brmember-flags mr)
spec-fee))))
))) )))
raw-members)) raw-members))
(balances (map (lambda (m) (balances (map (lambda (m)
@ -554,7 +552,8 @@
(let ((total (list-ref member 5))) (let ((total (list-ref member 5)))
(list (list-ref member 0) (list (list-ref member 0)
(list-ref member 1) (list-ref member 1)
(sprintf "\t~A" (list-ref member 7)) "---"
(sprintf "\t~A" (list-ref member 2)) (sprintf "\t~A" (list-ref member 2))
(sprintf "\t~A" (list-ref member 3)) (sprintf "\t~A" (list-ref member 3))
(sprintf "\t~A" (list-ref member 4)) (sprintf "\t~A" (list-ref member 4))
@ -571,11 +570,10 @@
(let* ((fees (foldl + 0 (map (lambda (b) (ldict-ref b 'fees)) balances))) (let* ((fees (foldl + 0 (map (lambda (b) (ldict-ref b 'fees)) balances)))
(credit (foldl + 0 (map (lambda (b) (ldict-ref b 'credit)) balances))) (credit (foldl + 0 (map (lambda (b) (ldict-ref b 'credit)) balances)))
(payment (foldl + 0 (map (lambda (b) (ldict-ref b 'payment)) 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") (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" fees))
(ansi-string "\t" #:bold (sprintf "~A" credit)) (ansi-string "\t" #:bold (sprintf "~A" credit))
(ansi-string "\t" #:bold (sprintf "~A" payment)) (ansi-string "\t" #:bold (sprintf "~A" payment))

View file

@ -167,7 +167,7 @@
brmember<?)) brmember<?))
(soonexps-lst (soonexps-lst
(if (null? soonexps) (if (null? soonexps)
'() #f
(list "" (list ""
(format "Expiring members (~A): ~A" (format "Expiring members (~A): ~A"
(length soonexps) (length soonexps)

View file

@ -366,6 +366,7 @@
slw)) slw))
state))) state)))
(let ((sln (sgr-list-neutralize sl))) (let ((sln (sgr-list-neutralize sl)))
;;(write sln)(newline)
(values (list sln) initial-state)))) (values (list sln) initial-state))))
;; Renders all the lines and appends the resulting blocks ;; Renders all the lines and appends the resulting blocks

View file

@ -204,6 +204,8 @@
(tbl1 (render-cells-widths ptbl col-widths)) (tbl1 (render-cells-widths ptbl col-widths))
;;(_ (print tbl1)) ;;(_ (print tbl1))
(tbl2 (map expand-row-height tbl1))) (tbl2 (map expand-row-height tbl1)))
;;(write tbl1)(newline)
;;(write tbl2)(newline)
;; Just return the result - both the table and cached column widths ;; Just return the result - both the table and cached column widths
(values tbl2 (values tbl2
col-widths)))) col-widths))))

View file

@ -88,6 +88,7 @@
(borders (expand-table-style border-spec num-columns num-rows)) (borders (expand-table-style border-spec num-columns num-rows))
(col-separators (table-col-separators? borders)) (col-separators (table-col-separators? borders))
(rows (merge-rows ptbl borders col-separators unicode?))) (rows (merge-rows ptbl borders col-separators unicode?)))
;;(write rows)(newline)
(let loop ((rows rows) (let loop ((rows rows)
(borders borders) (borders borders)
(res '()) (res '())

View file

@ -39,7 +39,7 @@
(chicken format)) (chicken format))
;; Short banner ;; Short banner
(define banner-line "HackerBase 1.17 (c) 2023-2024 Brmlab, z.s.") (define banner-line "HackerBase 1.16.2 (c) 2023-2024 Brmlab, z.s.")
;; Banner source with numbers for ANSI CSI SGR ;; Banner source with numbers for ANSI CSI SGR
(define banner-source " (define banner-source "

View file

@ -5,7 +5,7 @@
;; ;;
;; ISC License ;; ISC License
;; ;;
;; Copyright 2023-2024 Brmlab, z.s. ;; Copyright 2023 Brmlab, z.s.
;; Dominik Pantůček <dominik.pantucek@trustica.cz> ;; Dominik Pantůček <dominik.pantucek@trustica.cz>
;; ;;
;; Permission to use, copy, modify, and/or distribute this software ;; Permission to use, copy, modify, and/or distribute this software
@ -39,8 +39,6 @@
(chicken base) (chicken base)
(chicken keyword) (chicken keyword)
(chicken string) (chicken string)
(chicken irregex)
(chicken format)
util-io util-io
util-utf8 util-utf8
util-string util-string
@ -63,14 +61,6 @@ sent to the address stored within.")
"?=") "?=")
subj)) 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. ;; Sends an email using the UNIX mail(1) utility.
(define*/doc (send-mail body-lines (define*/doc (send-mail body-lines
#:from (from #f) #:from (from #f)
@ -93,22 +83,17 @@ Sends email using mail(1) command. The arguments ```#:to``` and
tos)) tos))
(header-args (header-args
(flatten (flatten
(append
(if from (list (sprintf "From: ~A" from)) '())
(map (map
(lambda (h) (list "-a" h)) (lambda (h) (list "-a" h))
headers))))) headers))))
(let ((from-email (if from
(extract-email-email from)
#f)))
(apply process-send/recv (apply process-send/recv
"mail" "mail"
(append (if from (append (if from
(list "-r" from-email) (list "-r" from)
'()) '())
(list "-s" (encode-subject subject)) (list "-s" (encode-subject subject))
real-tos real-tos
header-args) header-args)
body-lines)))) body-lines)))
) )