;; ;; export-web-static.scm ;; ;; Generate private member info page. ;; ;; 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-web-static)) (module export-web-static ( gen-html-members ) (import scheme (chicken base) (chicken format) (chicken pathname) (chicken string) (chicken file) brmember util-dir mbase members-payments cal-day util-git configuration texts) ;; HTML entities (define (sanitize-html str) (string-translate* str '(("&" . "&") ("<" . "<") (">" . ">") ("\"" . """)))) ;; Prints the HTML summary for given member to current-output-port (define (print-html-member mr) (let ((bhs (brmember-balance-history mr))) (print "") (print "") (print "") (print "") (print "Brmlab Member: " (brmember-nick mr) "") (print "") (print "") (print "") (print "

Brmlab Member: " (brmember-nick mr) "

") (print "

") (print "

") (print "

") ;;(print "

Basic Information

") (print "

Nickname/Username (Přezdívka/Uživatelské jméno): " (brmember-nick mr) "
Member ID, Variable Symbol for Payments (Členské číslo, variabilní symbol plateb): " (brmember-id mr) "
Balance in CZK (Zůstatek v Kč): " (caar (reverse bhs)) "
Account for Payments (Účet pro platbu příspěvků): 2500079551/2010

") (print "

") (print "

") (print "

Payments History

") (print "") (print "") (print "") (for-each (lambda (hr) (print "" )) bhs) (print "") (print "

Date	Type	Comment	Amount	Currency	Amount [CZK]	Balance
" (cal-day->string (cadr hr)) "	" (list-ref hr 6) "	" (list-ref hr 4) "	" (exact->inexact (list-ref hr 2)) "	" (list-ref hr 3) "	" (exact->inexact (list-ref hr 5)) "	" (exact->inexact (car hr)) "

") (print "

") (print "

") (print "

") (print "

") (print "

Member file

") (print "

")
     (print (sanitize-html
	     (string-intersperse (brmember-source mr) "\n")))
     (print "

") (print "

Changes History

") (print "

")
     (for-each (lambda (l)
		 (print (sanitize-html l)))
	       ((git (*members-directory*) 'output)
		'log '-p '-- 
		(brmember-file-name mr)))
     (print "

") (print "

") (print "

") (print "

") (print "") (print "") (print ""))) ;; Generates a single member in given directory (define (gen-html-member mr dir) (let ((fname (format "~A.html" (brmember-id mr)))) (with-output-to-file (make-pathname dir (format "~A.html" (brmember-nick mr))) (lambda () (print-html-member mr))))) ;; Removes all generated files which do not belong to any member (define (clean-members-files mb dir) (let loop ((fns (directory dir))) (when (not (null? fns)) (let* ((fn (car fns)) (utl (string-split fn ".")) (username (car utl)) (mr (find-member-by-nick mb username))) (when (or (not mr) (brmember-destroyed? mr)) (delete-file (make-pathname dir fn))) (loop (cdr fns)))))) ;; Generates all members in given directory (define (gen-html-members mb dir) (ensure-directory dir) (with-mbase-progress% mb dir mr (gen-html-member mr dir)) (clean-members-files mb dir)) )