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
=========
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
----------------------------
@ -37,13 +28,13 @@ ChangeLog
current date)
* 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)
* 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
@ -51,14 +42,14 @@ ChangeLog
* fix sqlite3 database locking issue
* allow limiting -fees output to -active only
1.13 - released 2023-12-05
--------------------------
1.13
----
* add dokuwiki problems to summary emails
* handle more SEPA payments
1.12 - released 2023-11-16
--------------------------
1.12
----
* switch to eggs: srfi-1, sqlite3
* semi-automatic export for brmdoor
@ -66,100 +57,83 @@ ChangeLog
* redirect dokuwiki plugin to login page if not logged in
* sync council and revision mailing lists
1.11 - released 2023-09-23
--------------------------
1.11
----
* add support for CC in emails
* update manual page
* setup new cron jobs
1.10 - released 2023-09-17
--------------------------
1.10
----
* direct access of mailman 3 database
1.9 - released 2023-09-16
-------------------------
1.9
---
* implement support for mailman 3
* add total debt to long-term debtors listings
1.8 - released 2023-07-29
------------------------
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 - released 2023-07-04
-------------------------
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.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
-------------------------
1.6
---
* dokuwiki plugin
* delete generated files for destroyed members
* verify dokuwiki users information
1.5 - released 2023-06-19
-------------------------
1.5
---
* improved table renderer
* show membership fees and payments balances history
* improved generator of static web pages
1.4 - released 2023-05-26
-------------------------
1.4
---
* vim and joe syntax highlighting support
* improved Fio bank statement fetcher and merger
1.3 - released 2023-05-22
-------------------------
1.3
---
* organizational bodies membership
1.2.1 - released 2023-05-19
---------------------------
* fix email string argument passing
* use bi-directional mailman communication
1.2 - released 2023-05-19
-------------------------
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 - released 2023-05-14
-------------------------
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 - released 2023-04-23
-------------------------
1.0
---
This was the first oficially released version which contains all the
functionality required to take over the original solution.

View file

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

View file

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

View file

@ -135,12 +135,18 @@
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)

View file

@ -44,8 +44,7 @@
cal-day
util-git
configuration
texts
logging)
texts)
;; HTML entities
(define (sanitize-html str)
@ -101,11 +100,7 @@
(brmember-nick mr) "</dd>")
(print "<dt>Member ID, Variable Symbol for Payments<br>(Členské číslo, variabilní symbol plateb)</dt><dd>"
(brmember-id mr) "</dd>")
(print "<dt>Balance in CZK<br>(Zůstatek v Kč)</dt><dd>"
(if (null? bhs)
"0"
(caar (reverse bhs)))
"</dd>")
(print "<dt>Balance in CZK<br>(Zůstatek v Kč)</dt><dd>" (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 "</dl>")
(print "</div>")

View file

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

View file

@ -129,6 +129,8 @@
(ptbl (table->string
pdata
#:border '(((#:right light) ... none) ...))))
;;(print pdata)
;;(write ptbl)(newline)
(list k ptbl)))
((fee)
(let* ((pdata
@ -148,6 +150,8 @@
(ptbl (table->string
pdata
#:border '(((#:right light) ... none) ...))))
;;(print pdata)
;;(write ptbl)(newline)
(list k ptbl)))
(else
(if v
@ -178,6 +182,7 @@
(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))
...
@ -526,13 +531,6 @@
payment
total
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))
(balances (map (lambda (m)
@ -554,7 +552,8 @@
(let ((total (list-ref member 5)))
(list (list-ref member 0)
(list-ref member 1)
(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))
@ -571,11 +570,10 @@
(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))
(current-total (foldl + 0 (map (lambda (m) (list-ref m 7)) members))))
(total (- (+ credit payment) fees)))
(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))

View file

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

View file

@ -366,6 +366,7 @@
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

View file

@ -204,6 +204,8 @@
(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))))

View file

@ -88,6 +88,7 @@
(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 '())

View file

@ -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.16.2 (c) 2023-2024 Brmlab, z.s.")
;; Banner source with numbers for ANSI CSI SGR
(define banner-source "

View file

@ -5,7 +5,7 @@
;;
;; ISC License
;;
;; Copyright 2023-2024 Brmlab, z.s.
;; Copyright 2023 Brmlab, z.s.
;; Dominik Pantůček <dominik.pantucek@trustica.cz>
;;
;; Permission to use, copy, modify, and/or distribute this software
@ -39,8 +39,6 @@
(chicken base)
(chicken keyword)
(chicken string)
(chicken irregex)
(chicken format)
util-io
util-utf8
util-string
@ -63,14 +61,6 @@ 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)
@ -93,22 +83,17 @@ Sends email using mail(1) command. The arguments ```#:to``` and
tos))
(header-args
(flatten
(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))))
(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)))
)