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
Post generation? Static
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.
Plugins? Injection support for HEAD and BODY. What about predicate-based injection?
How is it served? Hunchentoot, Lighttpd, S3, whomever!
@ -54,6 +54,3 @@ TODO:
;;; import
;; add comment handling ... (when comments ...)
;; support old URLs via use of post-aliases?
;;;; DYNAMIC
;;;; Scrap that shit!

View file

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

View file

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