Split journal.lisp into multiple files.

darcs-hash:5621824874dbddcf61282b66c975266d16d1fa6f

9 files changed, 613 insertions, 418 deletions

diff --git a/defpackage.lisp b/defpackage.lisp
new file mode 100644
index 0000000..cc828b3
--- /dev/null
+++ b/defpackage.lisp
@@ -0,0 +1,26 @@
+;;;; -*- coding: utf-8; mode: lisp -*-
+;;;; Copyright 2007, Matthias Andreas Benkard.
+
+;;;------------------------------------------------------------------------
+;;; This file is part of The Mulkblog Project.
+;;;
+;;; The Mulkblog Project is free software.  You can redistribute it and/or
+;;; modify it under the terms of the Affero General Public License as
+;;; published by Affero, Inc.; either version 1 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; The Mulkblog Project is distributed in the hope that it will be
+;;; useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+;;; of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the Affero General Public
+;;; License in the COPYING file that comes with The Mulkblog Project; if
+;;; not, write to Affero, Inc., 510 Third Street, Suite 225, San
+;;; Francisco, CA 94107 USA.
+;;;------------------------------------------------------------------------
+
+(defpackage #:mulk.journal
+  (:nicknames #:journal)
+  (:use #:cl #:fad #:iterate #:markdown #:yaclml #:http #:alexandria
+        #:xml-emitter #:split-sequence))
diff --git a/globals.lisp b/globals.lisp
new file mode 100644
index 0000000..1764089
--- /dev/null
+++ b/globals.lisp
@@ -0,0 +1,64 @@
+;;;; -*- coding: utf-8; mode: lisp -*-
+;;;; Copyright 2007, Matthias Andreas Benkard.
+
+;;;------------------------------------------------------------------------
+;;; This file is part of The Mulkblog Project.
+;;;
+;;; The Mulkblog Project is free software.  You can redistribute it and/or
+;;; modify it under the terms of the Affero General Public License as
+;;; published by Affero, Inc.; either version 1 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; The Mulkblog Project is distributed in the hope that it will be
+;;; useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+;;; of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the Affero General Public
+;;; License in the COPYING file that comes with The Mulkblog Project; if
+;;; not, write to Affero, Inc., 510 Third Street, Suite 225, San
+;;; Francisco, CA 94107 USA.
+;;;------------------------------------------------------------------------
+
+(in-package #:mulk.journal)
+
+
+(defparameter *site* nil
+  "One of :WIRSELKRAUT and :NFS.NET.")
+
+(defparameter *debugging-p* nil)
+
+(defparameter *query* nil
+  "The HTTP query string transformed into a property list.")
+
+(defparameter *http-env* nil
+  "A hash table of HTTP environment variables.")
+
+(defparameter *subpath-query* nil
+  "The query string stripped of the script location.")
+
+(defparameter *subpath-string* nil
+  "The query string stripped of the script location and query parameters,
+   that is, the virtual path below the script.")
+
+(defparameter *subpath* nil
+  "*SUBPATH-STRING* parsed into a list of nested directories.")
+
+(defparameter *post-number* nil
+  "The identification number of the journal entry to be acted upon.
+   May be NIL.")
+
+(defparameter *action* nil
+  "One of NIL, :INDEX, :VIEW-ATOM-FEED, :VIEW, :POST, :EDIT, :PREVIEW,
+   and :POST-COMMENT.")
+
+(defparameter *method* nil
+  "One of :GET, :POST, :PUT, and :DELETE.")
+
+(defparameter *script-filename* nil)
+
+(defparameter *journal-entries* nil
+  "A list of JOURNAL-ENTRY objects.")
+
+(defparameter *cgi-p* nil
+  "Whether we have been called as a CGI script or not.")
diff --git a/journal-content.lisp b/journal-content.lisp
new file mode 100644
index 0000000..c914269
--- /dev/null
+++ b/journal-content.lisp
@@ -0,0 +1,153 @@
+;;;; -*- coding: utf-8; mode: lisp -*-
+;;;; Copyright 2007, Matthias Andreas Benkard.
+
+;;;------------------------------------------------------------------------
+;;; This file is part of The Mulkblog Project.
+;;;
+;;; The Mulkblog Project is free software.  You can redistribute it and/or
+;;; modify it under the terms of the Affero General Public License as
+;;; published by Affero, Inc.; either version 1 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; The Mulkblog Project is distributed in the hope that it will be
+;;; useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+;;; of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the Affero General Public
+;;; License in the COPYING file that comes with The Mulkblog Project; if
+;;; not, write to Affero, Inc., 510 Third Street, Suite 225, San
+;;; Francisco, CA 94107 USA.
+;;;------------------------------------------------------------------------
+
+(in-package #:mulk.journal)
+
+
+;;; (@* "Class definitions")
+(defclass journal-entry ()
+  ((id :type (integer 0)
+       :accessor id-of
+       :initarg :id)
+   (uuid :type string
+         :accessor uuid-of
+         :initarg :uuid)
+   (file :type (or null pathname)
+         :accessor file-of
+         :initarg :file)
+   (title :type string
+          :accessor title-of
+          :initarg :title
+          :initform "")
+   (date :type (integer 0)
+         :accessor date-of
+         :initarg :date)
+   (last-modification :type (or null (integer 0))
+                      :accessor last-modification-of
+                      :initarg :last-modification
+                      :initform nil)
+   (body :type string
+         :accessor body-of
+         :initarg :body
+         :initform "")
+   (categories :type list
+               :accessor categories-of
+               :initarg :categories
+               :initform '())
+   (comments :type list
+             :accessor comments-about
+             :initarg :comments
+             :initform '())))
+
+
+(defclass journal-comment ()
+  ((id :type (integer 0)
+       :accessor id-of
+       :initarg :id)
+   (uuid :type string
+         :accessor uuid-of
+         :initarg :uuid)
+   (date :type (integer 0)
+         :accessor date-of
+         :initarg :date)
+   (body :type string
+         :accessor body-of
+         :initarg :body
+         :initform "")
+   (author :type (or null string)
+           :accessor author-of
+           :initarg :author
+           :initform nil)
+   (email :type (or null string)
+          :accessor email-of
+          :initarg :email
+          :initform nil)
+   (website :type (or null string)
+            :accessor website-of
+            :initarg :website
+            :initform nil)))
+
+
+;; (@* "Journal entry operations")
+(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 find-entry (number)
+  (find number *journal-entries* :key #'id-of))
+
+
+(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))))
+        (fixup-markdown-output
+         (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)))
+        (let ((comments (member :comments data)))
+          (when comments
+            (setf (second comments)
+                  (mapcar #'(lambda (comment-record)
+                              (apply #'make-instance
+                                     'journal-comment
+                                     comment-record))
+                          (second comments)))))
+        (apply #'make-instance 'journal-entry :file filename data)))))
+
+
+(defun compute-journal-last-modified-date ()
+  #-clisp (get-universal-time)
+  #+clisp
+  (loop for file in (list* *script-filename*                    ;; journal.cgi
+                           (merge-pathnames (make-pathname :type "lisp")
+                                            *script-filename*)  ;; journal.lisp
+                           (find-journal-entry-files))
+        maximize (posix:file-stat-mtime (posix:file-stat file))))
diff --git a/journal.cgi b/journal.cgi
index 96e46d9..a23b433 100755
--- a/journal.cgi
+++ b/journal.cgi
@@ -1,3 +1,3 @@
 #! /bin/sh
 DIR=`dirname "$0"`
-exec clisp -M "$DIR/lispinit.mem.gz" "$DIR/journal.lisp" "$@"
+exec clisp -M "$DIR/lispinit.mem.gz" "$DIR/run.lisp" "$@"
diff --git a/journal.lisp b/journal.lisp
index 0d16198..6db96e3 100755
--- a/journal.lisp
+++ b/journal.lisp
@@ -1,8 +1,7 @@
-#! /usr/bin/env clisp
 ;;;; -*- coding: utf-8; mode: lisp -*-
 ;;;; Copyright 2007, Matthias Andreas Benkard.
 
-;;;-----------------------------------------------------------------------
+;;;------------------------------------------------------------------------
 ;;; This file is part of The Mulkblog Project.
 ;;;
 ;;; The Mulkblog Project is free software.  You can redistribute it and/or
@@ -19,381 +18,11 @@
 ;;; License in the COPYING file that comes with The Mulkblog Project; if
 ;;; not, write to Affero, Inc., 510 Third Street, Suite 225, San
 ;;; Francisco, CA 94107 USA.
-;;;-----------------------------------------------------------------------
-
-
-;;; TAKE NOTICE: If you want to run this script from the command line or
-;;; from a web server, be sure to use a core image including the systems
-;;; this script depends upon.  The DEFSYSTEM form below has mainly been
-;;; written for purposes of documentation.
-(asdf:defsystem #:mulk.journal
-  :description "Matthias Benkard's simple web journal engine"
-  :licence     "Affero General Public License, version 1 or higher"
-  :depends-on  (#:cl-ppcre #:cl-fad #:iterate #:cl-markdown #:parenscript
-                #:yaclml #:lisp-cgi-utils #:alexandria #:xml-emitter
-                #:split-sequence))
-
-
-;;; The following does not generally work in a CGI setting because of
-;;; security restrictions.  Then again, loading all the dependencies
-;;; individually rather than using a core image would certainly be too
-;;; slow for any serious CGI usage, anyway, so what the heck.
-(unless (find-package '#:http)
-  (asdf:oos 'asdf:load-op '#:mulk.journal))
-
-
-(defpackage #:mulk.journal
-  (:nicknames #:journal)
-  (:use #:cl #:fad #:iterate #:markdown #:yaclml #:http #:alexandria
-        #:xml-emitter #:split-sequence))
+;;;------------------------------------------------------------------------
 
 (in-package #:mulk.journal)
 
 
-(defun keywordify (thing)
-  (if (null thing)
-      thing
-      (intern (etypecase thing
-                (string (string-upcase thing))
-                (symbol (symbol-name   thing)))
-              '#:keyword)))
-
-
-(defparameter *site*
-  (if (file-exists-p #p"/home/mulk") :mst-plus :nfs.net)
-  "One of :WIRSELKRAUT and :NFS.NET.")
-
-(defparameter *debugging-p*
-  (eq *site* :mst-plus))
-
-(defparameter *query*
-  #+clisp
-  (mapcan #'(lambda (param)
-              (list (keywordify param)
-                    (ext:convert-string-from-bytes
-                     (ext:convert-string-to-bytes
-                      (http-query-parameter param)
-                      charset:iso-8859-1)
-                     charset:utf-8)))
-          (http-query-parameter-list))
-  #-clisp '()
-  "The HTTP query string transformed into a property list.")
-
-(defparameter *http-env*
-  (http-get-env-vars)
-  "A hash table of HTTP environment variables.")
-
-(defparameter *subpath-query*
-  (subseq (gethash "REQUEST_URI" *http-env*)
-          (length (if (eq *site* :mst-plus)
-                      (gethash "SCRIPT_NAME" *http-env*)
-                      "/journal")))
-  "The query string stripped of the script location.")
-
-(defparameter *subpath-string*
-  (subseq *subpath-query*
-          0
-          (or (position #\? *subpath-query*)
-              (length *subpath-query*)))
-  "The query string stripped of the script location and query parameters,
-   that is, the virtual path below the script.")
-
-(defparameter *subpath*
-  (split-sequence #\/ *subpath-string*
-                  :remove-empty-subseqs t)
-  "*SUBPATH-STRING* parsed into a list of nested directories.")
-
-(defparameter *post-number*
-  (parse-integer (or (first *subpath*)
-                     (getf *query* :id ""))
-                 :junk-allowed t  #|| :radix 12 ||#)
-  "The identification number of the journal entry to be acted upon.
-   May be NIL.")
-
-(defparameter *action*
-  (or (keywordify (getf *query* :action))
-      (cond (*post-number*                      :view)
-            ((string= "feed" (first *subpath*)) :view-atom-feed)
-            (t                                  nil)))
-  "One of NIL, :INDEX, :VIEW-ATOM-FEED, :VIEW, :POST, :EDIT, :PREVIEW,
-   and :POST-COMMENT.")
-
-(defparameter *method*
-  (keywordify (gethash "REQUEST_METHOD" (http-get-env-vars)))
-  "One of :GET, :POST, :PUT, and :DELETE.")
-
-(defparameter *script-filename*
-  (pathname-as-file (or (gethash "SCRIPT_FILENAME" *http-env*)
-                        "/home/mulk/Dokumente/Projekte/Mulkblog/journal.cgi")))
-
-(defparameter *journal-entries*
-  '()
-  "A list of JOURNAL-ENTRY objects.")
-
-
-(defclass journal-entry ()
-  ((id :type (integer 0)
-       :accessor id-of
-       :initarg :id)
-   (uuid :type string
-         :accessor uuid-of
-         :initarg :uuid)
-   (file :type (or null pathname)
-         :accessor file-of
-         :initarg :file)
-   (title :type string
-          :accessor title-of
-          :initarg :title
-          :initform "")
-   (date :type (integer 0)
-         :accessor date-of
-         :initarg :date)
-   (last-modification :type (or null (integer 0))
-                      :accessor last-modification-of
-                      :initarg :last-modification
-                      :initform nil)
-   (body :type string
-         :accessor body-of
-         :initarg :body
-         :initform "")
-   (categories :type list
-               :accessor categories-of
-               :initarg :categories
-               :initform '())
-   (comments :type list
-             :accessor comments-about
-             :initarg :comments
-             :initform '())))
-
-
-(defclass journal-comment ()
-  ((id :type (integer 0)
-       :accessor id-of
-       :initarg :id)
-   (uuid :type string
-         :accessor uuid-of
-         :initarg :uuid)
-   (date :type (integer 0)
-         :accessor date-of
-         :initarg :date)
-   (body :type string
-         :accessor body-of
-         :initarg :body
-         :initform "")
-   (author :type (or null string)
-           :accessor author-of
-           :initarg :author
-           :initform nil)
-   (email :type (or null string)
-          :accessor email-of
-          :initarg :email
-          :initform nil)
-   (website :type (or null string)
-            :accessor website-of
-            :initarg :website
-            :initform nil)))
-
-
-(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 find-entry (number)
-  (find number *journal-entries* :key #'id-of))
-
-
-(defun make-uuid ()
-  "Generate a version 4 UUID according to RFC 4122, section 4.4."
-  (format nil "~(~8,'0x-~4,'0x-~4,'0x-~2,'0x~2,'0x-~12,'0x~)"
-          (random #x100000000)                ;; time_low
-          (random #x10000)                    ;; time_mid
-          (logior #b0100000000000000
-                  (logand #b0000111111111111
-                          (random #x10000)))  ;; time_hi_and_version
-          (logior #b10000000
-                  (logand #b00111111
-                          (random #x100)))    ;; clock_seq_hi_and_reserved
-          (random #x100)                      ;; clock_seq_low
-          (random #x1000000000000)))          ;; node
-
-
-(defun fixup-markdown-output (markup)
-  ;; No, cl-markdown is certainly not perfect.
-  ;;
-  ;; First, convert "<a ...> bla</a>" into " <a ...>bla</a>" (note the
-  ;; excess space to the right of the opening tag in the unprocessed
-  ;; string, which we move to the left of the same opening tag, where we
-  ;; expect it to make more sense in the general case).
-  (loop
-     for matches = (ppcre:all-matches "<a [^>]*?> " markup)
-     while (not (null matches))
-     do (progn
-          (setf markup
-                (replace markup markup :start1 (1+ (first matches))
-                                       :end1 (second matches)
-                                       :start2 (first matches)
-                                       :end2 (1- (second matches))))
-          (setf (elt markup (first matches)) #\Space)))
-  markup)
-
-
-(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))))
-        (fixup-markdown-output
-         (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)))
-        (let ((comments (member :comments data)))
-          (when comments
-            (setf (second comments)
-                  (mapcar #'(lambda (comment-record)
-                              (apply #'make-instance
-                                     'journal-comment
-                                     comment-record))
-                          (second comments)))))
-        (apply #'make-instance 'journal-entry :file filename data)))))
-
-
-(defun find-journal-entry-files ()
-  (let ((directory
-         (make-pathname
-          :directory (pathname-directory
-                      (merge-pathnames
-                       (make-pathname :directory '(:relative "journal-entries")
-                                      :name nil)
-                       *script-filename*))))
-        (journal-entry-files (list)))
-    (when (file-exists-p directory)
-      (walk-directory directory
-                      #'(lambda (x)
-                          (push x journal-entry-files))
-                      :test (complement #'directory-pathname-p)))
-    journal-entry-files))
-
-
-(defun read-journal-entries ()
-  (let ((journal-entry-files (find-journal-entry-files)))
-    (sort (mapcar #'read-journal-entry journal-entry-files)
-          #'>=
-          :key #'id-of)))
-
-
-(defmacro regex-case (string &body clauses)
-  (once-only (string)
-    `(cond ,@(loop for (keys . forms) in clauses
-                collect
-                  `(,(if (and (symbolp keys)
-                              (or (eq t keys)
-                                  (equal "OTHERWISE" (symbol-name keys))))
-                         't
-                         `(or ,@(loop for key in (if (listp keys)
-                                                     keys
-                                                     (list keys))
-                                   collect
-                                     `(ppcre:scan-to-strings ,key ,string))))
-                     ,@forms)))))
-
-
-(defun name-of-day (day-of-week)
-  (case day-of-week
-    (0 "Montag")
-    (1 "Dienstag")
-    (2 "Mittwoch")
-    (3 "Donnerstag")
-    (4 "Freitag")
-    (5 "Samstag")
-    (6 "Sonntag")))
-
-
-(defun format-date (destination date-control-string universal-time
-                    &optional (time-zone nil time-zone-supplied-p))
-  "Format DATE according to the description given by DATE-FORMAT-STRING.
-
-Recognised format directives are: %day, %mon, %yr, %day-of-week, %zone,
-%@day-of-week (name of day), %sec, %min, %hr, %daylight-p.
-
-Note that you can mix FORMAT and FORMAT-DATE painlessly by calling them
-after another in any arbitrary order."
-  (format
-   destination "~A"
-   (with-output-to-string (out)
-     (multiple-value-bind (sec min hr day mon yr day-of-week daylight-p zone)
-         (if time-zone-supplied-p
-             (decode-universal-time universal-time time-zone)
-             (decode-universal-time universal-time))
-       (let ((first-match-p t))
-         (ppcre:do-matches (start end "%[^%]*" date-control-string)
-           (let ((substring (subseq date-control-string start end)))
-             (multiple-value-bind (control value offset)
-                 (regex-case substring
-                   ("^%day-of-week"  (values "~D" day-of-week 12))
-                   ("^%@day-of-week" (values "~A"
-                                             (name-of-day day-of-week)
-                                             13))
-                   ("^%daylight-p"   (values "~A" daylight-p  11))
-                   ("^%zone"         (values "~D" zone 5))
-                   ("^%day"          (values "~D" day  4))
-                   ("^%mon"          (values "~D" mon  4))
-                   ("^%yr"           (values "~D" yr   3))
-                   ("^%sec"          (values "~D" sec  4))
-                   ("^%min"          (values "~D" min  4))
-                   ("^%hr"           (values "~D" hr   3))
-                   ("^%2day"         (values "~2,'0D" day  5))
-                   ("^%2mon"         (values "~2,'0D" mon  5))
-                   ("^%4yr"          (values "~4,'0D" yr   4))
-                   ("^%2sec"         (values "~2,'0D" sec  5))
-                   ("^%2min"         (values "~2,'0D" min  5))
-                   ("^%2hr"          (values "~2,'0D" hr   4)))
-               (when first-match-p
-                 (format out (subseq date-control-string 0 start))
-                 (setf first-match-p nil))
-               (if control
-                   (progn
-                     (format out control value)
-                     (format out "~A" (subseq substring offset)))
-                   (format out "~A" substring))))))))))
-
-
-(defun compute-journal-last-modified-date ()
-  #-clisp (get-universal-time)
-  #+clisp
-  (loop for file in (list* *script-filename*                    ;; journal.cgi
-                           (merge-pathnames (make-pathname :type "lisp")
-                                            *script-filename*)  ;; journal.lisp
-                           (find-journal-entry-files))
-        maximize (posix:file-stat-mtime (posix:file-stat file))))
-
-
 (defun link-to (action &key post-id (absolute nil))
   (with-output-to-string (out)
     (format out "~A" (if absolute
@@ -692,47 +321,3 @@ after another in any arbitrary order."
                                    :website ,website
                                    :body ,body))))
              :stream out))))
-
-
-#+clisp
-(defun main ()
-  (let ((*journal-entries* (read-journal-entries))
-        (*random-state* (make-random-state t)))
-    (ext:letf ((custom:*terminal-encoding* (ext:make-encoding
-                                            :charset charset:utf-8)))
-      (case *action*
-        (:post-comment   (let ((entry (find-entry *post-number*)))
-                           (push (make-instance 'journal-comment
-                                  :id (1+ (reduce #'max (comments-about entry)
-                                                  :key #'id-of
-                                                  :initial-value -1))
-                                  :uuid    (make-uuid)
-                                  :date    (get-universal-time)
-                                  :author  (getf *query* :author)
-                                  :email   (getf *query* :email)
-                                  :website (getf *query* :website)
-                                  :body    (getf *query* :comment-body))
-                                 (comments-about entry))
-                           (write-out-entry entry))
-                         (show-web-journal))
-        (:view-atom-feed (show-atom-feed))
-        (otherwise       (show-web-journal))))))
-
-
-#+clisp
-(handler-bind
-    ((error #'
-      (lambda (e)
-        (declare (ignorable 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))
diff --git a/main.lisp b/main.lisp
new file mode 100644
index 0000000..f27a989
--- /dev/null
+++ b/main.lisp
@@ -0,0 +1,110 @@
+;;;; -*- coding: utf-8; mode: lisp -*-
+;;;; Copyright 2007, Matthias Andreas Benkard.
+
+;;;------------------------------------------------------------------------
+;;; This file is part of The Mulkblog Project.
+;;;
+;;; The Mulkblog Project is free software.  You can redistribute it and/or
+;;; modify it under the terms of the Affero General Public License as
+;;; published by Affero, Inc.; either version 1 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; The Mulkblog Project is distributed in the hope that it will be
+;;; useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+;;; of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the Affero General Public
+;;; License in the COPYING file that comes with The Mulkblog Project; if
+;;; not, write to Affero, Inc., 510 Third Street, Suite 225, San
+;;; Francisco, CA 94107 USA.
+;;;------------------------------------------------------------------------
+
+(in-package #:mulk.journal)
+
+
+(defun call-with-initialised-journal (func)
+  (let* ((*site*            (if (file-exists-p #p"/home/mulk") :mst-plus :nfs.net))
+         (*debugging-p*     (eq *site* :mst-plus))
+         (*query*           #+clisp (mapcan #'(lambda (param)
+                                                (list (keywordify param)
+                                                      (ext:convert-string-from-bytes
+                                                       (ext:convert-string-to-bytes
+                                                        (http-query-parameter param)
+                                                        charset:iso-8859-1)
+                                                       charset:utf-8)))
+                                            (http-query-parameter-list))
+                            #-clisp '())
+         (*http-env*        (http-get-env-vars))
+         (*subpath-query*   (subseq (gethash "REQUEST_URI" *http-env*)
+                                    (length (if (eq *site* :mst-plus)
+                                                (gethash "SCRIPT_NAME" *http-env*)
+                                                "/journal"))))
+         (*subpath-string*  (subseq *subpath-query*
+                                    0
+                                    (or (position #\? *subpath-query*)
+                                        (length *subpath-query*))))
+         (*subpath*         (split-sequence #\/ *subpath-string*
+                                            :remove-empty-subseqs t))
+         (*post-number*     (parse-integer (or (first *subpath*)
+                                               (getf *query* :id ""))
+                                           :junk-allowed t  #|| :radix 12 ||#))
+         (*action*          (or (keywordify (getf *query* :action))
+                                (cond (*post-number*                      :view)
+                                      ((string= "feed" (first *subpath*)) :view-atom-feed)
+                                      (t                                  nil))))
+         (*method*          (keywordify (gethash "REQUEST_METHOD" *http-env*)))
+         (*script-filename* (pathname-as-file
+                             (or (gethash "SCRIPT_FILENAME" *http-env*)
+                                 "/home/mulk/Dokumente/Projekte/Mulkblog/journal.cgi")))
+         (*journal-entries* (read-journal-entries)))
+    (funcall func)))
+
+
+(defmacro with-initialised-journal (&body body)
+  `(call-with-initialised-journal #'(lambda () ,@body)))
+
+
+#+clisp
+(defun journal-main ()
+  (with-initialised-journal
+    (let ((*random-state* (make-random-state t)))
+      (ext:letf ((custom:*terminal-encoding* (ext:make-encoding
+                                              :charset charset:utf-8)))
+        (case *action*
+          (:post-comment   (let ((entry (find-entry *post-number*)))
+                             (push (make-instance 'journal-comment
+                                    :id (1+ (reduce #'max (comments-about entry)
+                                                    :key #'id-of
+                                                    :initial-value -1))
+                                    :uuid    (make-uuid)
+                                    :date    (get-universal-time)
+                                    :author  (getf *query* :author)
+                                    :email   (getf *query* :email)
+                                    :website (getf *query* :website)
+                                    :body    (getf *query* :comment-body))
+                                   (comments-about entry))
+                             (write-out-entry entry))
+                           (show-web-journal))
+          (:view-atom-feed (show-atom-feed))
+          (otherwise       (show-web-journal)))))))
+
+
+#+clisp
+(defun cl-user::script-main ()
+  (handler-bind
+      ((error #'
+        (lambda (e)
+          (declare (ignorable 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)))))))))
+    (journal-main)))
diff --git a/mulk-journal.asd b/mulk-journal.asd
new file mode 100644
index 0000000..3742d77
--- /dev/null
+++ b/mulk-journal.asd
@@ -0,0 +1,35 @@
+;;;; -*- coding: utf-8; mode: lisp -*-
+;;;; Copyright 2007, Matthias Andreas Benkard.
+
+;;;------------------------------------------------------------------------
+;;; This file is part of The Mulkblog Project.
+;;;
+;;; The Mulkblog Project is free software.  You can redistribute it and/or
+;;; modify it under the terms of the Affero General Public License as
+;;; published by Affero, Inc.; either version 1 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; The Mulkblog Project is distributed in the hope that it will be
+;;; useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+;;; of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the Affero General Public
+;;; License in the COPYING file that comes with The Mulkblog Project; if
+;;; not, write to Affero, Inc., 510 Third Street, Suite 225, San
+;;; Francisco, CA 94107 USA.
+;;;------------------------------------------------------------------------
+
+(asdf:defsystem #:mulk-journal
+  :description "Matthias Benkard's simple web journal engine"
+  :licence     "Affero General Public License, version 1 or higher"
+  :depends-on  (#:cl-ppcre #:cl-fad #:iterate #:cl-markdown #:parenscript
+                #:yaclml #:lisp-cgi-utils #:alexandria #:xml-emitter
+                #:split-sequence)
+  :components  ((:file "defpackage")
+                (:file "utils")
+                (:file "globals")
+                (:file "journal-content")
+                (:file "journal")
+                (:file "main"))
+  :serial      t)
diff --git a/run.lisp b/run.lisp
new file mode 100755
index 0000000..df60d76
--- /dev/null
+++ b/run.lisp
@@ -0,0 +1,55 @@
+#! /usr/bin/env clisp
+;;;; -*- coding: utf-8; mode: lisp -*-
+;;;; Copyright 2007, Matthias Andreas Benkard.
+
+;;;------------------------------------------------------------------------
+;;; This file is part of The Mulkblog Project.
+;;;
+;;; The Mulkblog Project is free software.  You can redistribute it and/or
+;;; modify it under the terms of the Affero General Public License as
+;;; published by Affero, Inc.; either version 1 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; The Mulkblog Project is distributed in the hope that it will be
+;;; useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+;;; of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the Affero General Public
+;;; License in the COPYING file that comes with The Mulkblog Project; if
+;;; not, write to Affero, Inc., 510 Third Street, Suite 225, San
+;;; Francisco, CA 94107 USA.
+;;;------------------------------------------------------------------------
+
+(in-package #:cl-user)
+
+;;; TAKE NOTICE: If you want to run this script from the command line or
+;;; from a web server, be sure to use a core image including the systems
+;;; this script depends upon.  The ASDF system definition has mainly
+;;; been written for purposes of debugging, development and
+;;; documentation.
+
+
+(defclass load-source-simple-op (asdf:operation) ())
+(defmethod asdf:perform ((o load-source-simple-op) (c asdf:component))
+  nil)
+(defmethod asdf:perform ((o load-source-simple-op) (m asdf:module))
+  (dolist (c (asdf:module-components m))
+    (load (asdf:component-pathname c))))
+
+
+;;; The following does not generally work in a CGI setting because of
+;;; security restrictions.  Then again, loading all the dependencies
+;;; individually rather than using a core image would certainly be too
+;;; slow for any serious CGI usage, anyway, so what the heck.
+(ignore-errors
+  (unless (asdf:find-system :mulk-journal nil)
+    (let ((*package* (find-package :asdf)))
+      (load "mulk-journal.asd")))
+
+  (unless (find-package '#:mulk.journal)
+    (asdf:oos 'load-source-simple-op '#:mulk-journal)))
+
+
+#+clisp
+(script-main)
diff --git a/utils.lisp b/utils.lisp
new file mode 100644
index 0000000..842bb0f
--- /dev/null
+++ b/utils.lisp
@@ -0,0 +1,167 @@
+;;;; -*- coding: utf-8; mode: lisp -*-
+;;;; Copyright 2007, Matthias Andreas Benkard.
+
+;;;------------------------------------------------------------------------
+;;; This file is part of The Mulkblog Project.
+;;;
+;;; The Mulkblog Project is free software.  You can redistribute it and/or
+;;; modify it under the terms of the Affero General Public License as
+;;; published by Affero, Inc.; either version 1 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; The Mulkblog Project is distributed in the hope that it will be
+;;; useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+;;; of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the Affero General Public
+;;; License in the COPYING file that comes with The Mulkblog Project; if
+;;; not, write to Affero, Inc., 510 Third Street, Suite 225, San
+;;; Francisco, CA 94107 USA.
+;;;------------------------------------------------------------------------
+
+(in-package #:mulk.journal)
+
+
+(defun keywordify (thing)
+  (if (null thing)
+      thing
+      (intern (etypecase thing
+                (string (string-upcase thing))
+                (symbol (symbol-name   thing)))
+              '#:keyword)))
+
+
+(defun make-uuid ()
+  "Generate a version 4 UUID according to RFC 4122, section 4.4."
+  (format nil "~(~8,'0x-~4,'0x-~4,'0x-~2,'0x~2,'0x-~12,'0x~)"
+          (random #x100000000)                ;; time_low
+          (random #x10000)                    ;; time_mid
+          (logior #b0100000000000000
+                  (logand #b0000111111111111
+                          (random #x10000))) ;; time_hi_and_version
+          (logior #b10000000
+                  (logand #b00111111
+                          (random #x100))) ;; clock_seq_hi_and_reserved
+          (random #x100)                   ;; clock_seq_low
+          (random #x1000000000000)))       ;; node
+
+
+(defun fixup-markdown-output (markup)
+  ;; No, cl-markdown is certainly not perfect.
+  ;;
+  ;; First, convert "<a ...> bla</a>" into " <a ...>bla</a>" (note the
+  ;; excess space to the right of the opening tag in the unprocessed
+  ;; string, which we move to the left of the same opening tag, where we
+  ;; expect it to make more sense in the general case).
+  (loop
+     for matches = (ppcre:all-matches "<a [^>]*?> " markup)
+     while (not (null matches))
+     do (progn
+          (setf markup
+                (replace markup markup :start1 (1+ (first matches))
+                                       :end1 (second matches)
+                                       :start2 (first matches)
+                                       :end2 (1- (second matches))))
+          (setf (elt markup (first matches)) #\Space)))
+  markup)
+
+
+(defun find-journal-entry-files ()
+  (let ((directory
+         (make-pathname
+          :directory (pathname-directory
+                      (merge-pathnames
+                       (make-pathname :directory '(:relative "journal-entries")
+                                      :name nil)
+                       *script-filename*))))
+        (journal-entry-files (list)))
+    (when (file-exists-p directory)
+      (walk-directory directory
+                      #'(lambda (x)
+                          (push x journal-entry-files))
+                      :test (complement #'directory-pathname-p)))
+    journal-entry-files))
+
+
+(defun read-journal-entries ()
+  (let ((journal-entry-files (find-journal-entry-files)))
+    (sort (mapcar #'read-journal-entry journal-entry-files)
+          #'>=
+          :key #'id-of)))
+
+
+(defmacro regex-case (string &body clauses)
+  (once-only (string)
+    `(cond ,@(loop for (keys . forms) in clauses
+                collect
+                  `(,(if (and (symbolp keys)
+                              (or (eq t keys)
+                                  (equal "OTHERWISE" (symbol-name keys))))
+                         't
+                         `(or ,@(loop for key in (if (listp keys)
+                                                     keys
+                                                     (list keys))
+                                   collect
+                                     `(ppcre:scan-to-strings ,key ,string))))
+                     ,@forms)))))
+
+
+(defun name-of-day (day-of-week)
+  (case day-of-week
+    (0 "Montag")
+    (1 "Dienstag")
+    (2 "Mittwoch")
+    (3 "Donnerstag")
+    (4 "Freitag")
+    (5 "Samstag")
+    (6 "Sonntag")))
+
+
+(defun format-date (destination date-control-string universal-time
+                    &optional (time-zone nil time-zone-supplied-p))
+  "Format DATE according to the description given by DATE-FORMAT-STRING.
+
+Recognised format directives are: %day, %mon, %yr, %day-of-week, %zone,
+%@day-of-week (name of day), %sec, %min, %hr, %daylight-p.
+
+Note that you can mix FORMAT and FORMAT-DATE painlessly by calling them
+after another in any arbitrary order."
+  (format
+   destination "~A"
+   (with-output-to-string (out)
+     (multiple-value-bind (sec min hr day mon yr day-of-week daylight-p zone)
+         (if time-zone-supplied-p
+             (decode-universal-time universal-time time-zone)
+             (decode-universal-time universal-time))
+       (let ((first-match-p t))
+         (ppcre:do-matches (start end "%[^%]*" date-control-string)
+           (let ((substring (subseq date-control-string start end)))
+             (multiple-value-bind (control value offset)
+                 (regex-case substring
+                   ("^%day-of-week"  (values "~D" day-of-week 12))
+                   ("^%@day-of-week" (values "~A"
+                                             (name-of-day day-of-week)
+                                             13))
+                   ("^%daylight-p"   (values "~A" daylight-p  11))
+                   ("^%zone"         (values "~D" zone 5))
+                   ("^%day"          (values "~D" day  4))
+                   ("^%mon"          (values "~D" mon  4))
+                   ("^%yr"           (values "~D" yr   3))
+                   ("^%sec"          (values "~D" sec  4))
+                   ("^%min"          (values "~D" min  4))
+                   ("^%hr"           (values "~D" hr   3))
+                   ("^%2day"         (values "~2,'0D" day  5))
+                   ("^%2mon"         (values "~2,'0D" mon  5))
+                   ("^%4yr"          (values "~4,'0D" yr   4))
+                   ("^%2sec"         (values "~2,'0D" sec  5))
+                   ("^%2min"         (values "~2,'0D" min  5))
+                   ("^%2hr"          (values "~2,'0D" hr   4)))
+               (when first-match-p
+                 (format out (subseq date-control-string 0 start))
+                 (setf first-match-p nil))
+               (if control
+                   (progn
+                     (format out control value)
+                     (format out "~A" (subseq substring offset)))
+                   (format out "~A" substring))))))))))