Below is a selection of code I have written and the output it generates. The part that function generates a nested list of lists for a tree control. My system runs under Huchentoot. I use Lispworks under Windows.
The output looks good. I can run it approx 10 times in a row. Then something fails. Among the errors are:
1. MySQL: 2006 - connection lost
2. MySQL: "select * from blog-header where (id = 199)" selector just be one row
3. The browser dons't update at all. When I go back other pages show incorrect data.
I have isolated it to navigate-blog, navigate-year and navigate-month functions. I tried completly rewiting it (this is the second version), but get the same problem.
Any idea what is happening here?
(defun remove-prefix (uri prefix) "Returns the prefix from an uri in search of a blog name. Big assumtion: Blog names consists only of latin characters." (let ((scanstring (concatenate 'string prefix "([A-Za-z]+)"))) (multiple-value-bind (dummy matchvector) (scan-to-strings scanstring uri) (declare (ignore dummy)) (if matchvector (svref matchvector 0) ""))))
(defconstant *month-abbrev* (list "jan" "feb" "mar" "apr" "may" "jun" "jul" "aug" "sep" "oct" "nov" "dec"))
(defun get-month-string (month) (nth (decf month) *month-abbrev*))
(defun extract-year (date-string) (parse-integer (subseq date-string 0 4)))
(defun extract-month (date-string) (parse-integer (subseq date-string 5 7)))
;; Result format: ((year (month (date title url) ...) ...) ...)
(defun make-navigate-list (item-list name) (let (last-year last-month year-list month-list result-list) (iter (for item in (reverse item-list)) (let* ((date-string (getf item :pub_time)) (year (extract-year date-string)) (month (extract-month date-string)))
(when (or (not last-year) (< year last-year)) (setf last-year year) (setf last-month nil) (when month-list (push (reverse month-list) year-list)) (setf month-list nil) (when year-list (push (reverse year-list) result-list)) (setf year-list (list (format nil "~D" year))))
(when (or (not last-month) (< month last-month)) (setf last-month month) (when month-list (push (reverse month-list) year-list)) (setf month-list (list (get-month-string month))))
(push (list (subseq (getf item :pub_time) 0 10) (or (getf item :title) "") (format nil "~A?id=~D" name (getf item :id))) month-list))) (when month-list (push (reverse month-list) year-list)) (when year-list (push (reverse year-list) result-list))
(reverse result-list)))
(defun navigate-month (month-list) (with-html-output-to-string (*standard-output* nil :prologue nil :indent t) (:li (:a :href (format nil "/~A/" (first month-list)) (fmt "~A" (first month-list))) (:ul (iter (for item in (rest month-list)) (htm (:li (:a :href (third item) (fmt "~A ~A" (first item) (second item))))))))))
(defun navigate-year (year-list) (with-html-output-to-string (*standard-output* nil :prologue nil :indent t) (:li (:a :href (format nil "/~A/" (first year-list)) (fmt "~A" (first year-list))) (iter (for month-list in (rest year-list)) (htm (:ul (fmt "~A" (navigate-month month-list))))))))
(defun navigate-blog (items name) (let ((navigate-list (make-navigate-list items name))) (with-html-output-to-string (*standard-output* nil :prologue nil :indent t) (:div :id "bloglist" (:ul :id "navigation" :class "foldertree" (iter (for year-list in navigate-list) (fmt "~A" (navigate-year year-list))))))))
(defun present-blog (blog) (let* ((item-id (or (and (get-parameter "id") (parse-integer (get-parameter "id"))) (latest-blog-item-id (getf blog :name)))) (item (get-blog-item item-id))) (with-html-output-to-string (*standard-output* nil :prologue t :indent t) (:html :xmlns "http://www.w3.org/1999/xhtml" (:head (:title (fmt "~A - ~A" (escape-string (getf blog :title)) (escape-string (getf item :title)))) (:link :href *blog-css-file* :rel "stylesheet" :type "text/css") (:link :href *tree-css-file* :rel "stylesheet" :type "text/css" :media "screen, projection") (:script :type "text/javascript" :src *tree-js-file* "")) (:body (:div :id "left-column" (:a :href *blog-homepage* "Blog home") (fmt "~A" (navigate-blog (get-items (getf blog :id)) (script-name)))) (:div :id "wrapper" (:div :id "header" (:h1 (escape-string (fmt "~A" (escape-string (getf blog :title)))))) (:div :id "main" (if item (htm (:h3 (fmt "~A" (escape-string (getf item :title)))) (:h4 (fmt "~A" (escape-string (getf item :pub_time)))) (:p (fmt "~A" (or (getf item :contents) "")))) (htm (:p (:em "This blog is empty!")))))))))))
(defun no-blog () (with-html-output-to-string (*standard-output* nil :prologue t :indent t) (:html :xmlns "http://www.w3.org/1999/xhtml" (:head (:title "Error") (:link :href *blog-css-file* :rel "stylesheet" :type "text/css")) (:body (:div :id "left-column" (:a :href *blog-homepage* "Blog home")) (:div :id "wrapper" (:div :id "header" (:h1 :class "middle" "Error!")) (:div :id "main" (:h2 :class "middle" "No such page") (:p :class "middle" "The blog that you requested does not exist!")))))))
(defun blog-page () (no-cache) (let ((blog (get-blog (remove-prefix (script-name) *blog-prefix*)))) (if blog (present-blog blog) (no-blog))))
;;-----------------------------------------------------------------------------------------------------------
Which generatates something like the following
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"> <html xmlns='http://www.w3.org/1999/xhtml'> <head> <title>Many Items blog - Tomorrow </title> <link href='/static-files/stylesheet.css' rel='stylesheet' type='text/css' /> <link href='/static-files/foldertree.css' rel='stylesheet' type='text/css' media='screen, projection' /> <script type='text/javascript' src='/static-files/treeMenu.js'>
</script> </head> <body> <div id='left-column'> <a href='/blogs.html'> Blog home </a> <div id='bloglist'> <ul id='navigation' class='foldertree'> <li> <a href='/2007/'>2007 </a> <ul> <li> <a href='/jul/'>jul </a> <ul> <li> <a href='/blogs/many?id=204'>2007-07-18 Tomorrow </a> </li> <li> <a href='/blogs/many?id=202'>2007-07-18 Tomorrow </a> </li> <li> <a href='/blogs/many?id=200'>2007-07-18 Tomorrow </a> </li> <li> <a href='/blogs/many?id=199'>2007-07-17 Today </a> </li> <li> <a href='/blogs/many?id=201'>2007-07-17 Today </a> </li> <li> <a href='/blogs/many?id=203'>2007-07-17 Today </a> </li> <li> <a href='/blogs/many?id=193'>2007-07-17 First item </a> </li> </ul> </li> </ul> <ul> <li> <a href='/jun/'>jun </a> <ul> <li> <a href='/blogs/many?id=198'>2007-06-12 Hollydays </a> </li> <li> <a href='/blogs/many?id=194'>2007-06-11 Second item </a> </li> </ul> </li> </ul> <ul> <li> <a href='/mar/'>mar </a> <ul> <li> <a href='/blogs/many?id=197'>2007-03-15 Easter </a> </li> </ul> </li> </ul> </li> <li> <a href='/2006/'>2006 </a> <ul> <li> <a href='/dec/'>dec </a> <ul> <li> <a href='/blogs/many?id=195'>2006-12-24 Christmas </a> </li> </ul> </li> </ul> <ul> <li> <a href='/mar/'>mar </a> <ul> <li> <a href='/blogs/many?id=196'>2006-03-14 Easter </a> </li> </ul> </li> </ul> </li> </ul> </div> </div> <div id='wrapper'> <div id='header'> <h1>Many Items blog </h1> </div> <div id='main'> <h3>Tomorrow </h3> <h4>2007-07-18 00:00:00 </h4> <p> </p> </div> </div> </body> </html>