diff options
| -rwxr-xr-x | journal.lisp | 168 |
1 files changed, 147 insertions, 21 deletions
diff --git a/journal.lisp b/journal.lisp index 9bc71e6..35008ef 100755 --- a/journal.lisp +++ b/journal.lisp @@ -46,32 +46,158 @@ (defparameter *action* (keywordify (getf *query* :action)) - "One of NIL, :INDEX, :VIEW, :POST, :EDIT, and :PREVIEW.") + "One of NIL, :INDEX, :VIEW-ATOM-FEED, :VIEW, :POST, :EDIT, and :PREVIEW.") -(defparameter *entry-number* - (parse-integer (getf *query* :entry "") +(defparameter *post-number* + (parse-integer (getf *query* :post "") :junk-allowed t #|| :radix 12 ||#) - "The identification number of the blog entry to be acted upon. + "The identification number of the journal entry to be acted upon. May be NIL.") (defparameter *method* (keywordify (gethash "REQUEST_METHOD" (http-get-env-vars))) "One of :GET, :POST, :PUT, and :DELETE.") - -(http-add-header "Content-type" "text/html; charset=UTF-8") -(http-send-headers) - - -(<:html - (<:body - (loop for (x . y) in `(("Action" . ,*action*) - ("Request method" . ,*method*) - ("Query" . ,*query*) - ("Query string" . ,(http-get-query-string)) - ("Environment" . ,(http-get-env-vars))) - do (<:p - (<:hr) - (<:h2 (<:as-html x)) - (<:p "Type " (<:em (<:as-html (type-of y))) ".") - (<:pre (<:as-html (prin1-to-string y))))))) +(defparameter *journal-entries* + '() + "A list of JOURNAL-ENTRY objects.") + +(defparameter *http-env* + (http-get-env-vars) + "A hash table of HTTP environment variables.") + + +(defclass journal-entry () + ((id :type (integer 0) + :accessor id-of + :initarg :id) + (title :type string + :accessor title-of + :initarg :title + :initform "") + (body :type string + :accessor body-of + :initarg :body + :initform "") + (categories :type list + :accessor categories-of + :initarg :categories + :initform '()))) + + +(defmethod shared-initialize ((journal-entry journal-entry) slot-names + &key) + (with-slots (id) journal-entry + (when (or (eq slot-names t) + (member 'id slot-names)) + (setf id (1+ (reduce #'max *journal-entries* + :key #'id-of + :initial-value -1))))) + (call-next-method)) + + +(defun journal-markup->html (markup) + (if (string= "" markup) + markup + (handler-bind + ((error ;; method-call-type-error or not + ;; Work around a weird bug in cl-markdown or CLISP. (I + ;; don't know which.) + #'(lambda (c) + (declare (ignore c)) + #+nil (<:as-html + (with-output-to-string (s) + (system::pretty-print-condition c s))) + (invoke-restart 'return nil)))) + (with-output-to-string (s) + ;; Normally, we shouldn't need to create our own stream to + ;; write into, but this is, of course, yet another + ;; CLISP/Markdown hack, because Markdown's default + ;; *OUTPUT-STREAM* seems to spontaneously close itself, making + ;; everything break when Markdown tries to render more stuff. + (markdown markup :stream s))))) + + +(defun read-journal-entry (filename) + (with-open-file (file filename :direction :input + :external-format #+clisp charset:utf-8 + #+sbcl :utf-8) + (let ((*read-eval* nil)) + (let ((data (read file))) + (apply #'make-instance 'journal-entry data))))) + + +(defun read-journal-entries () + (let ((directory + (make-pathname + :directory (pathname-directory + (merge-pathnames + (make-pathname :directory '(:relative "journal-entries") + :name nil) + (pathname-as-file + (or (gethash "SCRIPT_FILENAME" *http-env*) + "/home/mulk/Dokumente/Projekte/Mulkblog/journal.cgi")))))) + (journal-entries (list))) + (when (file-exists-p directory) + (walk-directory directory + #'(lambda (x) + (push (read-journal-entry x) journal-entries)) + :test (complement #'directory-pathname-p))) + (sort journal-entries #'>= :key #'id-of))) + + +(defun show-atom-feed () + (http-add-header "Content-type" "text/xml; charset=UTF-8") + (http-send-headers)) + + +(defun show-web-journal () + (http-add-header "Content-type" "text/html; charset=UTF-8") + (http-send-headers) + + (<:html + (<:body + (<:h1 :id :main-title "Kompottkins Weisheiten") + (<:div :id :contents + (if (or (null *action*) + (eq *action* :index)) + (dolist (journal-entry *journal-entries*) + (<:div :class :journal-entry + (<:h2 (<:as-html (title-of journal-entry))) + (<:as-is (journal-markup->html (body-of journal-entry))))))) + (<:div :id :navigation) + + (loop for (x . y) in `(("Action" . ,*action*) + ("Request method" . ,*method*) + ("Query" . ,*query*) + ("Query string" . ,(http-get-query-string)) + ("Environment" . ,(http-get-env-vars))) + do (<:p + (<:hr) + (<:h2 (<:as-html x)) + (<:p "Type " (<:em (<:as-html (type-of y))) ".") + (<:pre (<:as-html (prin1-to-string y)))))))) + + +(defun main () + (let ((*journal-entries* (read-journal-entries))) + (case *action* + (:view-atom-feed (show-atom-feed)) + (otherwise (show-web-journal))))) + + +(handler-bind + ((error #' + (lambda (e) + (<:html + (<:head + (<:title "Kompottkins Weisheiten: Fehler")) + (<:body + (<:h1 "Kompottkins Weisheiten: Fehlerbericht") + (<:p "Leider ist waehrend der Bearbeitung Ihrer Anfrage ein + Fehler aufgetreten. Wir bitten dies zu entschuldigen. + Ein detaillierter Fehlerbericht folgt.") + (<:pre (<:as-html (with-output-to-string (out) + #+clisp (system::pretty-print-condition e out) + #+clisp (system::print-backtrace :out out))))))))) + (main)) |