From 448f3a743d982518163abc15f0e1ddfedb30753d Mon Sep 17 00:00:00 2001 From: nathansmith Date: Mon, 12 May 2025 09:43:13 -0600 Subject: Working on scheme guest book --- cgi-bin/guest_book_scm.cgi | 104 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 104 insertions(+) create mode 100755 cgi-bin/guest_book_scm.cgi (limited to 'cgi-bin') diff --git a/cgi-bin/guest_book_scm.cgi b/cgi-bin/guest_book_scm.cgi new file mode 100755 index 0000000..3963b25 --- /dev/null +++ b/cgi-bin/guest_book_scm.cgi @@ -0,0 +1,104 @@ +#! /usr/bin/guile \ +-e main -s +!# + +(use-modules (ice-9 exceptions)) +(use-modules (json)) + +(define guest-book-json-file "cgi-bin/guest_book.json") + +;; 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\ +

~a

\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\ + Name\n\ + \n\ +
\n\ + Website (Optional)\n\ + \n\ + \n\ +

\n\ + Write a little silly something\n\ +
\n\ + \n\ +
\n\ + \n\ + You can't delete/edit it afterwards\n\ +
\n\ +

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

\n\ +
\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)) + -- cgit v1.2.3