Guest Book

#! /usr/bin/guile \ -e main -s !# (use-modules (ice-9 exceptions)) (use-modules (json)) (define guest-book-json-file "cgi-bin/guest_book.json") (define (decode-hex hex) (string (integer->char (string->number (string-append "#x" hex))))) (define (format-query-string item) (letrec ((decode-query (lambda (value) (let ((index (string-index value #\%)) (value-length (string-length value))) (cond ((and index value-length) (string-append (substring value 0 index) (decode-hex (substring value (+ index 1) (+ index 3))) (cond ((< index (- value-length 3)) (decode-query (substring value (+ index 3) value-length))) (else "")))) (else value)))))) (decode-query (string-map (lambda (character) (case character ((#\+) #\space) (else character))) item)))) ;; Progress form data (define (get-form) (let ((query (getenv "QUERY_STRING"))) (cond ((= (string-length query) 0) #f) (else (map (lambda (item) (let ((pairs (string-split item #\=))) (set-cdr! pairs (format-query-string (cadr pairs))) pairs)) (string-split query #\&)))))) (define (handle-fields) (display (get-form))) ;; Display a guest in the guest book (define (display-guest guest) (let ((date (cdr (list-ref guest 0))) (message (cdr (list-ref guest 1))) (url (cdr (list-ref guest 2))) (name (cdr (list-ref guest 3)))) (format #t " \n\ \n\

\n\ ~a ~a --- signed ~a\n\

\n\

\n\n" name url url date message))) ;; Display pretty much everything (define (display-guest-book) (display "Content-Type: text/html\n\n\ \n\ \n\ \n\ Guest Book\n\ \n\ \n\ \n\ $\"Back$ \n\ \n\ \n\ \n\ \n\ \n\

\n\

Sign my fucking guest book

\n\ \n\

\n\ Be nice! Dont be a fucking ass.\n\

\n") (handle-fields) (display "

\n\n") ;; Try to read the guest book json (with-exception-handler (lambda (error) (display " \n\ \n\

\n\

No guest have been added ): But you can be the first!

\n\

\n")) (lambda () (call-with-input-file guest-book-json-file (lambda (fp) (letrec ((guest-book (json->scm fp)) (guest-loop (lambda (index) (display-guest (vector-ref guest-book index)) (if (< index (- (vector-length guest-book) 1)) (guest-loop (+ index 1)))))) (guest-loop 0))))) #:unwind? #t) (display " \n\ \n\ \n")) (define (main args) (display-guest-book))