用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))
  )
)