Release 1.17.

This reverts commit 488499cf23.

CHANGELOG.md

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

README.md

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

src/brmember.scm

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

src/duck-extract.scm

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

src/export-web-static.scm

@@ -44,7 +44,8 @@
 	 cal-day
 	 util-git
 	 configuration
-	 texts)
+	 texts
+	 logging)
 
  ;; HTML entities
  (define (sanitize-html str)
@@ -100,7 +101,11 @@
 	    (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>" (caar (reverse bhs)) "</dd>")
+     (print "<dt>Balance in CZK<br>(Zůstatek v Kč)</dt><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 "</dl>")
      (print "</div>")

src/hackerbase.scm

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

src/members-print.scm

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

src/notifications.scm

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

src/sgr-block.scm

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

src/table-processor.scm

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

src/table.scm

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

src/texts.scm

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

src/util-mail.scm

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