63 lines
2 KiB
Common Lisp
63 lines
2 KiB
Common Lisp
|
;; clog -- Supposedly simplistic blogging in Common Lisp
|
||
|
|
;; Copyright (C) 2013 Tom Willemse
|
||
|
|
|
||
|
|
;; clog is free software: you can redistribute it and/or modify
|
||
|
|
;; it under the terms of the GNU Affero General Public License as published by
|
||
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
||
|
|
;; (at your option) any later version.
|
||
|
|
|
||
|
|
;; clog is distributed in the hope that it will be useful,
|
||
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
|
|
;; GNU Affero General Public License for more details.
|
||
|
|
|
||
|
|
;; You should have received a copy of the GNU Affero General Public License
|
||
|
|
;; along with clog. If not, see <http://www.gnu.org/licenses/>.
|
||
|
|
|
||
|
|
(in-package :clog)
|
||
|
|
|
||
|
|
(defclass tag ()
|
||
|
|
((id :col-type serial :reader tag-id)
|
||
|
|
(name :col-type string :reader tag-name)
|
||
|
|
(slug :col-type (varchar 255) :reader tag-slug))
|
||
|
|
(:metaclass dao-class)
|
||
|
|
(:keys id))
|
||
|
|
|
||
|
|
(defclass post ()
|
||
|
|
((id :col-type serial :reader post-id)
|
||
|
|
(timestamp :col-type timestamp :reader post-time)
|
||
|
|
(type :col-type (varchar 10) :reader post-type)
|
||
|
|
(title :col-type (varchar 500) :reader post-title)
|
||
|
|
(author-email :col-type (varchar 255) :reader post-author-email)
|
||
|
|
(author-name :col-type (varchar 255) :reader post-author-name)
|
||
|
|
(author-md5 :col-type (varchar 255) :reader post-author-md5)
|
||
|
|
(slug :col-type (or db-null (varchar 255)) :reader post-slug)
|
||
|
|
(content :col-type string :reader post-content)
|
||
|
|
(parent :col-type (or db-null integer) :reader post-parent))
|
||
|
|
(:metaclass dao-class)
|
||
|
|
(:keys id))
|
||
|
|
|
||
|
|
(deftable tag
|
||
|
|
(!dao-def)
|
||
|
|
(!unique :name)
|
||
|
|
(!unique :slug))
|
||
|
|
|
||
|
|
(deftable post
|
||
|
|
(!dao-def)
|
||
|
|
(!foreign 'post 'parent 'id)
|
||
|
|
(!unique '(type slug)))
|
||
|
|
|
||
|
|
(deftable post-tag
|
||
|
|
(:create-table
|
||
|
|
post-tag ((post-id :type :integer)
|
||
|
|
(tag-id :type :integer)))
|
||
|
|
(!foreign 'post 'post-id 'id)
|
||
|
|
(!foreign 'tag 'tag-id 'id)
|
||
|
|
(!unique '(post-id tag-id)))
|
||
|
|
|
||
|
|
(defun prepare-tables ()
|
||
|
|
(map nil (lambda (tbl)
|
||
|
|
(unless (table-exists-p tbl)
|
||
|
|
(create-table tbl)))
|
||
|
|
'(post tag post-tag)))
|