Assorted fixes and improvements.

This commit is contained in:
Brit Butler 2012-08-20 23:20:25 -04:00
parent ca37d63df8
commit e9b6ac1c0f
3 changed files with 18 additions and 13 deletions

View file

@ -27,16 +27,15 @@
(format nil "~a-~2,'0d-~2,'0d ~a" year (position month +short-month-names+ (format nil "~a-~2,'0d-~2,'0d ~a" year (position month +short-month-names+
:test #'string=) date time))) :test #'string=) date time)))
(defun import-post (post) (defun import-post (post &optional (since nil since-supplied-p))
(when (and (string= "publish" (node-val "wp:status" post)) ; is it public? (when (and (string= "publish" (node-val "wp:status" post)) ; is it public?
(string= "post" (node-val "wp:post_type" post)) ; is it a post? (string= "post" (node-val "wp:post_type" post)) ; is it a post?
(string>= (get-timestamp post) "2007-05")) (or (not since-supplied-p) (string>= (get-timestamp post) since)))
(let ((content (node-val "content:encoded" post)) (let ((slug (slugify (node-val "title" post))))
(slug (slugify (node-val "title" post))))
(when (string= "" slug) (when (string= "" slug)
(error "No valid slug-title for post ~a." (get-timestamp post))) (error "No valid slug-title for post ~a." (get-timestamp post)))
(export-post (node-val "title" post) (node-val "category" post) (export-post (node-val "title" post) (node-val "category" post)
(get-timestamp post) content (get-timestamp post) (node-val "content:encoded" post)
(format nil "~a.post" slug))))) (format nil "~a.post" slug)))))
(defun export-post (title tags date content path) (defun export-post (title tags date content path)
@ -47,15 +46,15 @@
;; TODO: What other data/metadata should we write out? ;; TODO: What other data/metadata should we write out?
(format out ";;;;;~%") (format out ";;;;;~%")
(format out "title: ~A~%" title) (format out "title: ~A~%" title)
(format out "tags: ~A~%" (format nil "~{~A, ~}" tags)) (format out "tags: ~A~%" (format nil "~{~A~^, ~}" tags))
(format out "date: ~A~%" date) (format out "date: ~A~%" date)
(format out "format: html~%") ; post format: html, md, rst, etc (format out "format: html~%") ; post format: html, md, rst, etc
(format out ";;;;;~%") (format out ";;;;;~%")
(format out "~A~%" (regex-replace-all (string #\Newline) content "<br>")))) (format out "~A~%" (regex-replace-all (string #\Newline) content "<br>"))))
(defun import-posts (filepath) (defun import-posts (filepath &optional since)
(let* ((xml (cxml:parse-file filepath (cxml-dom:make-dom-builder))) (let* ((xml (cxml:parse-file filepath (cxml-dom:make-dom-builder)))
(posts (dom:get-elements-by-tag-name xml "item"))) (posts (dom:get-elements-by-tag-name xml "item")))
(load-config) (load-config)
(ensure-directories-exist (repo *config*)) (ensure-directories-exist (repo *config*))
(loop for post across posts do (import-post post)))) (loop for post across posts do (import-post post since))))

View file

@ -5,6 +5,10 @@
If ARGS is provided, use (apply 'format nil PATH ARGS) as the value of PATH." If ARGS is provided, use (apply 'format nil PATH ARGS) as the value of PATH."
(merge-pathnames (apply 'format nil path args) coleslaw-conf:*basedir*)) (merge-pathnames (apply 'format nil path args) coleslaw-conf:*basedir*))
(defun make-keyword (string)
"Return a keyword matching STRING."
(intern (string-upcase string) :keyword))
(defun to-pathname (file parent) (defun to-pathname (file parent)
"Convert an iolib file-path back to a pathname." "Convert an iolib file-path back to a pathname."
(merge-pathnames (file-path-namestring file) parent)) (merge-pathnames (file-path-namestring file) parent))
@ -44,15 +48,15 @@ on files that match the given extension."
"Compile the blog to a staging directory in /tmp." "Compile the blog to a staging directory in /tmp."
(let ((staging #p"/tmp/coleslaw/")) (let ((staging #p"/tmp/coleslaw/"))
; TODO: More incremental compilation? Don't regen whole blog unnecessarily. ; TODO: More incremental compilation? Don't regen whole blog unnecessarily.
(if (probe-file staging) (when (probe-file staging)
(delete-files staging :recursive t) (delete-files staging :recursive t))
(ensure-directories-exist staging)) (ensure-directories-exist staging)
(with-current-directory staging (with-current-directory staging
(let ((css-dir (app-path "themes/~a/css/" (theme *config*))) (let ((css-dir (app-path "themes/~a/css/" (theme *config*)))
(static-dir (merge-pathnames "static/" (repo *config*)))) (static-dir (merge-pathnames "static/" (repo *config*))))
(dolist (dir (list css-dir static-dir)) (dolist (dir (list css-dir static-dir))
(when (probe-file dir) (when (probe-file dir)
(run-program "cp" `("-R" ,dir "."))))) (run-program "cp" `("-R" ,(namestring dir) ".")))))
(render-posts) (render-posts)
(render-indices)) (render-indices))
(deploy staging) (deploy staging)

View file

@ -40,9 +40,11 @@
for line = (read-line in nil) for line = (read-line in nil)
when (not (search field line :test #'string=)) when (not (search field line :test #'string=))
do (error "The provided file lacks the field ~a." field) do (error "The provided file lacks the field ~a." field)
appending (list (intern (string-upcase field) :keyword) appending (list (make-keyword field)
(aref (parse-field (read-line in)) 0))))) (aref (parse-field (read-line in)) 0)))))
(check-header) (check-header)
(setf (getf args :tags) (cl-ppcre:split ", " (getf args :tags))
(getf args :format) (make-keyword (getf args :format)))
(apply 'make-instance 'blog (apply 'make-instance 'blog
(append args (list :content (slurp-remainder) (append args (list :content (slurp-remainder)
:slug (slugify (getf args :title)))))))) :slug (slugify (getf args :title))))))))