Commits

sakito committed 7d7358d

簡易サンプルを作成

  • Participants

Comments (0)

Files changed (3)

+.. -*- rst -*-
+
+===================
+hunchentoot-blank
+===================
+
+hunchentootの動作確認用プロジェクトです。
+
+Copyright (c) 2012 sakito <sakito@sakito.com>
+
+This program is licensed under the terms of the LLGPL.

hunchentoot-sample.asd

+#|
+Copyright (c) 2012 sakito <sakito@sakito.com>
+
+This program is licensed under the terms of the LLGPL.
+|#
+
+(in-package :cl-user)
+(defpackage hunchentoot-sample-asd
+  (:use :cl :asdf)
+  (:export :start :stop))
+(in-package :hunchentoot-sample-asd)
+
+(defsystem hunchentoot-sample
+  :version "0.0"
+  :author "sakito"
+  :license "LLGPL"
+  :serial t
+  :depends-on (:hunchentoot
+               :alexandria
+               :clsql
+               :cl-markup)
+  :components ((:file "hunchentoot-sample")))

hunchentoot-sample.lisp

+#|
+Copyright (c) 2012 sakito <sakito@sakito.com>
+
+This program is licensed under the terms of the LLGPL.
+|#
+
+;; (ql:quickload :hunchentoot-sample)
+;; (hunchentoot-sample::start)
+;; (hunchentoot-sample::stop)
+
+(in-package :cl-user)
+(defpackage hunchentoot-sample
+  (:use :cl
+        :cl-markup)
+  (:export :start :stop))
+(in-package :hunchentoot-sample)
+
+;; 定数定義
+
+(defconstant *default-directory*
+  (pathname (directory-namestring #.(or *compile-file-truename*
+                                        *load-truename*)))
+  "このファイルがあるディレクトリ")
+
+(defconstant *js-path* (merge-pathnames "js/" *default-directory*)
+  "JavaScript 用ディレクトリ")
+
+(defconstant *css-path* (merge-pathnames "css/" *default-directory*)
+  "スタイルシート用ディレクトリ")
+
+;; サーバ設定
+
+(setf
+ ;; for utf-8
+ hunchentoot:*default-content-type* "text/html; charset=utf-8"
+ ;; for debug
+ hunchentoot:*catch-errors-p* nil)
+
+(setf hunchentoot:*dispatch-table*
+      (list
+       'hunchentoot:dispatch-easy-handlers
+       (hunchentoot:create-folder-dispatcher-and-handler "/css/" *css-path*)
+       (hunchentoot:create-folder-dispatcher-and-handler "/js/" *js-path*)))
+
+
+(defvar *acceptor* nil)
+
+(defun start (&optional (port 4242))
+  "Web サーバ起動"
+  (when *acceptor*
+    (stop))
+  (setf *acceptor* (hunchentoot:start
+                    (make-instance 'hunchentoot:easy-acceptor
+                                   :port port)))
+  ;; ログの設定
+  (let ((access-log-file (merge-pathnames "log/sample-access.log" *default-directory*))
+        (message-log-file (merge-pathnames "log/sample-message.log" *default-directory*)))
+    ;; ファイル作成
+    (ensure-directories-exist access-log-file)
+    (ensure-directories-exist message-log-file)
+    ;; ファイル設定
+    (setf (hunchentoot:acceptor-access-log-destination *acceptor*) access-log-file
+          (hunchentoot:acceptor-message-log-destination *acceptor*) message-log-file)))
+
+(defun stop ()
+  "Web サーバ停止"
+  (hunchentoot:stop *acceptor*)
+  (setf *acceptor* nil))
+
+;; DB 設定
+
+(clsql:file-enable-sql-reader-syntax)
+
+;; echo create database hunchentoot_sample default character set utf8;' | mysql -u root
+(defconstant *connection-spec* '("localhost" "hunchentoot_sample" "root" "")
+  "MySQL の接続情報。(DBサーバ DB名 ユーザ パスワード)")
+
+(defmacro with-db (&body body)
+  (alexandria:with-gensyms (res handler-done)
+    `(clsql:with-database (clsql:*default-database*
+                           *connection-spec*
+                           :make-default t
+                           :pool t
+                           :encoding :utf-8
+                           :database-type :mysql)
+       ;; デバッグ開始
+       (clsql::start-sql-recording)
+       (unwind-protect
+            (let (,res (,handler-done t))
+              ;; 日本語がだめな場合は以下を試してみる
+              ;; (clsql:execute-command "SET NAMES 'utf8'")
+              ;; (clsql:execute-command "set character_set_client='utf8'")
+              ;; (clsql:execute-command "set character_set_connection='utf8'")
+              ;; (clsql:execute-command "set character_set_results='utf8'")
+
+              ;; トランザクション
+              (clsql:with-transaction (:database clsql:*default-database*)
+                ;; hunchentoot:redirect した場合の対応
+                (catch 'hunchentoot::handler-done
+                  (setf ,res (progn ,@body))
+                  (setf ,handler-done nil)))
+              (if ,handler-done
+                  (throw 'hunchentoot::handler-done nil)
+                  ,res))
+         ;; デバッグ終了
+         (clsql::stop-sql-recording)))))
+;;(with-db (clsql:query "select 'あ'"))
+
+
+;; ページ
+
+#|
+名前を入力して、データベースに投入するまでのもっとも簡易なサンプル
+以下のテーブルを利用しているので事前に作成しておく
+CREATE TABLE SAMPLE (
+ID INT AUTO_INCREMENT
+, NAME VARCHAR(255)
+, CONSTRAINT SAMPLE_PK PRIMARY KEY (ID))
+|#
+
+;; テーブル定義
+(clsql:def-view-class sample ()
+  ((id :accessor id
+       :initarg :id
+       :db-kind :key
+       :db-constraints :auto-increment
+       :type integer)
+   (name :accessor name
+          :initarg :name
+          :type string)))
+
+;; 入力画面
+(hunchentoot:define-easy-handler
+    (my-index :uri "/my/") ()
+  (markup
+   (html
+    (:head
+     (:meta :content "text/html" :charset "UTF-8")
+     (:title "index"))
+    (:body
+     (:form :method "get" :action "/my/conf"
+            (:input :type "text" :name "name")
+            (:input :type "submit")
+            )
+     )
+    )))
+
+;; 確認画面( hidden でやっている例)
+(hunchentoot:define-easy-handler
+    (my-conf :uri "/my/conf") (name)
+  (markup
+   (html
+    (:head
+     (:meta :content "text/html" :charset "UTF-8")
+     (:title "conf"))
+    (:body
+     (:p "お名前は" (format nil "「~@[~A~]」" name) "ですね")
+     (:form :method "get" :action "/my/end"
+            (:input :type "hidden" :name "name" :value (format nil "~@[~A~]" name))
+            (:input :type "submit")
+            )
+     )
+    )))
+
+;; 完了画面
+(hunchentoot:define-easy-handler
+    (my-end :uri "/my/end") (name)
+  ;; ログの出力
+  (hunchentoot:log-message* :info name)
+  ;; DBへ挿入
+  (with-db
+      (let ((sample (make-instance 'sample :name (format nil "~@[~A~]" name))))
+        (clsql:update-records-from-instance sample)))
+  ;; 完了画面表示
+  (markup
+   (html
+    (:head
+     (:meta :content "text/html" :charset "UTF-8")
+     (:title "conf"))
+    (:body
+     (:p "お名前を" (format nil "「~@[~A~]」" name) "で登録しました")
+     (:a :href "/my/" (:p "top"))
+     )
+    )))
+