用Clojure和Emacs写博客
写作的最佳环境还是Emacs编辑器, 网页界面的编辑器无论多么强大, 永远也不可能比得上Emacs. 但是我想更进一步, 完全不考虑web界面, 所有的动作, 发布, 修改, 更新都在Emacs里面完成, 这样的话, Emacs就显得有点不足, 编辑本身才是他的强项, 而其他的任务例如和HTTP, FTP, 文件系统打交道更适合像Clojure这样的脚本语言.
而Clojure的REPL可以完全融合在Emacs里面, 那么整个过程都不需要离开Emacs就可以完成.
下面的Clojure代码可以完成HTTP POST, FTP文件上传, 管理已发布的内容等功能.
用法:
;; 创建一篇文章 (projet post-short-name create) ;; 设置标题 (projet post-short-name set-title "标题") ;; 设置分类 (projet post-short-name set-cat "default") ;; 用Emacs编辑正文 (projet post-short-name set-cat edit) ;; 发布或者更新 (projet post-short-name set-cat build) ;; 查找任何包含emas的project id (project "*emacs*" list)
提交POST的时候, 要带一个cookie值, 网站后台应该识别这个cookie值, 并允许访问, 其他的字段例如标题, 正文, 可以通过HTTP参数来提交.
(require '[clj-http.client :as client]) ;; ftp component (require '[miner.ftp :as ftp]) (def project-home "C:\\codebase\\blogpostv2") (defn project-exist [proj] (is-dir (str project-home "\\" proj)) ) (def tag-list '( ;; we may use this to validate input taglist )) (defn mkdir [path] (let [ f (java.io.File. path)] (.mkdir f) ) ) (defn proj-conf-file [proj] (str project-home "\\" proj "\\project.proj") ) (defn read-file-as-text [file] (slurp file) ) (defn read-map-from-file [file] (read-string (read-file-as-text file)) ) (defn write-map-to-file [map file] (spit file (str map)) ) (defn load-db [db-file] (read-map-from-file db-file) ) (defn boot-db [db-file] (write-map-to-file [] db-file) [] ) (defn load-on-create-db [db-file] (if (is-file db-file) (load-db db-file) (boot-db db-file) ) ) (defn get-conf-proj [proj] (load-on-create-db (str project-home "\\" proj "\\project.proj")) ) (defn set-meta [proj key value] (let [proj-conf (get-conf-proj proj)] (flush-db (assoc-in proj-conf [key] value) (proj-conf-file proj)) ) ) (defn build-map-for-send [proj] (let [proj-conf (get-conf-proj proj)] {:title (:title proj-conf) :cat (:cat proj-conf) :originformat (:originformat proj-conf) :publishstate (:publishstate proj-conf) :description (:description proj-conf) :keywords (:keywords proj-conf) :taglist (if (nil? (:taglist proj-conf)) "" (:taglist proj-conf)) :content (slurp (str project-home "\\" proj "\\post.txt")) ;; this is a convention } ) ) (defn send-build [url map] (client/post url {:form-params map :content-type :x-www-form-urlencoded :cookies {"logincookie" {:value "admin" :discard true :path "/" :version 0}} } ) ;; nil ) (declare local-uploader) (declare zhang-uploader) (def target-host "127.0.0.117") (def published-slot :localpublished) (defn zhang-local[] (def target-host "127.0.0.122") (def uploader local-uploader) (def published-slot :localzpublished) ) (defn zhang-online[] (def target-host "zhangley.com") (def uploader zhang-uploader) (def published-slot :zpublished) ) (defn send-publish [proj map] (let [response (send-build (str "http://" target-host "/publish") map)] (let [id (re-find #"[0-9]*?$" ( (:headers response) "Location"))] (set-meta proj published-slot id) ) ) ) ;; we need a function to tell use which targeting we are push (defn project-push-target [] (case published-slot :zpublished "online zhang" :localzpublished "local zhang" ) ) (defn init-proj-conf [proj] (let [proj-conf-file (str project-home "\\" proj "\\project.proj") dummy (load-on-create-db proj-conf-file) ] (flush-db { :title "" :cat "" :originformat "1" :publishstate "0" ; this should be public state :description "" :keywords "" :taglist "" :published nil; if already published, this is the id :localpublished nil :zpublished nil :localzpublished nil :upload-list [] :url-resource [] :pdf-resource [] } proj-conf-file) ) ) (defn init-main-content [proj] (flush-db "code:hide\n\ncode:end\n" (str project-home "\\" proj "\\post.txt")) ) (defn get-meta [proj key] (let [proj-conf (get-conf-proj proj)] (key proj-conf) ) ) (defn set-taglist [proj taglist] (set-meta proj :taglist taglist) ) (defn set-title [proj title] (set-meta proj :title title) ) (defn addimage-proj [proj file] (let [proj-conf (get-conf-proj proj)] (flush-db (update-in proj-conf [:upload-list] #(conj % {:filename file :uploaded nil })) (proj-conf-file proj)) ) ) (defn set-uploaded [proj index] (let [proj-conf (get-conf-proj proj)] (flush-db (assoc-in proj-conf [:upload-list index :uploaded] true) (proj-conf-file proj)) ) ) (defn set-deuploaded-debug [proj index] (let [proj-conf (get-conf-proj proj)] (flush-db (assoc-in proj-conf [:upload-list index :uploaded] nil) (proj-conf-file proj)) ) ) (defn mkdir-proj [proj] (mkdir (str project-home "\\" proj)) ) (defn create-project [proj] "proj is a symbol, project name , also will be project root directory name" (if (project-exist proj) (println "project already exist: " proj) (do (mkdir-proj (str proj)) (init-proj-conf proj) (init-main-content proj) ) ) ) (defn edit-post-proj [proj] (if (not (project-exist proj) ) (create-project proj) ) (shell "ema.bat" (str project-home "\\" proj "\\post.txt")) ) (defn can-build [proj] (cond (= (get-meta proj :title) "") (do (println "title is empty") nil) (= (get-meta proj :cat) "") (do (println "cat is empty") nil) :else true ) ) (defn local-uploader [need-upload proj] nil ) (defn host-uploader-toftp [need-upload proj ftp-image-path] (ftp/with-ftp [client ftp-image-path :file-type :binary] (doseq [img need-upload] (println "uploading " (str "C:\\Pictures\\" (:filename img) )) (if (ftp/client-put client (str "C:\\Pictures\\" (:filename img) )) ;; upload succed , update it in project (do (println "uploaded " (:filename img) "now set true at index " (:index img)) (set-uploaded proj (:index img)) ) (println "client-put failed") ) ) ) ) (defn zhang-uploader [need-upload proj ] (host-uploader-toftp need-upload proj "ftp://ftpname:ftppassword@1.1.1.1/public_html/images") ) ; default implementation (def uploader local-uploader) ;; if is creating or the image has not been uploaded we set it need upload (defn is-creating [proj] (nil? (published-slot (get-conf-proj proj))) ) ; if its creating, we always upload, no matter whehter its has been uploaded (defn scan-uploadlist [proj] "扫描上传列表, 对还没有上传的全部图片执行上传操作" (let [proj-conf (get-conf-proj proj) need-upload-list (map-indexed #(hash-map :index %1 :filename (:filename %2) :uploaded (:uploaded %2)) (:upload-list proj-conf) ) need-upload (filter #(or (is-creating proj) (not (:uploaded %))) need-upload-list )] (uploader need-upload proj) ) ) (defn build-project [proj] (if (can-build proj) (do (scan-uploadlist proj) ;; http post (let [proj-conf (get-conf-proj proj) map-send (build-map-for-send proj) id (published-slot proj-conf) ] (if id ;; update (do (println "updating:" (:title map-send)) (clojure.pprint/pprint map-send) (send-build (str "http://" target-host "/update/" id) map-send) "update post complete") ;; publish (do (println "creating") (send-publish proj map-send)) ) ) ) nil) ) (defn make-public [proj] (set-meta proj :publishstate "1") ) (defn project-list [proj-pattern] (shell "ls.bat " (str project-home "\\" proj-pattern)) ) (defn project-preview [proj] "打开指定的post, 预览, 用id" (let [id (get-meta proj published-slot)] (chrome (str "http://" target-host "/topic/" id)) ) ) (defmacro project [proj action & args] "how to use, project shortname action" `(case ~(str action) "create" (create-project '~proj) "build" (build-project ~(str proj)) "edit" (edit-post-proj ~(str proj)) "public" (make-public ~(str proj)) "set-title" (set-title ~(str proj) ~(first args)) "set-taglist" (set-taglist ~(str proj) ~(first args)) "set-cat" (set-meta ~(str proj) :cat ~(first args)) "list" (project-list ~(str proj)) "preview" (project-preview ~(str proj)) ) )