Rename web-static to export-wiki-compat

src/export-wiki-compat.scm

@@ -0,0 +1,104 @@
+;;
+;; export-wiki-compat.scm
+;;
+;; Exporting members status for displaying in dokuwiki hack.
+;;
+;; 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 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)
+	 brmember
+	 util-list
+	 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)))))
+
+ )