;; ;; web-static.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 web-static)) (module web-static ( 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) member-record utils configuration members-payments members-base) ;; Generate all the files in specified (default current) directory. (define (gen-web-static-member mr . dirs) (let ((nick (member-nick mr)) (id (member-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 (member-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 (get-process-output-lines (sprintf "git -C \"~A\" log -p -- \"~A\"" (string-translate* (*members-directory*) '(("\"" . "\\\""))) (member-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 loop ((mb (members-base-members mb))) (when (not (null? mb)) (gen-web-static-member (car mb) dir) (loop (cdr mb))))) )