Mito ORM 和 SxQL

Awesome-cl list 里面罗列了很多不同的数据库的插件库，其中大致可以分为四类：

与数据库引擎封装在一起（cl-sqlite、postmodern、cl-redis等），
与多个数据库的接口（clsql、sxql等），
持久对象数据库（bknr.datastore (see chap. 21 of “Common Lisp Recipes”)，ubiquitous等),
对象关系映射（ORM） (Mito)

还有其他的数据库工具（pgloader）。

本章将从 Mito 开始介绍。如果必须要使用现有的数据库的话，可以了解下 cl-dbi 和 clsql。如果不需要现有数据库的话，而是想要使用 Lisp 对象进行自动持久化，那么就随意了。

Mito ORM 和 SxQL

可以通过 quicklisp 安装 mito：

(ql:quickload :mito)

概述

Mito 是个 Common Lisp ORM，其支持迁移、关系和 PostgreSQL 的。

支持MySQL、PostSQL 和 SQLite3，
在定义模型是，默认会加上 id（主键）、created_at 和 updated_at 三个字段，和 Ruby 的 ActiveRecord 或 Django 一样，
支持数据库迁移，
支持数据库模式版本控制（schema versioning），
在 SBCL 和 CCL 下验证过

作为 ORM，Mito 可以编写类定义、指定表关系以及提供查询函数。如果是要自定义查询，那么就需要用到 SxQL，一个为多个数据库提供统一接口的 SQL 生成器。

使用 Mito 的一般步骤如下：

连接数据库
编写 CLOS 类模型
执行迁移以创建或修改表
创建对象，将其保存到数据库

然后不断执行以上操作。

连接数据库

在 Mito 中可以调用函数 connect-toplevel 来连接 RDBMs：

(mito:connect-toplevel :mysql :database-name "myapp" :username "fukamachi" :password "c0mon-1isp")

数据库驱动类型可以是 :mysql、sqlite3 和 :postgres。

当连接 sqlite 时，不需要指定用户名和密码：

(connect-toplevel :sqlite3 :database-name "myapp")

通常，需要提前创建好 MySQL 或 PostgreSQL 的数据库，具体操作参照其文档。

连接时会将 mito:*connection* 设置为新连接然后返回该连接。

断开也是使用 disconnect-toplevel.

=> you might make good use of a wrapper function:

(defun connect ()
  "Connect to the DB."
  (connect-toplevel :sqlite3 :database-name "myapp"))

模型

定义模型

在 Mito 中，通过使用 (:metaclass mito:dao-table-class) 来定义一个类，该类和数据库中的表相对应。

(defclass user ()
  ((name :col-type (:varchar 64)
         :initarg :name
         :accessor user-name)
   (email :col-type (or (:varchar 128) :null)
          :initarg :email
          :accessor user-email))
  (:metaclass mito:dao-table-class))

注意，这些类会自动加入一些属性：名为 id 的主键（如果没有设置主键）以及用来记录时间戳的 created_at 和 updated_at 字段。要禁用这种行为的话，在 defclass 中将 :auto-pk 以及 :record-timestamps 设置为 nil。

可以检查下新定义的类：

