试了下CommonLisp的WEB开发

很多人喜欢Rails这种“All in One"的方式， 不过个人更喜欢搭积木的方式。每个小系统专心做好自己的事， 然后大家合作产生具有更强大功能的系统。 从网上收集了一些样本代码， 用SBCL试了下， 感觉不错。

>(ql:quickload "quickproject")

>(quickproject:make-project  "/media/E/RnD/clisp/web/":depends-on '(hunchentoot cl-who cl-json parenacript css-lite elephant))

web项目的架子就搭好了：

%ls
README.txt  web.db  package.lisp  web.asd  web.lisp

%cat web.asd

(asdf:defsystem:web
  :serial t
  :depends-on (:hunchentoot
               :cl-who
               :cl-json
               :css-lite
               :parenscript
               :elephant)
  :components ((:file "package")
               (:file "web")))

其中各组件的功能，网上一查就知。简单说一下： 

cl-who用于产生XHTML;  parenscript用于产生客户端JavaScript;  elephant用于操作数据库。

%cat package.lisp

(defpackage:web
  (:use :cl :cl-who :hunchentoot :parenscript :elephant)
  (:import-from :css-lite :css)
  (:import-from :json :encode-json-to-string))

%cat web.lisp
(in-package #:web)

;;; "web" goes here. Hacks and glory await!

;; 启动WEB服务器
(setf *web-server*  (start  (make-instance 'hunchentoot:acceptor :port 8000)))

;; 输出所有静态内容
(push (create-static-file-dispatcher-and-handler "/GameVoter.png" "statics/imgs/GameVoter.png")  *dispatch-table*)
(push(create-static-file-dispatcher-and-handler "/site.css" "statics/css/site.css") *dispatch-table*)

;; 启动Elephant
(setf*store* (open-store '(:clsql  (:sqlite3  "/media/E/RnD/clisp/web/web.db"))))

;; 将每一个游戏表示为Elephant持久类的一个实例
(defpclasspersistent-game ()
   ((name :reader name :initarg :name :index t)
    (votes :accessor votes :initarg :votes :initform 0 :index t)))

(defmethod vote-for (user-selected-game)
    (incf(votes user-selected-game)))

(defun game-from-name (name)
  (get-instance-by-value 'persistent-game 'name name))

(defun game-stored? (game-name)
  (game-from-name game-name))

(defun add-game (name)
  (with-transaction ()
    (unless (game-stored? name)
      (make-instance 'persistent-game :name name))))

;; 返回以流行程度排序的游戏列表
(defun games ()
  (nreverse (get-instances-by-range 'persistent-game 'votes nil nil)))

;; 对指定URL（加上.htm）自动生成 Hunchentoot 的处理器
(defmacro define-url-fn ((name) &body body)
  `(progn
     (defun ,name ()
       ,@body)
     (push (create-prefix-dispatcher,(format nil "/~(~a~)" name) ',name)*dispatch-table*)))

;;标准页面,使网站的风格一致
(defmacrostandard-page ((&key title) &body body)
  `(with-html-output-to-string (*standard-output* nil :prologue t :indent t)
     (:html :xmlns "http://www.w3.org/1999/xhtml"  :xml\:lang "en" :lang "en"
       (:head
         (:meta :http-equiv "Content-Type" :content "text/html;charset=utf-8")
     (:title ,title)
     (:link :type "text/css" :rel "stylesheet" :href "/site.css"))
       (:body
         (:div :id "header" ; Start all pages with our header.
           (:img :src "/GameVoter.png" :alt "Game Voter Logo" :class "logo")
           (:span :class "strapline" "Vote for your favourite Video Game"))
         ,@body))))

;; 负责产生HTML的函数
(define-url-fn (index)
  (standard-page (:title "Game Voter")
     (:h1 "Vote on your all time favourite games!")
     (:p "Missing a game? Make it available for votes " (:a :href "new-game" "here"))
     (:h2 "Current stand")
     (:div :id "chart" ; Used for CSS styling of the links.
       (:ol
    (dolist (game (games))
     (htm  
      (:li (:a :href (format nil "vote?name=~a" (name game)) "Vote!")
           (fmt "~A with ~d votes" (name game) (votes game)))))))))

(define-url-fn (new-game)
  (standard-page (:title "Add a new game")
     (:h1 "Add a new game to the chart")
     (:form:action "/game-added" :method "post"
        :onsubmit (ps-inline      ; 客户端验证
           (when (= name.value "")
             (alert "Please enter a name.")
             (return false)))
       (:p "What is the name of the game?" (:br)
       (:input :type "text" :name "name" :class "txt"))
       (:p (:input :type "submit" :value "Add" :class "btn")))))

(define-url-fn (game-added)
  (let ((name (parameter "name")))
    (unless (or (null name) (zerop (length name))) ; 万一 JavaScript 关闭了
      (add-game name))
    (redirect "/index")))

(define-url-fn (vote)
  (let ((game (game-from-name (parameter "name"))))
    (if game
    (vote-for game))
    (redirect "/index")))

回到SBCL

>(ql:quickload "web")

在浏览器中访问 http://127.0.0.1:8000/index 试试！