孤独にそっくり

開いている窓の前で立ち止まるな

実践Common Lispを読む? 第26章途中〜第29章

lambda_plate
第26章の途中から第29章まで読みました。この本で第3章から言われていたMP3ブラウザ?を実装するところまで来たわけです。
読み始めたのは6月の終わりだったので、もう2ヵ月くらい経っていますね。
最初のほうに読んだ章のことはもうほとんど覚えていません。写経だけじゃ記憶に定着しませんね。
ちゃんと読めてる感じがしないので、「?」をつけときました。

第26章途中から

ひとまず動かすためにasdファイルを読み込んだら動いたからそのまま読み進めた。

*HTMLを生成する
;;S式をHTMLにするemit-html関数
;;これは全てを生成してからHTMLにするので、効率的ではない
(emit-html '(:html (:head (:title "Hello")) (:body (:p "Hello, World!"))))
;;htmlマクロを使ったほうがいい
;;どちらも<p>foo</p>を出力する
(html (:p "foo"))
(let ((x "foo")) (html (:p x)))
;;キーワードシンボルで始まらない場合は、コードであるとみなされる
(html (:ul (dolist (item (list 1 2 3)) (html (:li item)))))
;;出力
<ul>
 <li>1</li>                                                                    
 <li>2</li>                                                                    
 <li>3</li>                                                                    
</ul>   

入れ子になってるから少しわかりにくい

*クエリパラメータ

ユーザからの入力の受け取りが必要
AllegroServeでは入力をパースしてくれる
request-query関数を使う
個々のパラメータを取り出したいときはrequest-query-value関数

(publish :path "/show-query-params" :function 'show-query-params)
;;受け取った全てのクエリパラーメタを取り出して表示する
(defun show-query-params (request entity)
  (with-http-response (request entity :content-type "text/html")
    (with-http-body (request entity)
      (with-html-output ((request-reply-stream request))
        (html
          (:standard-page
           (:title "Query Parameters")
           (if (request-query request)
             (html
               (:table :border 1
                       (loop for (k . v) in (request-query request)
                          do (html (:tr (:td k) (:td v))))))
             (html (:p "No query parameters.")))))))))
*クッキー

AllegroServeではSet-Cookieヘッダを送ることが出来る
それを可能にするset-cookie-header関数では、:nameと:valueの引数を必ず渡す必要がある。他の引数はいろいろあるが、:expiresは、ブラウザがクッキーを保存する期間を制御するための引数になり、NIL(デフォルト)の場合、ブラウザはプロセスが生きている間だけ存在する。0だとすぐに捨てることになる。
実行したら動いた。

*DEFINE-URL-FUNCTION

HTML生成関数は毎回引数にrequestとentityを取り、with-http-responseとwith-http-responseの呼び出しが含まれるから、マクロにしちゃう。
かなり長いので省略。
型を変換したり、いろいろ処理してる。

第27章 実践:MP3データベース

第25章で作ったID3v2ライブラリを使う。
第3章で作ったデータベースの主な問題は、*db*にテーブルを1つしか格納できないことと、格納されている型がコードにはわからないことだった。ソートとかできなくて困る。この問題をtableクラスを定義して個々のデータベーステーブルを表すことにより解決する。

;;make-rows関数でrowスロットを初期化
;;
(defclass table ()
  ((rows   :accessor rows   :initarg :rows :initform (make-rows))
   (schema :accessor schema :initarg :schema)))
;;書かないけどエラー処理のための関数とか色々定義した
;;列の仕様を記述したリストからcolumnオブジェクトのリストを作るmake-shema関数を定義
(defun make-schema (spec)
  (mapcar #'(lambda (column-spec) (apply #'make-column column-spec)) spec))
;;こんな感じで使う
(defparameter *mp3-schema*
  (make-schema
   '((:file string)
     (:genre interned-string "Unknown")
     (:artist interned-string "Unknown")
     ...
     (:id3-size number))))
;;MP3の情報を持つテーブルを作るには、MAKE-INSTANCEに*mp3-schemaを:schemaの初期引数として渡せばいい
(defparameter *mp3* (make-instance 'table :schema *ma3-schema*))
*値の挿入
;;挿入する
(defun insert-row (names-and-values table)
  (vector-push-extend (normalize-row names-and-values (schema table)) (rows table)))
;;実際に作業するヘルパー関数
;;各行についてデフォルトの属性リストを組み立てる
;;行の値はnames-and-valuesかdefault-valueのどちらかを使う
(defun normalize-row (names-and-values schema)
  (loop
     for column in schema
     for name = (name column)
     for value = (or (getf names-and-values name) (default-value column))
     collect name
     collect (normalize-for-column value column)))
;;今まで作ってきたライブラリを色々つかってMP3ファイルから取り出した情報でMP3データベースをロードする関数を定義する
(defun load-database (dir db)
  (let ((count 0))
    (walk-directory
     dir
     #'(lambda (file)
         (princ #\.)
         (incf count)
         (insert-row (file->row file) db))
     :test #'mp3-p)
    (format t "~&Loaded ~d files into database." count)))
*データーベースにクエリを出す

ユニークな行に限定したり、ソートしたり機能を付けたい
ここで書くクエリ関数selectはSQLのSELECT文をモデルにしている。
5つのキーワードパラメータをとる

  • :from tableオブジェクト
  • :columns どの列が結果に含まれるかを指定
  • :where 引数として行を受け取り、その行を結果に含める場合には真を返す
  • :distinct 結果の行から重複を削除するかどうか決めるブール値 デフォはNULL
  • :order-by 列の名前でソート
;;selectの使い方
(select :from *mp3s* :where (matching *mp3s* :artist "Green Day"))
;;実装
(defun select (&key (columns t) from where distinct order-by)
  (let ((rows (rows from))
        (schema (schema from)))

    (when where
      (setf rows (restrict-rows rows where)))

    (unless (eql columns 't)
      (setf schema (extract-schema (mklist columns) schema))
      (setf rows (project-columns rows schema)))

    (when distinct
      (setf rows (distinct-rows rows schema)))

    (when order-by
      (setf rows (sorted-rows rows schema (mklist order-by))))

    (make-instance 'table :rows rows :schema schema)))

関数を返す関数がうんぬんとかクロージャがどうのとか書いてあるけどいまいちわからず・・・行の並び替えはパス。

*マッチング関数

matching関数は指定されたすべての列がマッチする関数が返される。テーブルの行ごとではなく、1回だけで済むように、できるだけ多くの作業をクロージャの外で行っている。

(defun matching (table &rest names-and-values)
  "Build a where function that matches rows with the given column values."
  (let ((matchers (column-matchers (schema table) names-and-values)))
    #'(lambda (row)
        (every #'(lambda (matcher) (funcall matcher row)) matchers))))

matchingはrowという1つの引数をとるクロージャを返す?
EVERYは1つめの引数に述語を取り、述語が2つ目の引数に渡されたリストの要素のすべてに対して真を返す時だけ真を返す。そのため、EVERYに渡す述語引数としてさらに別のクロージャを渡す?
もうダメだ。

*結果の取得

内部データをなるべく隠すようにコードを包む。

;;例えばこんな感じ
(defun column-value (row column-name)
  (getf row column-name))
*それ以外のデータベース操作

SQLでいうところのDELETE文とかその他もろもろ

;;delete
(defun delete-rows (&key from where)
  (loop
     with rows = (rows from)
     with store-idx = 0
     for read-idx from 0
     for row across rows
     do (setf (aref rows read-idx) nil)
     unless (funcall where row) do
       (setf (aref rows store-idx) row)
       (incf store-idx)
     finally (setf (fill-pointer rows) store-idx)))

(defun delete-all-rows (table)
  (setf (rows table) (make-rows *default-table-size*)))

これで第29章で作るMP3ファイルブラウザの準備ができた。

第28章 実践Shoutcastサーバ

サーバからMP3をストリーミング出来るようにShoutcastプロトコルを実装
Shoutcstプロトコルの説明全然頭に入ってこない。
リクエストに対してICYレスポンスってのが返ってくるらしい。
AllegroServeのリクエストオブジェクトから取り出したIDに基づいてShoutcastサーバが曲ソースを探す。以下の3つが出来るようにする。

;;ソースから現在の曲を取得する
(defgeneric current-song (source)
  (:documentation "Return the currently playing song or NIL."))
;;現在の曲が終わったことを曲ソースに伝える
(defgeneric still-current-p (song source)
  (:documentation
   "Return true if the song given is the same as the current-song."))
;;曲が再生中かどうか、もし再生中なら曲ソースを次の曲に移す
(defgeneric maybe-move-to-next-song (song source)
  (:documentation
   "If the given song is still the current one update the value returned by current-song."))

Shoutcastサーバが必要とする曲についての情報を表すため、クラスsongを定義する。current-songから返る値はこのクラスのインスタンス
それからメソッドとかを定義。

Shoutcastを実装する

AllegroServeの低レベルの機能とやり取りするために通常関数を定義。

(publish :path "/stream.mp3" :function 'shoutcast)

(defun shoutcast (request entity)
  (with-http-response
      (request entity :content-type "audio/MP3" :timeout *timeout-seconds*)
    (prepare-icy-response request *metadata-interval*)
    (let ((wants-metadata-p (header-slot-value request :icy-metadata)))
      (with-http-body (request entity)
        (play-songs
         (request-socket request)
         (find-song-source *song-source-type* request)
         (if wants-metadata-p *metadata-interval*))))))

:timeoutには10年を渡している。
play-current関数を繰り返し呼び出すplay-songs関数と、Shoutcastデータを実際に送るplay-current関数と、現在の曲のタイトルを受けて適切にフォーマットされたICYメタデータとしてバイト列の配列を生成するmake-icy-metadata関数を実装しておわり。

第29章 実践:MP3ブラウザ

Webインターフェースの実装。Shoutcastサーバに接続するMP3クライアントがそれぞれプレイリストを持ち、曲ソースとして利用する。
そうなんですかって感じで流し読みだけしてパス。

まとめ

実践の章に入ってから、「~が必要だから実装する」みたいにゴリゴリ実装しているのを読んできたわけですが、実践的にアプリケーションを書いたことがない僕にとっては、どうしてそう考えているのかがイマイチ理解できず、羅列されたコードの説明を呆然と眺めていました。きっと自分で何かを作ったことがある人なら「こうやって作るんだ」みたいな発見があるんじゃないでしょうか。
とはいえ、HTMLやデータベースやサーバまでCommonLispで書かれているのはこの言語の柔軟性というか、潜在的な力みたいなものを感じたし、それぞれ小さな関数やマクロの積み重ねでこうしたアプリケーションが構築されていくのはすごいと思いました。いつか読み直したりしたら面白いのかなと思います。僕がちゃんとそれまで勉強をしていればの話ですけどね。
次回で読了できるようにサクッとやっていきたいと思います。