(mito.class:table-column-slots (find-class 'user))
;=> (#<MITO.DAO.COLUMN:DAO-TABLE-COLUMN-CLASS MITO.DAO.MIXIN::ID>
;    #<MITO.DAO.COLUMN:DAO-TABLE-COLUMN-CLASS COMMON-LISP-USER::NAME>
;    #<MITO.DAO.COLUMN:DAO-TABLE-COLUMN-CLASS COMMON-LISP-USER::EMAIL>
;    #<MITO.DAO.COLUMN:DAO-TABLE-COLUMN-CLASS MITO.DAO.MIXIN::CREATED-AT>
;    #<MITO.DAO.COLUMN:DAO-TABLE-COLUMN-CLASS MITO.DAO.MIXIN::UPDATED-AT>)

这个类会隐式地继承 mito:dao-class。

(find-class 'user)
;=> #<MITO.DAO.TABLE:DAO-TABLE-CLASS COMMON-LISP-USER::USER>
(c2mop:class-direct-superclasses *)
;=> (#<STANDARD-CLASS MITO.DAO.TABLE:DAO-CLASS>)

这在定义适用于所有表的类的时候有很大的帮助。

更多关于 Common Lisp 对象系统的介绍，参见第15章：CLOS。

创建表

在定义完模型后，就需要创建表了：

(mito:ensure-table-exists 'user)

有个辅助函数是：

(defun ensure-tables ()
  (mapcar #'mito:ensure-table-exists '('user 'foo 'bar)))

Mito’s documentation 中还介绍了其他的方法。

每次修改完模型后，需要运行一遍数据迁移，具体在在一节中会介绍。

字段（fields）

字段类型（fields type）

字段的类型有以下几种：

(:varchar <integer>)，

:serial，:bigserial，:integer，:bigint，:unsigned，

:timestamp，:timestamptz，

:bytea

可选字段（optional fields）

可选字段可以使用 (or <real type> :null)：

   (email :col-type (or (:varchar 128) :null)
          :initarg :email
          :accessor user-email))

字段约束

:unique-keys 可以像下面这样使用：

(defclass user ()
  ((name :col-type (:varchar 64)
         :initarg :name
         :accessor user-name)
   (email :col-type (:varchar 128)
          :initarg :email
          :accessor user-email))
  (:metaclass mito:dao-table-class)
  (:unique-keys email))

现在已经知道 :primary-key。

可以用 :table-name 来修改表名。

表关系

指定表的关系可以将 :col-type 设置为其他的模型类：

(defclass tweet ()
  ((status :col-type :text
           :initarg :status
           :accessor tweet-status)
   ;; This slot refers to USER class
   (user :col-type user
         :initarg :user
         :accessor tweet-user))
  (:metaclass mito:dao-table-class))
(table-definition (find-class 'tweet))
;=> (#<SXQL-STATEMENT: CREATE TABLE tweet (
;        id BIGSERIAL NOT NULL PRIMARY KEY,
;        status TEXT NOT NULL,
;        user_id BIGINT NOT NULL,
;        created_at TIMESTAMP,
;        updated_at TIMESTAMP
;    )>)

现在就可以通过 USER 对象（而不是 USER-ID）来创建或检索 TWEET 对象了。

(defvar *user* (mito:create-dao 'user :name "Eitaro Fukamachi"))
(mito:create-dao 'tweet :user *user*)
(mito:find-dao 'tweet :user *user*)

Mito 不会在引用表中添加外键约束。

一对一

A one-to-one relationship is simply represented with a simple foreign
key on a slot (as :col-type user in the tweet class). Besides, we
can add a unicity constraint, as with (:unique-keys email).

一对多、多对一

The tweet example above shows a one-to-many relationship between a user and
his tweets: a user can write many tweets, and a tweet belongs to only
one user.

The relationship is defined with a foreign key on the “many” side
linking back to the “one” side. Here the tweet class defines a
user foreign key, so a tweet can only have one user. You didn’t need
to edit the user class.

A many-to-one relationship is actually the contrary of a one-to-many.
You have to put the foreign key on the appropriate side.

多对多

A many-to-many relationship needs an intermediate table, which will be
the “many” side for the two tables it is the intermediary of.

And, thanks to the join table, we can store more information about the relationship.

Let’s define a book class:

(defclass book ()
    ((title
       :col-type (:varchar 128)
       :initarg :title
       :accessor title)
     (ean
       :col-type (or (:varchar 128) :null)
       :initarg :ean
       :accessor ean))
    (:metaclass mito:dao-table-class))

A user can have many books, and a book (as the title, not the physical
copy) is likely to be in many people’s library. Here’s the
intermediate class:

(defclass user-books ()
    ((user
      :col-type user
      :initarg :user)
    (book
      :col-type book
      :initarg :book))
    (:metaclass mito:dao-table-class))

Each time we want to add a book to a user’s collection (say in
a add-book function), we create a new user-books object.

But someone may very well own many copies of one book. This is an
information we can store in the join table:

(defclass user-books ()
    ((user
      :col-type user
      :initarg :user)
    (book
      :col-type book
      :initarg :book)
    ;; Set the quantity, 1 by default:
    (quantity
      :col-type :integer
      :initarg :quantity
      :initform 1
      :accessor quantity))
    (:metaclass mito:dao-table-class))

继承和混合（mixin）

DAO-CLASS 的子类都能被继承。这在创建有相同字段的模型类时就很方便。

(defclass user ()
  ((name :col-type (:varchar 64)
         :initarg :name
         :accessor user-name)
   (email :col-type (:varchar 128)
          :initarg :email
          :accessor user-email))
  (:metaclass mito:dao-table-class)
  (:unique-keys email))
(defclass temporary-user (user)
  ((registered-at :col-type :timestamp
                  :initarg :registered-at
                  :accessor temporary-user-registered-at))
  (:metaclass mito:dao-table-class))
(mito:table-definition 'temporary-user)
;=> (#<SXQL-STATEMENT: CREATE TABLE temporary_user (
;        id BIGSERIAL NOT NULL PRIMARY KEY,
;        name VARCHAR(64) NOT NULL,
;        email VARCHAR(128) NOT NULL,
;        registered_at TIMESTAMP NOT NULL,
;        created_at TIMESTAMP,
;        updated_at TIMESTAMP,
;        UNIQUE (email)
;    )>)

当需要一个与数据库其他表都无关的临时表时，可以用 DAO-TABLE-MIXIN。下面代码中的 has-email 类就不会创建表。

(defclass has-email ()
  ((email :col-type (:varchar 128)
          :initarg :email
          :accessor object-email))
  (:metaclass mito:dao-table-mixin)
  (:unique-keys email))
;=> #<MITO.DAO.MIXIN:DAO-TABLE-MIXIN COMMON-LISP-USER::HAS-EMAIL>
(defclass user (has-email)
  ((name :col-type (:varchar 64)
         :initarg :name
         :accessor user-name))
  (:metaclass mito:dao-table-class))
;=> #<MITO.DAO.TABLE:DAO-TABLE-CLASS COMMON-LISP-USER::USER>
(mito:table-definition 'user)
;=> (#<SXQL-STATEMENT: CREATE TABLE user (
;       id BIGSERIAL NOT NULL PRIMARY KEY,
;       name VARCHAR(64) NOT NULL,
;       email VARCHAR(128) NOT NULL,
;       created_at TIMESTAMP,
;       updated_at TIMESTAMP,
;       UNIQUE (email)
;   )>)

更多使用的例子参见mito-auth。

问题诊断

“Cannot CHANGE-CLASS objects into CLASS metaobjects.”

当看到下面的错误提示时：

Cannot CHANGE-CLASS objects into CLASS metaobjects.
   [Condition of type SB-PCL::METAOBJECT-INITIALIZATION-VIOLATION]
See also:
  The Art of the Metaobject Protocol, CLASS [:initialization]

绝对是你先写了个类，然后再添加 Mito 元类，之后再执行这个类。

发生这种情况时，就需要将这个类从当前的包中移除掉。

(setf (find-class 'foo) nil)

或者用 Slime 的检查器，鼠标点一下这个类，然后选择 “移除（remove）” 按钮。

更多相关信息参见这里.

迁移

首先创建一个表：

(ensure-table-exists 'user)

然后修改表：

(mito:migrate-table 'user)

可以用 migration-expressions class 来检查生成的 SQL 语句。例如，创建个 user 表：

(ensure-table-exists 'user)
;-> ;; CREATE TABLE IF NOT EXISTS "user" (
;       "id" BIGSERIAL NOT NULL PRIMARY KEY,
;       "name" VARCHAR(64) NOT NULL,
;       "email" VARCHAR(128),
;       "created_at" TIMESTAMP,
;       "updated_at" TIMESTAMP
;   ) () [0 rows] | MITO.DAO:ENSURE-TABLE-EXISTS

这次创建之前的 user 定义没有任何修改：

(mito:migration-expressions 'user)
;=> NIL

现在添加个唯一一个字段 email：

(defclass user ()
  ((name :col-type (:varchar 64)
         :initarg :name
         :accessor user-name)
   (email :col-type (:varchar 128)
          :initarg :email
          :accessor user-email))
  (:metaclass mito:dao-table-class)
  (:unique-keys email))

在次执行 migration-expressions：

(mito:migration-expressions 'user)
;=> (#<SXQL-STATEMENT: ALTER TABLE user ALTER COLUMN email TYPE character varying(128), ALTER COLUMN email SET NOT NULL>
;    #<SXQL-STATEMENT: CREATE UNIQUE INDEX unique_user_email ON user (email)>)

然后再将修改提交：

(mito:migrate-table 'user)
;-> ;; ALTER TABLE "user" ALTER COLUMN "email" TYPE character varying(128), ALTER COLUMN "email" SET NOT NULL () [0 rows] | MITO.MIGRATION.TABLE:MIGRATE-TABLE
;   ;; CREATE UNIQUE INDEX "unique_user_email" ON "user" ("email") () [0 rows] | MITO.MIGRATION.TABLE:MIGRATE-TABLE
;-> (#<SXQL-STATEMENT: ALTER TABLE user ALTER COLUMN email TYPE character varying(128), ALTER COLUMN email SET NOT NULL>
;    #<SXQL-STATEMENT: CREATE UNIQUE INDEX unique_user_email ON user (email)>)

查询

创建对象

像平常一样，可以使用 make-instance 来创建 user 对象：

(defvar me
  (make-instance 'user :name "Eitaro Fukamachi" :email "e.arrows@gmail.com"))
;=> USER

然后使用 insert-dao 进行保存：

(mito:insert-dao me)
;-> ;; INSERT INTO `user` (`name`, `email`, `created_at`, `updated_at`) VALUES (?, ?, ?, ?) ("Eitaro Fukamachi", "e.arrows@gmail.com", "2016-02-04T19:55:16.365543Z", "2016-02-04T19:55:16.365543Z") [0 rows] | MITO.DAO:INSERT-DAO
;=> #<USER {10053C4453}>

将上面两个步骤合并成一条语句就是：

(mito:create-dao 'user :name "Eitaro Fukamachi" :email "e.arrows@gmail.com")

不能将 user 类给定义为外部类，也不能在 user 所在包的外部创建其对象（无论如何，将所有与数据库相关的操作宝尊在一个 models 包和文件中，在实践中是比较好的）。相反，可以使用构造函数进行对象的创建：

(defun make-user (&key name)
  (make-instance 'user :name name))

更新字段

(setf (slot-value me 'name) "nitro_idiot")
;=> "nitro_idiot"

然后保存：

(mito:save-dao me)

删除数据

(mito:delete-dao me)
;-> ;; DELETE FROM `user` WHERE (`id` = ?) (1) [0 rows] | MITO.DAO:DELETE-DAO
;; or:
(mito:delete-by-values 'user :id 1)
;-> ;; DELETE FROM `user` WHERE (`id` = ?) (1) [0 rows] | MITO.DAO:DELETE-DAO

获取主键值

(mito:object-id me)
;=> 1

计数

(mito:count-dao 'user)
;=> 1

单个查询

(mito:find-dao 'user :id 1)
;-> ;; SELECT * FROM `user` WHERE (`id` = ?) LIMIT 1 (1) [1 row] | MITO.DB:RETRIEVE-BY-SQL
;=> #<USER {10077C6073}>

因此，对于泛型帮助其，有这么一种可能，就是通过给定键值来查找对象。

(defgeneric find-user (key-name key-value)
  (:documentation "Retrieves an user from the data base by one of the unique
keys."))
(defmethod find-user ((key-name (eql :id)) (key-value integer))
  (mito:find-dao 'user key-value))
(defmethod find-user ((key-name (eql :name)) (key-value string))
  (first (mito:select-dao 'user
                          (sxql:where (:= :name key-value)))))

查找所有

使用 select-dao 宏。

获取所有用户：

(mito:select-dao 'user)
;(#<USER {10077C6073}>)
;#<SXQL-STATEMENT: SELECT * FROM user>

通过关系查找

和上面看到的表之间的关系一样：

(mito:find-dao 'tweet :user *user*)

自定义查询

通过 select-dao，可以编写更精确的查询语句，然后将查询语句传给 SxQL。

示例：

(select-dao 'tweet
    (where (:like :status "%Japan%")))

另一个例子：

(select (:id :name :sex)
  (from (:as :person :p))
  (where (:and (:>= :age 18)
               (:< :age 65)))
  (order-by (:desc :age)))

同时也可以用常规的 Lisp 代码组合成查询语句：

(defun find-tweets (&key user)
  (select-dao 'tweet
    (when user
      (where (:= :user user)))
    (order-by :object-created)))

闭包

参见 SxQL documentation.

以下是示例：

(select-dao 'foo
  (where (:and (:> :age 20) (:<= :age 65))))

(order-by :age (:desc :id))

(group-by :sex)

(having (:>= (:sum :hoge) 88))

(limit 0 10)

join等的用法也一样。

操作符

:not
:is-null, :not-null
:asc, :desc
:distinct
:=, :!=
:<, :>, :<= :>=
:a<, :a>
:as
:in, :not-in
:like
:and, :or
:+, :-, :* :/ :%
:raw

触发器

因为 insert-dao、update-dao 和 delete-dao 都被定义为泛型函数，所以可以在这些函数中定义 :before、after 和 :around 方法，和之前的组合方法一样。

(defmethod mito:insert-dao :before ((object user))
  (format t "~&Adding ~S...~%" (user-name object)))
(mito:create-dao 'user :name "Eitaro Fukamachi" :email "e.arrows@gmail.com")
;-> Adding "Eitaro Fukamachi"...
;   ;; INSERT INTO "user" ("name", "email", "created_at", "updated_at") VALUES (?, ?, ?, ?) ("Eitaro Fukamachi", "e.arrows@gmail.com", "2016-02-16 21:13:47", "2016-02-16 21:13:47") [0 rows] | MITO.DAO:INSERT-DAO
;=> #<USER {100835FB33}>

Inflation/Deflation

Inflation/Deflation 是将 Mito 和 RDBMS 中值相互转换的函数。

(defclass user-report ()
  ((title :col-type (:varchar 100)
          :initarg :title
          :accessor report-title)
   (body :col-type :text
         :initarg :body
         :initform ""
         :accessor report-body)
   (reported-at :col-type :timestamp
                :initarg :reported-at
                :initform (local-time:now)
                :accessor report-reported-at
                :inflate #'local-time:universal-to-timestamp
                :deflate #'local-time:timestamp-to-universal))
  (:metaclass mito:dao-table-class))

预加载

ORM 最头痛的问题就是“N+1 查询”问题。

;; BAD EXAMPLE
(use-package '(:mito :sxql))
(defvar *tweets-contain-japan*
  (select-dao 'tweet
    (where (:like :status "%Japan%"))))
;; Getting names of tweeted users.
(mapcar (lambda (tweet)
          (user-name (tweet-user tweet)))
        *tweets-contain-japan*)

上面例子中在每次迭代时查询用户时都会发送个类似 “SELECT * FROM user WHERE id = ?” 的查询语句。

为了避免这个性能问题，在查询中添加 includes，这样就只会发送一次查询语句，而不是 N 次：

;; GOOD EXAMPLE with eager loading
(use-package '(:mito :sxql))
(defvar *tweets-contain-japan*
  (select-dao 'tweet
    (includes 'user)
    (where (:like :status "%Japan%"))))
;-> ;; SELECT * FROM `tweet` WHERE (`status` LIKE ?) ("%Japan%") [3 row] | MITO.DB:RETRIEVE-BY-SQL
;-> ;; SELECT * FROM `user` WHERE (`id` IN (?, ?, ?)) (1, 3, 12) [3 row] | MITO.DB:RETRIEVE-BY-SQL
;=> (#<TWEET {1003513EC3}> #<TWEET {1007BABEF3}> #<TWEET {1007BB9D63}>)
;; No additional SQLs will be executed.
(tweet-user (first *))
;=> #<USER {100361E813}>

模式版本控制

$ ros install mito
$ mito
Usage: mito command [option...]
Commands:
    generate-migrations
    migrate
Options:
    -t, --type DRIVER-TYPE          DBI driver type (one of "mysql", "postgres" or "sqlite3")
    -d, --database DATABASE-NAME    Database name to use
    -u, --username USERNAME         Username for RDBMS
    -p, --password PASSWORD         Password for RDBMS
    -s, --system SYSTEM             ASDF system to load (several -s's allowed)
    -D, --directory DIRECTORY       Directory path to keep migration SQL files (default: "/Users/nitro_idiot/Programs/lib/mito/db/")
    --dry-run                       List SQL expressions to migrate

自省（Introspection）

Mito 也有自省函数。

可以在 (mito.class.column:...) 中调用函数来获取字段的信息了：

table-column-[class, name, info, not-null-p,...]
primary-key-p

(mito.class.table:...) 对表也一样。

假设得到了类的属性列表：

(ql:quickload "closer-mop")
(closer-mop:class-direct-slots (find-class 'user))
;; (#<MITO.DAO.COLUMN:DAO-TABLE-COLUMN-CLASS NAME>
;;  #<MITO.DAO.COLUMN:DAO-TABLE-COLUMN-CLASS EMAIL>)
(defparameter user-slots *)

这样就能解决下面的问题了：

查询列字段类型

(mito.class.column:table-column-type (first user-slots))
;; (:VARCHAR 64)

查询列属性是否可为空

(mito.class.column:table-column-not-null-p
  (first user-slots))
;; T
(mito.class.column:table-column-not-null-p
  (second user-slots))
;; NIL

测试

我们不会在生产环境下测试数据库的操作。因此需要为每个测试创建一个临时的数据库。

下面代码中的宏创建个名字随机的临时数据库、表格、执行代码，然后重新连接原有的数据库。

(defpackage my-test.utils
  (:use :cl)
  (:import-from :my.models
                :*db*
                :*db-name*
                :connect
                :ensure-tables-exist
                :migrate-all)
  (:export :with-empty-db))
(in-package my-test.utils)
(defun random-string (length)
  ;; thanks 40ants/hacrm.
  (let ((chars "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"))
    (coerce (loop repeat length
                  collect (aref chars (random (length chars))))
            'string)))
(defmacro with-empty-db (&body body)
  "Run `body` with a new temporary DB."
  `(let* ((*random-state* (make-random-state t))
          (prefix (concatenate 'string
                               (random-string 8)
                               "/"))
          ;; Save our current DB connection.
          (connection (when (mito.connection:connected-p)
                        mito:*connection*)))
     (uiop:with-temporary-file (:pathname name :prefix prefix)
       ;; Bind our *db-name* to a new name, so as to create a new DB.
       (let* ((*db-name* name))
         ;; Always re-connect to our real DB even in case of error in body.
         (unwind-protect
           (progn
             ;; our functions to connect to the DB, create the tables and run the migrations.
             (connect)
             (ensure-tables-exist)
             (migrate-all)
             ,@body)
           (setf mito:*connection* connection))))))

使用方法如下：

(prove:subtest "Creation in a temporary DB."
  (with-empty-db
    (let ((user (make-user :name "Cookbook")))
      (save-user user)
      (prove:is (name user)
                "Cookbook"
                "Test username in a temp DB."))))
;; Creation in a temporary DB
;;  CREATE TABLE "user" (
;;       id BIGSERIAL NOT NULL PRIMARY KEY,
;;       name VARCHAR(64) NOT NULL,
;;       email VARCHAR(128) NOT NULL,
;;       created_at TIMESTAMP,
;;       updated_at TIMESTAMP,
;;       UNIQUE (email)
;; ) () [0 rows] | MITO.DB:EXECUTE-SQL
;; ✓ Test username in a temp DB.

exploring an existing (PostgreSQL) database with postmodern
mito-attachment
mito-auth
can a role-based access right control library
an advanced “defmodel” macro.

27. Databases