Fix missing licences and typos.

README.md

@@ -46,6 +46,7 @@ Features
   * computing member balance
 * generating static web output for member pages in dokuwiki
 * exporting brmdoor cards lists
+* synchronization of mailinglist subscriptions with member files
 
 Requirements
 ------------
@@ -59,6 +60,7 @@ Build requirements:
 * make (tested with GNU make)
 * Chicken eggs (chicken-install)
   * sqlite3
+  * srfi-1
 
 Runtime requirements:
 
@@ -70,6 +72,10 @@ Runtime requirements:
 Building
 --------
 
+All the eggs used are installed in the source tree using:
+
+    sh install-eggs.sh
+
 Building static binary:
 
     make static

doc/d-utils.md

@@ -388,6 +388,16 @@ quoted-printable sequences.
 Returns the ```str``` with all characters converted to upper case
 using ```char-upcase```. Does not work with UTF-8.
 
+### string-capitalize [procedure]
+
+    (string-capitalize str)
+
+* ```str``` - arbitrary string
+
+Returns the ```str``` with the first character converted to upper case
+using ```char-upcase``` and the remainder converted to lower case
+using ```char-downcase```. Does not work with UTF-8.
+
 ## util-mail [module]
 
     (import util-mail)

src/Makefile

@@ -59,7 +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
+	 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	\
@@ -68,14 +68,15 @@ GENDOC-SOURCES=gendoc.scm duck-extract.import.scm			\
 	util-format.import.scm util-tag.import.scm			\
 	util-string.import.scm util-bst.import.scm			\
 	util-bst-bdict.import.scm util-bst-ldict.import.scm		\
-	util-dir.import.scm util-utf8.import.scm
+	util-dir.import.scm util-utf8.import.scm util-mail.import.scm	\
+	util-bst-lset.import.scm
 
 GENDOC-OBJS=gendoc.o duck-extract.o util-time.o util-csv.o util-io.o	\
 	progress.o testing.o util-proc.o util-git.o util-io.o		\
 	util-stdout.o util-parser.o util-proc.o util-format.o		\
 	racket-kwargs.o util-bst-ldict.o util-tag.o duck.o		\
 	util-string.o util-bst.o util-bst-bdict.o util-bst-ldict.o	\
-	util-dir.o util-utf8.o
+	util-dir.o util-utf8.o util-bst-lset.o util-mail.o
 
 .PHONY: imports
 imports: $(HACKERBASE-DEPS)
@@ -205,7 +206,8 @@ MEMBERS-PRINT-SOURCES=members-print.scm util-bst-ldict.import.scm	\
 	bank-account.import.scm members-fees.import.scm			\
 	members-payments.import.scm brmember-format.import.scm		\
 	specification.import.scm cal-format.import.scm			\
-	util-git.import.scm racket-kwargs.import.scm
+	util-git.import.scm racket-kwargs.import.scm			\
+	tiocgwinsz.import.scm
 
 members-print.o: members-print.import.scm
 members-print.import.scm: $(MEMBERS-PRINT-SOURCES)
@@ -543,3 +545,8 @@ MAILMAN3-SQL-SOURCES=mailman3-sql.scm configuration.import.scm
 
 mailman3-sql.o: mailman3-sql.import.scm
 mailman3-sql.import.scm: $(MAILMAN3-SQL-SOURCES)
+
+TIOCGWINSZ-SOURCES=tiocgwinsz.scm duck.import.scm
+
+tiocgwinsz.o: tiocgwinsz.import.scm
+tiocgwinsz.import.scm: $(TIOCGWINSZ-SOURCES)

src/configuration.scm

@@ -1,5 +1,5 @@
 ;;
-;; configuraiton.scm
+;; configuration.scm
 ;;
 ;; Configuration parameters used by various modules.
 ;;

src/gendoc.scm

@@ -1,3 +1,27 @@
+;;
+;; gendoc.scm
+;;
+;; Generate documentation for all documented modules dynamically.
+;;
+;; ISC License
+;;
+;; Copyright 2023 Brmlab, z.s.
+;; Dominik Pantůček <dominik.pantucek@trustica.cz>
+;;
+;; 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.
+;;
 
 (import duck-extract)
 

src/hackerbase.scm

