A fresh start. Also, remove split-sequence dep from importer.

This commit is contained in:
Brit Butler 2012-08-15 00:02:22 -04:00
parent 8c0b1f8697
commit 011d97b065
9 changed files with 4 additions and 311 deletions

5
TODO
View file

@ -16,7 +16,7 @@ Where is the data? git
How is the data edited? git status/inotify How is the data edited? git status/inotify
Post generation? Static Post generation? Static
What is the post format? (markdown, plaintext, rst, etc, anything with a parser plugin!) What is the post format? (markdown, plaintext, rst, etc, anything with a parser plugin!)
How are comments handled? They're not supported. If they are, its by a friggin plugin. How are comments handled? They're not supported.
What about themes? Templates are themes. DUH. What about themes? Templates are themes. DUH.
Plugins? Injection support for HEAD and BODY. What about predicate-based injection? Plugins? Injection support for HEAD and BODY. What about predicate-based injection?
How is it served? Hunchentoot, Lighttpd, S3, whomever! How is it served? Hunchentoot, Lighttpd, S3, whomever!
@ -54,6 +54,3 @@ TODO:
;;; import ;;; import
;; add comment handling ... (when comments ...) ;; add comment handling ... (when comments ...)
;; support old URLs via use of post-aliases? ;; support old URLs via use of post-aliases?
;;;; DYNAMIC
;;;; Scrap that shit!

View file

@ -10,7 +10,6 @@
:components ((:file "packages") :components ((:file "packages")
(:file "coleslaw") (:file "coleslaw")
(:file "themes") (:file "themes")
(:file "comments")
(:file "posts") (:file "posts")
(:file "indices") (:file "indices")
(:file "plugins")) (:file "plugins"))
@ -29,4 +28,3 @@
(defmethod operation-done-p ((op test-op) (defmethod operation-done-p ((op test-op)
(c (eql (find-system :coleslaw)))) (c (eql (find-system :coleslaw))))
(values nil)) (values nil))

View file

