Work on member web static file generator.

This commit is contained in:
Dominik Pantůček 2023-04-01 18:02:44 +02:00
parent b3bb37cbce
commit 52a2108b4f
5 changed files with 42 additions and 3 deletions

View file

@ -53,7 +53,6 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
(newline) (newline)
;; Command-line options and configurable parameters ;; Command-line options and configurable parameters
(define *members-directory* (make-parameter "members"))
(define *apikeys-file* (make-parameter "apikey.ntlm")) (define *apikeys-file* (make-parameter "apikey.ntlm"))
(define -needs-bank- (make-parameter #f)) (define -needs-bank- (make-parameter #f))
(define -member-id- (make-parameter #f)) (define -member-id- (make-parameter #f))

View file

@ -31,6 +31,7 @@
*current-month* *current-month*
*member-file-context* *member-file-context*
*member-suspend-max-months* *member-suspend-max-months*
*members-directory*
) )
(import scheme (import scheme
@ -52,4 +53,7 @@
;; How long the member can be suspended without any action required? ;; How long the member can be suspended without any action required?
(define *member-suspend-max-months* (make-parameter 24)) (define *member-suspend-max-months* (make-parameter 24))
;; Needed by multiple modules actually
(define *members-directory* (make-parameter "members"))
) )

View file

@ -31,6 +31,7 @@
( (
make-member-record make-member-record
member-file-name
member-file-path member-file-path
member-record-input-file member-record-input-file
@ -128,7 +129,11 @@
(cadr args)) (cadr args))
pairs))))))) pairs)))))))
;; Convenience accessor ;; File name without directory
(define (member-file-name mr)
(dict-ref mr 'file-name))
;; Convenience accessor for file name with directory
(define (member-file-path mr) (define (member-file-path mr)
(dict-ref mr 'file-path)) (dict-ref mr 'file-path))

View file

@ -31,6 +31,7 @@
filter filter
string-repeat string-repeat
string-first+rest string-first+rest
get-process-output-lines
utils-tests! utils-tests!
) )
@ -38,6 +39,8 @@
(chicken base) (chicken base)
(chicken string) (chicken string)
(chicken irregex) (chicken irregex)
(chicken io)
(chicken process)
testing) testing)
;; Returns a list with elements matching pred? predicate. ;; Returns a list with elements matching pred? predicate.
@ -72,6 +75,14 @@
(cons key-str val)) (cons key-str val))
(cons str "")))) (cons str ""))))
;; Very simple shell command wrapper that returns lines produced by
;; given command. Dangerous - performs no argument escaping!
(define (get-process-output-lines cmd)
(let-values (((stdout stdin pid stderr) (process* cmd)))
(close-output-port stdin)
(let ((result (read-lines stdout)))
(let-values (((a b c) (process-wait pid)))
result))))
;; Performs utils module self-tests. ;; Performs utils module self-tests.
(define (utils-tests!) (define (utils-tests!)

View file

@ -29,12 +29,16 @@
web-static web-static
( (
gen-web-static-member gen-web-static-member
gen-web-static
) )
(import scheme (import scheme
(chicken base) (chicken base)
(chicken format) (chicken format)
member-record) (chicken string)
member-record
utils
configuration)
;; Generate all the files in current directory, should be wrapped in ;; Generate all the files in current directory, should be wrapped in
;; something like with-current-directory. ;; something like with-current-directory.
@ -53,6 +57,22 @@
(when (not (null? lines)) (when (not (null? lines))
(print (car lines)) (print (car lines))
(loop (cdr lines)))))) (loop (cdr lines))))))
(with-output-to-file (sprintf "~A.log" nick)
(lambda ()
(let loop ((lines
(get-process-output-lines
(sprintf "git -C \"~A\" log \"~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)
#f)
) )