diff --git a/README.md b/README.md index 9fcb37f..699ae82 100644 --- a/README.md +++ b/README.md @@ -46,7 +46,6 @@ 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 ------------ @@ -60,7 +59,6 @@ Build requirements: * make (tested with GNU make) * Chicken eggs (chicken-install) * sqlite3 - * srfi-1 Runtime requirements: @@ -72,10 +70,6 @@ Runtime requirements: Building -------- -All the eggs used are installed in the source tree using: - - sh install-eggs.sh - Building static binary: make static diff --git a/doc/d-utils.md b/doc/d-utils.md index 08b8a43..fdf2ad2 100644 --- a/doc/d-utils.md +++ b/doc/d-utils.md @@ -388,16 +388,6 @@ 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) diff --git a/src/Makefile b/src/Makefile index c71d1ff..0615ce5 100644 --- a/src/Makefile +++ b/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 tiocgwinsz.o + mailman-common.o mailman3.o mailman3-sql.o GENDOC-SOURCES=gendoc.scm duck-extract.import.scm \ util-time.import.scm util-csv.import.scm util-git.import.scm \ @@ -68,15 +68,14 @@ 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-mail.import.scm \ - util-bst-lset.import.scm + util-dir.import.scm util-utf8.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-bst-lset.o util-mail.o + util-dir.o util-utf8.o .PHONY: imports imports: $(HACKERBASE-DEPS) @@ -206,8 +205,7 @@ 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 \ - tiocgwinsz.import.scm + util-git.import.scm racket-kwargs.import.scm members-print.o: members-print.import.scm members-print.import.scm: $(MEMBERS-PRINT-SOURCES) @@ -545,8 +543,3 @@ 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) diff --git a/src/configuration.scm b/src/configuration.scm index 3518efc..7b9b7af 100644 --- a/src/configuration.scm +++ b/src/configuration.scm @@ -1,5 +1,5 @@ ;; -;; configuration.scm +;; configuraiton.scm ;; ;; Configuration parameters used by various modules. ;; diff --git a/src/gendoc.scm b/src/gendoc.scm index 2ffd3ac..e5afddc 100644 --- a/src/gendoc.scm +++ b/src/gendoc.scm @@ -1,27 +1,3 @@ -;; -;; gendoc.scm -;; -;; Generate documentation for all documented modules dynamically. -;; -;; 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. -;; (import duck-extract) diff --git a/src/hackerbase.scm b/src/hackerbase.scm index 24552d1..f458a18 100644 --- a/src/hackerbase.scm +++ b/src/hackerbase.scm @@ -62,7 +62,6 @@ (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)) @@ -138,8 +137,6 @@ "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" @@ -375,7 +372,7 @@ (newline) (if mr (print-member-balances-table mr) - (print-members-fees-table MB (-show-destroyed-) (-show-only-active-)))) + (print-members-fees-table MB (-show-destroyed-)))) ((repl) (repl)) ((genweb) @@ -409,7 +406,7 @@ (if (null? nmembers) (print "Everyone paid on time.") (let () - (stdout-print "Notify" (-notify-months-)) + (print "Notify" (-notify-months-)) (let loop ((lst nmembers)) (when (and (not (null? lst)) (or (not mr) diff --git a/src/mailman3-sql.scm b/src/mailman3-sql.scm index 741ec23..a9a0fc8 100644 --- a/src/mailman3-sql.scm +++ b/src/mailman3-sql.scm @@ -45,11 +45,7 @@ ;; Returns (possibly cached) SQLite3 DB handle (define (mailman3-db) (when (not (*cached-mailman3-db*)) - (*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* (open-database (*mailman3-sql-path*)))) (*cached-mailman3-db*)) ;; Returns the list of mailman3 mailinglists by querying te diff --git a/src/members-payments.scm b/src/members-payments.scm index bf2c416..6f8731d 100644 --- a/src/members-payments.scm +++ b/src/members-payments.scm @@ -77,25 +77,13 @@ (string->number (bank-transaction-varsym transaction))) (varsym-id - (if (and varsym-id0 - (> varsym-id0 1000)) - varsym-id0 + (or varsym-id0 (let* ((msg (bank-transaction-message transaction)) - (ci1 (substring-index "," msg)) - (vs1 (if ci1 - (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))) - (or (string->number vs1) - (string->number vs2) - (string->number vs3)))))) + (ci (substring-index "," msg)) + (vs (if ci + (substring msg 0 ci) + msg))) + (string->number vs))))) varsym-id))) ;; Special comparator (originally with JendaSAP hack) diff --git a/src/members-print.scm b/src/members-print.scm index 86e14c1..3fdf736 100644 --- a/src/members-print.scm +++ b/src/members-print.scm @@ -67,8 +67,7 @@ cal-format util-git cal-day - racket-kwargs - tiocgwinsz) + racket-kwargs) (define *show-payments-count* (make-parameter 36)) @@ -268,9 +267,11 @@ (define (members-table-row a:? label mrs fmt) (list (string-append "\t" a:? label) (length mrs) - (member-records->string - (sort mrs brmemberstring + (sort mrs brmemberstring - (filter - identity - (list (list "Type" "Count" "List") - (members-pred-table-row mb - (ansi-string #:yellow "Chair:") - brmember-chair? - "~N") - (members-pred-table-row mb - (ansi-string #:yellow "Council:") - brmember-council? - "~N") - (members-pred-table-row mb - (ansi-string #:yellow "Revision:") - brmember-revision? - "~N") - (members-pred-table-row mb - (ansi-string #:yellow "Grant:") - brmember-grant? - "~N") - (members-pred-table-row mb - (string-append a:success "Active:") - brmember-active? - "~N~E") - (members-pred-table-row mb - (string-append a:highlight "Students:") - brmember-student? - "~N~E") - (members-table-row a:warning "Suspended:" suspended-mrs "~N~E (~S)") - (members-pred-table-row mb - (string-append a:warning "Destroyed:") - brmember-destroyed? - "~N~E") - (let ((suspended2 (filter - (lambda (mr) - (>= (brmember-suspended-months mr) - member-suspend-max-months)) - suspended-mrs))) - (if (null? suspended2) - #f - (members-table-row (ansi #:magenta) "Suspended (long):" suspended2 "~N (~S)"))) - (if (null? soon-expire-mrs) + (let* ((total-count (length + (find-members-by-predicate mb brmember-usable?))) + (invalid-mrs (find-members-by-predicate + mb + (compose not is-4digit-prime? brmember-id))) + (suspended-mrs (find-members-by-predicate mb brmember-suspended?)) + (debtor-mrs (sort + (members-to-notify mb 3) + brmemberstring + (filter + identity + (list (list "Type" "Count" "List") + (members-pred-table-row mb + (ansi-string #:yellow "Chair:") + brmember-chair? + "~N") + (members-pred-table-row mb + (ansi-string #:yellow "Council:") + brmember-council? + "~N") + (members-pred-table-row mb + (ansi-string #:yellow "Revision:") + brmember-revision? + "~N") + (members-pred-table-row mb + (ansi-string #:yellow "Grant:") + brmember-grant? + "~N") + (members-pred-table-row mb + (string-append a:success "Active:") + brmember-active? + "~N~E") + (members-pred-table-row mb + (string-append a:highlight "Students:") + brmember-student? + "~N~E") + (members-table-row a:warning "Suspended:" suspended-mrs "~N~E (~S)") + (members-pred-table-row mb + (string-append a:warning "Destroyed:") + brmember-destroyed? + "~N~E") + (let ((suspended2 (filter + (lambda (mr) + (>= (brmember-suspended-months mr) + member-suspend-max-months)) + suspended-mrs))) + (if (null? suspended2) #f - (members-table-row (ansi #:magenta #:bold) "Expire Soon:" - soon-expire-mrs "~N (~S)")) - (members-pred-table-row mb - (ansi-string #:red #:bold "Prolems:") - brmember-has-problems? - "~N~E ~A") - (if (null? debtor-mrs) - #f - (list (ansi-string "\t" #:magenta #:bold "Debtors:") - (format "~A" (length debtor-mrs)) - (table->string - (append - (members-attrs-table debtor-mrs - brmember-format - (list "Name" "Balance" "Last Payment") - (list "~N" "\t~B" "~L")) - (list - (list - "Total" - (format - "\t~A" - (foldr - (lambda (v a) - (+ (member-total-balance v) a)) - 0 - debtor-mrs))))) - #:border '(((#:bottom #:right light) ... (#:bottom light)) - ((#:right light) ... none) ... - ((#:top #:right light) ... (#:top light))) - #:ansi-reset? #t))) - )) - #:border '(((#:bottom #:right light) ... (#:bottom light)) - ... - ((#:right light) ... none)) - #:width (- columns 10) - #:ansi-reset? #t)))) + (members-table-row (ansi #:magenta) "Suspended (long):" suspended2 "~N (~S)"))) + (if (null? soon-expire-mrs) + #f + (members-table-row (ansi #:magenta #:bold) "Expire Soon:" + soon-expire-mrs "~N (~S)")) + (members-pred-table-row mb + (ansi-string #:red #:bold "Prolems:") + brmember-has-problems? + "~N~E ~A") + (if (null? debtor-mrs) + #f + (list (ansi-string "\t" #:magenta #:bold "Debtors:") + (format "~A" (length debtor-mrs)) + (table->string + (append + (members-attrs-table debtor-mrs + brmember-format + (list "Name" "Balance" "Last Payment") + (list "~N" "\t~B" "~L")) + (list + (list + "Total" + (format + "\t~A" + (foldr + (lambda (v a) + (+ (member-total-balance v) a)) + 0 + debtor-mrs))))) + #:border '(((#:bottom #:right light) ... (#:bottom light)) + ((#:right light) ... none) ... + ((#:top #:right light) ... (#:top light))) + #:ansi-reset? #t))) + )) + #:border '(((#:bottom #:right light) ... (#:bottom light)) + ... + ((#:right light) ... none)) + #:width 70 + #:ansi-reset? #t))) (let ((pmrs (find-members-by-predicate mb brmember-file-has-problems?))) (when (not (null? pmrs)) (newline) @@ -471,14 +471,10 @@ ")")))) ;; Prints summary table of all fees and credits for all members - (define (print-members-fees-table MB . dsa) - (let ((destroyed? (if (null? dsa) + (define (print-members-fees-table MB . ds) + (let ((destroyed? (if (null? ds) #f - (car dsa))) - (only-active? (if (or (null? dsa) - (null? (cdr dsa))) - #f - (cadr dsa)))) + (car ds)))) (let* ((members ;; Pass 1 (map (lambda (mr) @@ -504,11 +500,8 @@ (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)))))) + (find-members-by-predicate MB (lambda (mr) + (not (brmember-destroyed? mr))))) brmember -;; -;; 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 ") - -(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)))) - - ) diff --git a/src/util-bst-bdict.scm b/src/util-bst-bdict.scm index bf198de..1a2c6a7 100644 --- a/src/util-bst-bdict.scm +++ b/src/util-bst-bdict.scm @@ -1,27 +1,3 @@ -;; -;; util-bst-bdict.scm -;; -;; BST-based number dictionary. -;; -;; 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 util-bst-bdict)) diff --git a/src/util-bst-ldict.scm b/src/util-bst-ldict.scm index 99d0393..1810793 100644 --- a/src/util-bst-ldict.scm +++ b/src/util-bst-ldict.scm @@ -1,27 +1,3 @@ -;; -;; util-bst-ldict.scm -;; -;; BST-based symbol dictionary. -;; -;; 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 util-bst-ldict)) diff --git a/src/util-bst-lset.scm b/src/util-bst-lset.scm index b8a035f..48bf226 100644 --- a/src/util-bst-lset.scm +++ b/src/util-bst-lset.scm @@ -1,27 +1,3 @@ -;; -;; util-bst-lset.scm -;; -;; BST-based set implementation. -;; -;; 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 util-bst-lset)) diff --git a/src/util-bst.scm b/src/util-bst.scm index c27d518..93f97a7 100644 --- a/src/util-bst.scm +++ b/src/util-bst.scm @@ -1,27 +1,3 @@ -;; -;; util-bst.scm -;; -;; Underlying BST implementation for sets and dictionaries. -;; -;; 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 util-bst))