@ -1,11 +1,10 @@
(eval-when (:compile-toplevel) (eval-when (:compile-toplevel)
(ql:quickload '(cxml split-sequence local-time cl-ppcre))) (ql:quickload '(cxml cl-ppcre)))
(defpackage :coleslaw-import (defpackage :coleslaw-import
(:use :cl :coleslaw :cxml) (:use :cl :coleslaw :cxml)
(:import-from :local-time #:+short-month-names+ (:import-from :local-time #:+short-month-names+
#:encode-timestamp) #:encode-timestamp)
(:import-from :split-sequence #:split-sequence)
(:import-from :cl-ppcre #:regex-replace-all)) (:import-from :cl-ppcre #:regex-replace-all))
(in-package :coleslaw-import) (in-package :coleslaw-import)
@ -30,8 +29,8 @@ object is determined by SERVICE."))
(post-p () (post-p ()
(string= "post" (node-val "wp:post_type"))) (string= "post" (node-val "wp:post_type")))
(make-timestamp (pubdate) (make-timestamp (pubdate)
(let* ((date (split-sequence #\Space (subseq pubdate 5))) (let* ((date (cl-ppcre:split " " (subseq pubdate 5)))
(time (split-sequence #\: (fourth date)))) (time (cl-ppcre:split ":" (fourth date))))
(encode-timestamp 0 (encode-timestamp 0
(parse-integer (third time)) (parse-integer (third time))
(parse-integer (second time)) (parse-integer (second time))

View file

@ -1,39 +0,0 @@
(in-package :coleslaw)
(defclass author ()
((name :initform nil :initarg :name
:accessor author-name)
(url :initform nil :initarg :url
:accessor author-url)
(ip :initform nil :initarg :ip
:accessor author-ip)))
(defclass comment ()
((id :initform nil :initarg :id
:accessor comment-id)
(post :initform nil :initarg :post
:accessor comment-post)
(author :initform nil :initarg :author
:accessor comment-author)
(timestamp :initform nil :initarg :timestamp
:accessor comment-timestamp)
(content :initform nil :initarg :content
:accessor comment-content)
(parent :initform nil :initarg :parent
:accessor comment-parent)))
(defgeneric make-comment (post author timestamp content
parent &key id &allow-other-keys)
(:documentation "Create a COMMENT with the given data."))
(defgeneric add-comment (comment post-id)
(:documentation "Add COMMENT to POST-ID."))
(defgeneric delete-comment (comment post-id)
(:documentation "Delete COMMENT from POST-ID."))
(defgeneric render-comments (post-id)
(:documentation "Render the comments for POST-ID."))
(defgeneric find-comments (post-id)
(:documentation "Find the comments for POST-ID."))

View file

@ -1,110 +0,0 @@
(in-package :coleslaw)
(defvar *site-root* nil
"A string representing the base URL of the site,
e.g. \"http://blog.redlinernotes.com\".")
(defvar *site-title* nil
"A string containing the title of the site,
e.g. \"Improved Means for Achieving Deterioriated Ends\".")
(defvar *site-credits* nil
"A string containing the credits of the site,
e.g. \"Brit Butler (year)\".")
(defvar *site-license* nil
"A string containing the (optional) license of the site,
e.g. \"CC-BY-SA\". Otherwise, standard copyright is assumed.")
(defvar *site-navigation* nil
"A string of HTML describing a navbar or similar structure.")
(defvar *output-dir* nil
"The path where the compiled coleslaw site will be output.")
(defvar *input-dir* nil
"The directory which will be watched for new posts.")
(defun static-init ()
(setf *storage* (make-hash-table))
(loop for table in '(:authors :comments :posts :credentials)
do (setf (gethash table *storage*) (make-hash-table)))
(setf (gethash :indices *storage*) (make-hash-table :test #'equal)))
(defmethod start-coleslaw (&rest options)
)
(defmethod stop-coleslaw (&rest options)
)
(defmethod get-credentials (name)
(gethash name (gethash :credentials *storage*)))
(defmethod set-credentials (name credentials)
(setf (gethash name (gethash :credentials *storage*)) credentials))
(defmethod add-injection ((str string) location)
(pushnew str (gethash location *storage*) :test #'string))
(defmethod remove-injection ((str string) location)
(setf (gethash location *storage*)
(remove str (gethash location *storage*) :test #'string=)))
(defmethod render-page (content)
(let ((result (funcall (find-symbol "BASE" (theme-package))
(list :title *site-title*
:siteroot *site-root*
:head-inject (apply #'concatenate 'string
(gethash :head *storage*))
:navigation *site-navigation*
:content content
:body-inject (apply #'concatenate 'string
(gethash :body *storage*))
:license *site-license*
:credits *site-credits*))))
result))
(defun write-post (post)
(let* ((id (post-id post))
(filepath (merge-pathnames (post-file id)
*output-dir*)))
(ensure-directories-exist filepath)
(with-open-file (out filepath :direction :output
:if-exists :supersede :if-does-not-exist :create)
(write-string (render-page (render-post id)) out))))
(defun write-index (index)
(let* ((count (length (index-posts index)))
(pages (ceiling (/ count 10)))
(id (index-id index)))
(ensure-directories-exist
(cl-fad:pathname-as-directory (merge-pathnames id *output-dir*)))
(loop for page from 1 to pages do
(let ((filepath (merge-pathnames (index-file id page)
*output-dir*)))
(with-open-file (out filepath :direction :output
:if-exists :supersede :if-does-not-exist :create)
(write-string (render-page (render-index id page)) out))))))
(defmethod render-site ()
(flet ((copy-dir (from to)
(cl-fad:walk-directory from
(lambda (file)
(let ((name (concatenate 'string
(pathname-name file) "."
(pathname-type file))))
(cl-fad:copy-file file (merge-pathnames name to)))))))
(when (cl-fad:directory-exists-p *output-dir*)
(cl-fad:delete-directory-and-files *output-dir*))
(ensure-directories-exist *output-dir*)
(let ((css-dir (merge-pathnames "css/" *output-dir*))
(static-dir (merge-pathnames "static/" *output-dir*)))
(ensure-directories-exist css-dir)
(ensure-directories-exist static-dir)
;; TODO: Copy-dir dies if the directories aren't there...
(copy-dir (merge-pathnames "css/" *theme-dir*) css-dir)
(copy-dir (merge-pathnames "static/" *input-dir*) static-dir))
(loop for post being the hash-values in (gethash :posts *storage*)
do (write-post post))
(loop for index being the hash-values in (gethash :indices *storage*)
do (write-index index))))

View file

@ -1,2 +0,0 @@
(in-package :coleslaw)

View file

@ -1,73 +0,0 @@
(in-package :coleslaw)
(defmethod make-index (id posts)
(make-instance 'index :id id :posts posts))
(defmethod find-index (id)
(gethash id (gethash :indices *storage*)))
(defun (setf find-index) (new-val id)
(setf (gethash id (gethash :indices *storage*)) new-val)
new-val)
(defmethod add-to-index (id (post post))
(let ((index (find-index id)))
(if index
(push post (index-posts index))
(setf index (make-index id (list post))))
(setf (find-index id) index)))
(defmethod remove-from-index (id (post post))
(let ((index (find-index id)))
(setf (index-posts index) (remove post (index-posts index)))
(if (index-posts index)
(setf (find-index id) index)
(remhash id (gethash :indices *storage*)))))
(defun monthlinks ()
(loop for month in (gethash :months-list *storage*)
collecting (list :url (index-url (concatenate 'string "date/" month) 1)
:name month)))
(defun taglinks ()
(loop for tag in (gethash :tags-list *storage*)
collecting (list :url (index-url (concatenate 'string "tag/" tag) 1)
:name tag)))
(defun index-title (id)
(let ((split-id (split-sequence:split-sequence #\/ id)))
(cond ((string= "date" (first split-id))
(format nil "Posts from ~A" (second split-id)))
((string= "tag" (first split-id))
(format nil "Posts tagged ~A" (second split-id)))
(t (format nil "Recent Posts")))))
(defmethod render-index (id page)
(let* ((index-posts (index-posts (find-index id)))
(start (* 10 (1- page)))
(end (if (> (length index-posts) (+ start 9))
(+ start 9)
(length index-posts)))
(posts (subseq index-posts start end))
(content (funcall (find-symbol "INDEX" (theme-package))
(list :taglinks (taglinks)
:monthlinks (monthlinks)
:title (index-title id)
:posts (loop for post in posts collect
(list :url (post-url (post-id post))
:title (post-title post)
:date (pretty-date (post-date post))
:contents (post-content post)))
:prev (when (> page 1)
(index-url id (1- page)))
:next (when (< (* 10 page) (length index-posts))
(index-url id (1+ page)))))))
content))
(defun index-file (id page)
(if (string= "recent" id)
(concatenate 'string (write-to-string page) ".html")
(concatenate 'string id "/" (write-to-string page) ".html")))
(defmethod index-url (id page)
(concatenate 'string *site-root* "/" (index-file id page)))

View file

@ -1,58 +0,0 @@
(in-package :coleslaw)
(defmethod make-post (title tags date content &key id aliases)
(make-instance 'post :id (incf (gethash :posts-index *storage* 0))
:title title
:tags tags
:date date
:content content
:aliases aliases))
(defmethod find-post (id)
(gethash id (gethash :posts *storage*)))
(defun (setf find-post) (new-val id)
(setf (gethash id (gethash :posts *storage*)) new-val)
new-val)
(defmethod add-post ((post post) id)
(setf (find-post id) post)
(add-to-index "recent" post)
(loop for tag in (post-tags post) do
(pushnew tag (gethash :tags-list *storage*) :test #'string=)
(add-to-index (concatenate 'string "tag/" tag) post))
(let ((year-month (year-month (post-date post))))
(pushnew (year-month (post-date post))
(gethash :months-list *storage*) :test #'string=)
(add-to-index (concatenate 'string "date/" year-month) post)))
(defmethod remove-post (id)
;; Removes post from storage and indexes but not disk! Should we support more?
(let ((post (find-post id)))
(loop for tag in (post-tags post) do
(remove-from-index (concatenate 'string "tag/" tag) post))
(remove-from-index (concatenate 'string "date/"
(year-month (post-date post))) post)
(remove-from-index "recent" post)
(setf (find-post id) nil)))
(defmethod render-post (id)
(let* ((post (find-post id))
(result (funcall (theme-fn "POST")
(list :title (post-title post)
:tags (pretty-list (post-tags post))
:date (pretty-date (post-date post))
:content (post-content post)
:prev (when (find-post (1- id))
(post-url (1- id)))
:next (when (find-post (1+ id))
(post-url (1+ id)))))))
result))
(defun post-file (id)
(let ((post (find-post id)))
(concatenate 'string (year-month (post-date post)) "/"
(escape (post-title post)) ".html")))
(defmethod post-url (id)
(concatenate 'string *site-root* "/" (post-file id)))

View file

@ -1,19 +0,0 @@
(in-package :coleslaw)
(defun pretty-date (date)
(subseq (local-time:format-rfc1123-timestring nil date) 0 16))
(defun pretty-list (list)
(format nil "~{~A~^, ~}" list))
(defun year-month (date)
(format nil "~4d-~2,'0d" (local-time:timestamp-year date)
(local-time:timestamp-month date)))
(defun theme-fn (name)
(find-symbol name (theme-package)))
(defun escape (str)
(substitute #\. #\/
(substitute #\_ #\?
(substitute #\- #\Space str))))