@@ -62,6 +62,7 @@
 (define -web-dir- (make-parameter #f))
 (define -normal-month- (make-parameter #t))
 (define -show-destroyed- (make-parameter #f))
+(define -show-only-active- (make-parameter #f))
 (define -notify-months- (make-parameter 1))
 (define -send-emails- (make-parameter #f))
 
@@ -137,6 +138,8 @@
  "Misc options:"
  (-destroyed () "Show destroyed members in -fees"
 	     (-show-destroyed- #t))
+ (-only-active () "Show only active members in -fees"
+	       (-show-only-active- #t))
  ""
  "Base Actions:"
  (-info () "Print information"
@@ -372,7 +375,7 @@
    (newline)
    (if mr
        (print-member-balances-table mr)
-       (print-members-fees-table MB (-show-destroyed-))))
+       (print-members-fees-table MB (-show-destroyed-) (-show-only-active-))))
   ((repl)
    (repl))
   ((genweb)
@@ -406,7 +409,7 @@
      (if (null? nmembers)
 	 (print "Everyone paid on time.")
 	 (let ()
-	   (print "Notify" (-notify-months-))
+	   (stdout-print "Notify" (-notify-months-))
 	   (let loop ((lst nmembers))
 	     (when (and (not (null? lst))
 			(or (not mr)

src/mailman3-sql.scm

@@ -45,7 +45,11 @@
  ;; Returns (possibly cached) SQLite3 DB handle
  (define (mailman3-db)
    (when (not (*cached-mailman3-db*))
-     (*cached-mailman3-db* (open-database (*mailman3-sql-path*))))
+     (*cached-mailman3-db*
+      (let ((handler (make-busy-timeout 2000)))
+	(let ((db (open-database (*mailman3-sql-path*))))
+	  (set-busy-handler! db handler)
+	  db))))
    (*cached-mailman3-db*))
 
  ;; Returns the list of mailman3 mailinglists by querying te

src/members-payments.scm

@@ -77,13 +77,25 @@
 	       (string->number
 		(bank-transaction-varsym transaction)))
 	      (varsym-id
-	       (or varsym-id0
+	       (if (and varsym-id0
+			(> varsym-id0 1000))
+		   varsym-id0
 		   (let* ((msg (bank-transaction-message transaction))
-			  (ci (substring-index "," msg))
+			  (ci1 (substring-index "," msg))
-			  (vs (if ci
+			  (vs1 (if ci1
-				  (substring msg 0 ci)
+				   (substring msg 0 ci1)
+				   msg))
+			  (ci2 (substring-index " " msg))
+			  (vs2 (if ci2
+				   (substring msg 0 ci2)
+				   msg))
+			  (ci3 (substring-index "NULL" msg))
+			  (vs3 (if ci3
+				   (substring msg (+ ci3 4) (+ ci3 4 4))
 				   msg)))
-		     (string->number vs)))))
+		     (or (string->number vs1)
+			 (string->number vs2)
+			 (string->number vs3))))))
 	 varsym-id)))
 
  ;; Special comparator (originally with JendaSAP hack)

src/members-print.scm

@@ -67,7 +67,8 @@
 	 cal-format
 	 util-git
 	 cal-day
-	 racket-kwargs)
+	 racket-kwargs
+	 tiocgwinsz)
 
  (define *show-payments-count* (make-parameter 36))
 
@@ -267,11 +268,9 @@
  (define (members-table-row a:? label mrs fmt)
    (list (string-append "\t" a:? label)
 	 (length mrs)
-	 (ansi-paragraph-format
 	 (member-records->string
 	  (sort mrs brmember<?)
-	   fmt)
+	  fmt)))
-	  60)))
 
  ;; Generic table of members attributes
  (define (members-attrs-table mrs fmt hdr row)
@@ -301,6 +300,7 @@
 
  ;; Prints nicely aligned members base info
  (define (print-members-base-table mb)
+   (let-values (((rows columns) (term-size)))
      (let* ((total-count (length
 			  (find-members-by-predicate mb brmember-usable?)))
 	    (invalid-mrs (find-members-by-predicate
@@ -395,8 +395,8 @@
 	 #:border '(((#:bottom #:right light) ... (#:bottom light))
 		    ...
 		    ((#:right light) ... none))
-       #:width 70
+	 #:width (- columns 10)
-       #:ansi-reset? #t)))
+	 #:ansi-reset? #t))))
    (let ((pmrs (find-members-by-predicate mb brmember-file-has-problems?)))
      (when (not (null? pmrs))
        (newline)
@@ -471,10 +471,14 @@
 	      ")"))))
 
  ;; Prints summary table of all fees and credits for all members
- (define (print-members-fees-table MB . ds)
+ (define (print-members-fees-table MB . dsa)
-   (let ((destroyed? (if (null? ds)
+   (let ((destroyed? (if (null? dsa)
 			 #f
-			 (car ds))))
+			 (car dsa)))
+	 (only-active? (if (or (null? dsa)
+			       (null? (cdr dsa)))
+			   #f
+			   (cadr dsa))))
      (let* ((members ;; Pass 1
 	     (map
 	      (lambda (mr)
@@ -500,8 +504,11 @@
 	      (sort
 	       (if destroyed?
 		   (find-members-by-predicate MB (lambda x #t))
+		   (if only-active?
 		       (find-members-by-predicate MB (lambda (mr)
-						   (not (brmember-destroyed? mr)))))
+						       (brmember-active? mr)))
+		       (find-members-by-predicate MB (lambda (mr)
+						       (not (brmember-destroyed? mr))))))
 	       brmember<?)))
 	    (balances (map (lambda (m)
 			     (list-ref m 6))

src/notifications.scm

@@ -227,11 +227,39 @@
 		 #:border '(((#:bottom #:right light) ... (#:bottom light))
 			    ((#:right light) ... none)
 			    ...)
-		 )))))
+		 ))))
+	  (dwpu (filter (lambda (dwu)
+			  (or (member "member" (list-ref dwu 3))
+			      (member "council" (list-ref dwu 3))
+			      (member "admin" (list-ref dwu 3))))
+			(ldict-ref mb 'dokuwiki)))
+	  (dw-lst
+	   (if (null? dwpu)
+	       '()
+	       (list ""
+		     "DokuWiki users (non-members) in wrong group(s):"
+		     (string-append
+		      "  "
+		      (string-intersperse
+		       (map car dwpu)
+		       ", ")))))
+	  (dwmu (find-members-by-predicate mb (compose not brmember-dokuwiki-groups-ok?)))
+	  (dw2-lst
+	   (if (null? dwmu)
+	       '()
+	       (list ""
+		     "Members in wrong dokuwiki group(s):"
+		     (string-append
+		      "  "
+		      (string-intersperse
+		       (map brmember-nick dwmu)
+		       ", "))))))
      (append income-lst
 	     unpaired-lst
 	     debtors-lst
 	     boring-lst
+	     dw-lst
+	     dw2-lst
 	     (list ""
 		   "--"
 		   "Brmlab Hackerspace Members Database"

src/texts.scm

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

src/tiocgwinsz.scm

@@ -0,0 +1,63 @@
+;;
+;; tiocgwinsz.scm
+;;
+;; Get size of current terminal.
+;;
+;; ISC License
+;;
+;; Copyright 2023 Brmlab, z.s.
+;; Dominik Pantůček <dominik.pantucek@trustica.cz>
+;;
+;; 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 tiocgwinsz))
+
+(import duck)
+
+(foreign-declare "#include <sys/ioctl.h>")
+
+(module*
+ tiocgwinsz
+ #:doc ("TTY terminal size support.")
+ (
+  term-size
+  )
+
+ (import scheme
+	 (chicken foreign)
+	 (chicken bitwise))
+
+ (define tiocgwinsz-ioctl
+   (foreign-lambda*
+    int ()
+    "
+struct winsize wss;
+if (ioctl(0, TIOCGWINSZ, &wss) == 0) {
+  C_return(wss.ws_row*65536+wss.ws_col);
+} else {
+  C_return(0);
+}
+"
+    ))
+
+ (define/doc (term-size)
+   ("Returns the number of terminal rows and columns.")
+   (let ((res (tiocgwinsz-ioctl)))
+     (values 
+      (arithmetic-shift res -16)
+      (bitwise-and res #xffff))))
+
+ )

src/util-bst-bdict.scm

@@ -1,3 +1,27 @@
+;;
+;; util-bst-bdict.scm
+;;
+;; BST-based number dictionary.
+;;
+;; ISC License
+;;
+;; Copyright 2023 Brmlab, z.s.
+;; Dominik Pantůček <dominik.pantucek@trustica.cz>
+;;
+;; 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 util-bst-bdict))
 

src/util-bst-ldict.scm

@@ -1,3 +1,27 @@
+;;
+;; util-bst-ldict.scm
+;;
+;; BST-based symbol dictionary.
+;;
+;; ISC License
+;;
+;; Copyright 2023 Brmlab, z.s.
+;; Dominik Pantůček <dominik.pantucek@trustica.cz>
+;;
+;; 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 util-bst-ldict))
 

src/util-bst-lset.scm

@@ -1,3 +1,27 @@
+;;
+;; util-bst-lset.scm
+;;
+;; BST-based set implementation.
+;;
+;; ISC License
+;;
+;; Copyright 2023 Brmlab, z.s.
+;; Dominik Pantůček <dominik.pantucek@trustica.cz>
+;;
+;; 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 util-bst-lset))
 

src/util-bst.scm

@@ -1,3 +1,27 @@
+;;
+;; util-bst.scm
+;;
+;; Underlying BST implementation for sets and dictionaries.
+;;
+;; ISC License
+;;
+;; Copyright 2023 Brmlab, z.s.
+;; Dominik Pantůček <dominik.pantucek@trustica.cz>
+;;
+;; 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 util-bst))