;; ;; export-wiki-compat.scm ;; ;; Exporting members status for displaying in dokuwiki hack. ;; ;; 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 export-wiki-compat)) (module export-wiki-compat ( gen-web-static-member gen-web-static ) (import scheme (chicken base) (chicken format) (chicken string) (chicken process-context) (chicken pathname) (chicken file) (chicken file posix) srfi-1 brmember configuration members-payments mbase util-git progress) ;; Generate all the files in specified (default current) directory. (define (gen-web-static-member mr . dirs) (let ((nick (brmember-nick mr)) (id (brmember-id mr)) (dir (if (null? dirs) (current-directory) (car dirs)))) (with-output-to-file (make-pathname dir (sprintf "~A.id" nick)) (lambda () (print id))) (with-output-to-file (make-pathname dir (sprintf "~A.balance" nick)) (lambda () (print (member-total-balance mr)))) (with-output-to-file (make-pathname dir (sprintf "~A.misc" nick)) (lambda () (let loop ((lines (brmember-source mr))) (when (not (null? lines)) (print (car lines)) (loop (cdr lines)))))) (with-output-to-file (make-pathname dir (sprintf "~A.log" nick)) (lambda () (let loop ((lines ((git (*members-directory*) #:output) 'log '-p '-- (brmember-file-name mr)))) (when (not (null? lines)) (print (car lines)) (loop (cdr lines)))))) )) ;; Generates all member files in given directory (define (gen-web-static mb dir) (when (and (file-exists? dir) (regular-file? dir)) (error 'gen-web-static "Directory is a file:" dir)) (when (not (directory-exists? dir)) (create-directory dir)) (let* ((members-list (find-members-by-predicate mb brmember-existing?)) (mlen0 (length members-list)) (mlen (if (> mlen0 0) mlen0 1))) (with-progress% #t dir (let loop ((mb members-list) (i 0)) (if (not (null? mb)) (let () (progress%-advance (/ i mlen)) (gen-web-static-member (car mb) dir) (loop (cdr mb) (add1 i)))) (progress%-advance 1))))) )