Chapter 10 commit.

This chapter focued on using foreign keys to reference other tables in
the SQLite database. The multiple associate models code examples are
all based on mito (the ORM) and, as always with ORM's, I always feel
lost using them. So, I do not know how to sum this commit up apart
from say Chapter 10 committed.

rails-to-caveman.asd

@@ -11,6 +11,7 @@
                #:uiop
 	       #:local-time ; <-- Added Chapter 6
 	       #:ratify ; <-- Chapter 7
+	       #:trivia ; <-- Chapter 10
 
                ;; for @route annotation
                #:cl-syntax-annot

src/model.lisp

@@ -43,10 +43,9 @@
 		  :accessor member-only))
   (:metaclass mito:dao-table-class))
 
-(defun user-and-article-table-check ()  
+(defun user-article-and-entry-table-check ()  
   (with-connection (db)
-    (mito:ensure-table-exists 'user)
-    (mito:ensure-table-exists 'article)))
+    (mito:ensure-table-exists '(user article entry))))
 	
 
 (defclass user ()
@@ -116,21 +115,30 @@
 		      (write-line "hgoe hoge boge hoge")
 		      (write-line "fuga fuga guffaug uga")
 		      (write-line "tasdf asdf asdf sadf")))
-		      (now-time (local-time:now)))
-		  (dotimes (x 10)
-		    (mito:create-dao 'article
-				     :title (format nil "Result:~D" x)
-				     :body body
-				     :date-released (local-time:timestamp- now-time (- 8 x) :day)
-				     :date-expired (local-time:timestamp- now-time (- 2 x) :day)
-				     :member-only (zerop 0)))))))
+	    (now-time (local-time:now)))
+	(dotimes (x 10)
+	  (mito:create-dao 'article
+			   :title (format nil "Result:~D" x)
+			   :body body
+			   :date-released (local-time:timestamp- now-time (- 8 x) :day)
+			   :date-expired (local-time:timestamp- now-time (- 2 x) :day)
+			   :member-only (zerop 0)))
+	(dolist (name '("Jiro" "Taro" "Hana"))
+	  (let ((user (mito:find-dao 'user :name name)))
+	    (when user (dotimes (x 10)
+			 (mito:create-dao 'entry
+					  :user user
+					  :title (format nil "Title~D" x)
+					  :body body
+					  :date-posted (local-time:timestamp- now-time (- 10 x) :day)
+					  :status (nth (rem x 3) '("draft" "member-only" "public")))))))))))
 
 
 (defun rebuild ()
   "Drops the current database table, recreates it and populates it using seeded data."
   (with-connection (db)
-    (mito:recreate-table 'user)
-    (mito:recreate-table 'article))
+    (mapc #'mito:ensure-table-exists '(user article entry))
+    (mapc #'mito:recreate-table '(user article entry)))
   (seeds))
 
 (defun ids ()
@@ -437,3 +445,60 @@ reference for future projects. This is a learning project after all.
 			     expired-hour
 			     expired-min)))
 	      ,@args)))
+
+(defclass entry()
+  ((user
+    :col-type user
+    :initarg :user
+    :accessor author-of
+    :reader author)
+   (title
+    :col-type (:varchar 200)
+    :initarg :title
+    :accessor title-of)
+   (body
+    :col-type (or :null :text)
+    :initarg :body
+    :accessor body-of)
+   (date-posted
+    :col-type :date
+    :initarg :date-posted
+    :accessor date-posted-of)
+   (status
+    :col-type (:varchar 16)
+    :initarg :status
+    :initform "draft"))
+  (:metaclass mito:dao-table-class))
+
+(defmethod initialize-instance
+    :around((o entry) &rest args
+	    &key posted-year
+	      posted-month
+	      posted-day
+	      posted-hour
+	      posted-min
+	      date-posted
+	    &allow-other-keys)
+  (apply #'call-next-method o
+	 `(,@ (when (and (null date-posted) posted-year)
+		`(:date-posted ,(format nil "~A-~A-~AT~A:~A:00"
+					posted-year
+					posted-month
+					posted-day
+					posted-hour
+					posted-min))) ,@args)))
+
+(defmethod mito:delete-dao :before((user user))
+  (mito:delete-by-values 'entry
+			 :user-id (mito:object-id user)))
+
+(defun validate-entry (entry &rest target-slots)
+  (with-check-validate (entry) ;target-slots)
+      ((title (:require t)
+	      (:type string)
+	      (:assert (<= 1 (length title) 200)))
+       (body (:require t))
+       (date-posted (:require t)
+		    (:key #'local-time:parse-timestring))
+       (status (:require t)
+	       (:assert (find status '("draft" "member-only" "public"):test #'equal))))))

src/web.lisp

@@ -330,6 +330,175 @@ nil "/users/~D"(mito:object-id user))))))))
 				    `(303 (:location
 					   ,(format nil "/user/~D" id))))))))))))
 
+(defroute ("/entries" :method :post) (&key method)
+  (cond ((string= "put" method)
+	 (create-entry (lack.request:request-body-parameters
+			ningle:*request*)))
+	(t `(401 () (,(format nil "Unknown method ~S" method))))))
+
+(defroute entries-index "/entries" (&key id)
+  (with-connection (db)
+    (let ((author (when id (mito:find-dao
+			    'rails-to-caveman.model::user :id id))))
+      (format t "[INFO] ~A" author)
+      (render "entries/index.html"
+	      `(:member ,author
+		:user ,(current-user)
+		:news ,(articles-make 5)
+		:blogs ,(entries :limit 5)
+		:articles ,(articles-make 5)
+		:entries ,(entries :author author)
+		,@(roles)
+		:token ,(token)
+		;; :member ,(rails-to-caveman.model::author-of entry))))))
+		)))))
+
+(defroute show-entry "/entries/:id" (&key id)
+  (if (null (ignore-errors (parse-integer id)))
+      (myway:next-route)
+      (with-connection (db)
+      (let ((entry (mito:find-dao 'rails-to-caveman.model::entry :id id))
+	    (entries (entries :limit 5)))
+	(render "entries/show.html"
+		`(,@(roles)
+		  :entry ,entry
+		  :token ,(token)
+		  :user ,(current-user)
+		  :entries ,entries
+		  :blogs ,entries
+		  :news ,(articles 5)
+		  :member ,(rails-to-caveman.model::author-of entry)))))))
+
+(defroute create-entry ("/entries" :method :post) ; :post was :put
+  (&key authenticity-token)
+  (step
+  (if (not (string= authenticity-token (token)))
+      '(401 () ("Denied"))
+      (with-connection (db)
+	(multiple-value-bind (entry errors)
+	    (rails-to-caveman.model::validate-entry
+	     (apply #'make-instance 'rails-to-caveman.model::entry
+		    :user (current-user)
+		    (request-params
+		     (lack.request:request-body-parameters
+		      ningle:*request*))))
+	  (if errors (render "entries/new.html"
+			     `(,@(roles)
+			       :entry ,entry
+			       :token ,(token)
+			       :errors ,errors
+			       :user ,(current-user)
+			       :blogs ,(entries :limit 5)
+			       :news ,(articles 5)))
+	      (progn (mito:save-dao entry)
+		     (setf (gethash :notice ningle:*session*)
+			   "Stored")
+		     `(303 (:location
+			    ,(format nil "/entries/~D"
+				     (mito:object-id entry)))))))))))
+
+(defroute ("/entries/:id" :method :post) (&key method id)
+  (step
+  (cond ((string= "post" method)
+	 (update-entry (acons "ID" id
+			      (lack.request:request-body-parameters
+			       ningle:*request*))))
+	((string= "delete" method)
+	 (destroy-entry (acons "ID" id
+			       (lack.request:request-body-parameters
+				ningle:*request*))))
+	(t `(401 () (,(format nil "Unknown method ~S" method)))))))
+
+(defun update-entry (request)
+  (destructuring-bind (&key
+			 authenticity-token
+			 id
+			 title
+			 body
+			 posted-year
+			 posted-month
+			 posted-day
+			 posted-hour
+			 posted-min
+		       &allow-other-keys)
+      (request-params request)
+    (if (not (string= authenticity-token(token)))
+	'(401 ()("Denied"))
+	(if (null (ignore-errors (parse-integer id)))
+	    (myway:next-route)
+	    (with-connection (db)
+	    (let ((entry (mito:find-dao
+			  'rails-to-caveman.model::entry :id id)))
+	      (setf (rails-to-caveman.model::title-of entry) title
+		    (rails-to-caveman.model::body-of entry) body
+		    (rails-to-caveman.model::date-posted-of entry)
+		    (format nil "~A-~A-~AT~A:~A:00"
+			    posted-year
+			    posted-month
+			    posted-day
+			    posted-hour
+			    posted-min))
+	      (multiple-value-bind (entry errors)
+		  (rails-to-caveman.model::validate-entry entry)
+		(if errors (render "entries/edit.html"
+				   `(,@(roles)
+				     :member ,(rails-to-caveman.model::author-of entry)
+				     :user ,(current-user)
+				     :token ,(token)
+				     :entry ,entry
+				     :news ,(articles 5)
+				     :blogs ,(entries :limit 5)
+				     :errors ,errors ))
+		    (progn (mito:save-dao entry)
+			   (setf (gethash :notice ningle:*session*) "Updated")
+			   `(303 (:location
+				  ,(format nil "/entries/~D"
+					   (mito:object-id entry)))))))))))))
+
+(defroute "/entries/new" (&key)
+  (step
+   (render "entries/new.html"
+	   `(,@(roles)
+	       :token ,(token)
+	       :entry ,(make-instance 'rails-to-caveman.model::entry
+				      :date-posted
+				      (local-time:now))
+	       :user ,(current-user)
+	       :blogs ,(entries :limit 5)
+	       :news ,(articles 5)))))
+
+(defroute "/entries/:id/edit" (&key id)
+  (if (null (ignore-errors (parse-integer id)))
+      (myway:next-route)
+      (render "entries/edit.html"
+	      `(,@(roles)
+		:entry ,(with-connection (db)
+			  (mito:find-dao 'rails-to-caveman.model::entry :id id))
+		:user ,(current-user)
+		:blogs ,(entries :limit 5)
+		:news ,(articles 5)))))
+
+(defroute destroy-entry ("/entries/:id" :method :delete)
+  (&key authenticity-token id)
+  (if (not (string= authenticity-token (token)))
+      '(401 () ("Denied"))
+      (with-connection (db)
+      (if (null (ignore-errors (parse-integer id)))
+	  (myway:next-route)
+	  (let ((entry (mito:find-dao 'rails-to-caveman.model::entry :id id)))
+	    (if (null entry)
+		`(401 () (,(format nil "Entry id ~A is not exist" id)))
+		(progn (mito:delete-dao entry)
+		       (setf (gethash :notice ningle:*session*) "Deleted")
+		       `(303 (:location
+			      ,(format nil "/user/~D/entries"
+				       (mito:object-id (current-user))))))))))))
+
+(defroute "/user/:id/entries" (&key id)
+  (entries-index (acons "ID" id
+			(lack.request:request-body-parameters
+			 ningle:*request*))))
+
 (defroute "/account" ()
   (if (not (hermetic:logged-in-p))
       '(401 ())
@@ -558,7 +727,7 @@ nil "/users/~D"(mito:object-id user))))))))
 		     ,@(roles)
 		     :token ,(token))))
 
-(defroute new-article ("/articles" :method :put)
+(defroute new-article ("/articles" :method :put) ; :put need to be put?
   (&key authenticity-token no-expiration-p)
   (if (not (string= authenticity-token (token)))
       '(401 () ("Denied"))
@@ -974,3 +1143,26 @@ nil "/users/~D"(mito:object-id user))))))))
 ;; 			    (:= :only-member your-app.model::+false+)))
 ;; 	  (sxql:order-by(:desc :date-released))
 ;; 	  (sxql:limit n)))))
+
+(defun entries (&key (logged-in-p (hermetic:logged-in-p))
+		  (user (and logged-in-p (current-user)))
+		  author limit)
+  (with-connection (db)
+    (mito:select-dao 'rails-to-caveman.model::entry
+      (sxql:where (trivia:match*(logged-in-p author)
+		    ((nil nil) `(:= "public" :status))
+		    ((nil _)
+		     `(:and (:= ,(mito:object-id author) :user-id)
+			    (:= "public" :status)))
+		    ((_ nil) `(:or (:= "public" :status)
+				   (:= "member-only" :status)
+				   (:and (:= "draft" :stats)
+					 (:= ,(mito:object-id user)
+					  :user-id))))
+		    ((_ _) (if(mito:object= user author)
+			      `(:= ,(mito:object-id user)
+				:user-id)
+			      `(:and (:= ,(mito:object-id author) :user-id)
+				     (:or (:= "public" :status)
+					  (:= "member-only" :status)))))))
+      (sxql:order-by (:desc :date-posted)) (when limit (sxql:limit limit)))))

templates/entries/edit.html

@@ -0,0 +1,16 @@
+{% extends "layouts/app.html" %}
+
+{% block title %}
+{% lisp (title! "Edit blog") %}
+{% endblock %}
+
+{% block content %}
+<h1>{% lisp (title!) %}</h1>
+
+<form class="edit-entry" id="edit-entry" action="/entries/{{entry.id}}" method="post">
+        <input type="hidden" name="ANTHENTICITY-TOKEN" value="{{token}}">
+        <input type="hidden" name="METHOD" value="put">
+        {% include "entries/form.html" %}
+        <div><input type="submit" value="Submit"></div>
+</form>
+{% endblock %}

templates/entries/footer.html

@@ -0,0 +1,20 @@
+<ul class="entry-footer">
+  {% if user %}
+  <li>{{entry.status}}</li>
+  {% ifequal user.id member.id %}
+  <a href="/entries/{{entry.id}}/edit">Edit</a>
+
+  <form action="/entries/{{entry.id}}" method="post">
+    <input type="hidden" name="AUTHENTICITY-TOKEN" value="{{token}}">
+    <input type="hidden" name="METHOD" value="delete">
+    <input type="submit" value="Delete">
+  </form>
+  
+  {% endifequal %}
+  {% endif %}
+
+  <li> by <a href="/user/{{entry.user-id}}/entries"> {{entry.author.name}} </a> </li>
+  <li>{{ entry.date-posted
+    | date: ((:year 4)"/"(:month 2)"/"(:day 2)" "(:hour 2)":"(:min 2)) }}
+  </li>
+</ul>

templates/entries/form.html

@@ -0,0 +1,62 @@
+{% include "shared/errors.html" %}
+<p>{{entry.date-posted}}</p>
+<table class="attr">
+        <tr>
+                <th width="80"><label for="title">Title</label></th>
+                <td><input type="text" name="TITLE" id="title" size="50" value="{{entry.title}}"/></td>
+        </tr>
+        <tr>
+                <th><label for="body">Body</label></th>
+                <td><textarea name="BODY" id="body" rows="10" cols="45">{{entry.body}}</textarea></td>
+        </tr>
+        <tr>
+                <th><label for="posted-at">Date</label></th>
+                <td>
+                        <select id="posted-year" name="POSTED-YEAR">
+                                {{ entry.date-posted
+                                 | lisp: (lambda(timestamp)
+                                           (let ((year (local-time:timestamp-year (local-time:now))))
+                                             (date-options :start 2000 :end (1+ year)
+                                                           :target (local-time:timestamp-year timestamp))))
+                                 | safe
+                                 }}
+                        </select>
+                        <select id="posted-month" name="POSTED-MONTH">
+                                {{ entry.date-posted
+                                 | lisp: (lambda(timestamp)
+                                           (date-options :start 1 :end 12
+                                                         :target (local-time:timestamp-month timestamp)))
+                                 | safe }}
+                        </select>
+                        <select id="posted-day" name="POSTED-DAY">
+                                {{ entry.date-posted
+                                 | lisp: (lambda(timestamp)
+                                           (date-options :start 1 :end 31
+                                                         :target (local-time:timestamp-day timestamp)))
+                                 | safe }}
+                        </select>
+                        -
+                        <select id="posted-hour" name="POSTED-HOUR">
+                                {{ entry.date-posted
+                                 | lisp: (lambda(timestamp)
+                                           (date-options :end 59 :target (local-time:timestamp-hour timestamp)))
+                                 | safe }}
+                        </select>
+                        <select id="posted-min" name="POSTED-MIN">
+                                {{ entry.date-posted
+                                 | lisp: (lambda(timestamp)
+                                           (date-options :end 59 :target (local-time:timestamp-minute timestamp)))
+                                 | safe }}
+                        </select>
+                </td>
+        </tr>
+        <tr>
+                <th><label for="status">Status</label></th>
+                <td><select id="status" name="STATUS">
+                                <option value="draft" selected>Draft</option>
+                                <option value="member-only">Member only</option>
+                                <option value="public">Public</option>
+                        </select>
+                </td>
+        </tr>
+</table>

templates/entries/index.html

@@ -0,0 +1,39 @@
+{% extends "layouts/app.html" %}
+{% block title %}
+
+{% if member %}
+{{ member.name
+| lisp: (lambda (name) (title! (format nil "~A San's blog" name))) 
+}}
+{% else %}
+
+{% lisp (title! "Member blog") %}
+
+{% endif %}
+{% endblock %}
+
+{% block content %}
+
+<h1>{% lisp (title!) %}</h1>
+
+{% if user %}
+<div class="toolbar">
+  <a href="/entries/new">Write blog</a>
+</div>
+{% endif %}
+
+{% if entries %}
+{% for entry in entries %}
+
+<h2>{{entry.title}}</h2> 
+<p>{{ entry.body | truncatechars: 80 }}</p>
+<a href="/entries/{{entry.id}}">More</a>
+
+{% include "entries/footer.html" %}
+{% endfor %}
+{% else %}
+
+<p>No entries</p>
+
+{% endif %}
+{% endblock %}

templates/entries/new.html

@@ -0,0 +1,16 @@
+{% extends "layouts/app.html" %}
+
+{% block title %}
+{% lisp (title! "Write new blog") %}
+{% endblock %}
+
+{% block content %}
+<h1>{% lisp (title!) %}</h1>
+
+<form class="new-entry" id="new-entry" action="/entries" method="post">
+        <input type="hidden" name="AUTHENTICITY-TOKEN" value="{{token}}">
+        <input type="hidden" name="METHOD" value="put">
+        {% include "entries/form.html" %}
+        <div><input type="submit" value="Submit"></div>
+</form>
+{% endblock %}

templates/entries/show.html

@@ -0,0 +1,17 @@
+{% extends "layouts/app.html" %}
+
+{% block title %}
+{{ entry
+ | lisp: (lambda(entry)
+           (title! (format nil "~A - ~A San's blog"
+                           (rails-to-caveman.model::title-of entry)
+                           (rails-to-caveman.model::name-of (rails-to-caveman.model::author-of entry)))))
+ }}
+{% endblock %}
+
+{% block content %}
+<h1>{% lisp (title!) %}</h1>
+<h2>{{entry.title}}</h2>
+{{ entry.body | simple-format | safe }}
+{% include "entries/footer.html" %}
+{% endblock %}

templates/shared/header.html

@@ -4,7 +4,7 @@
   <ul>
     <li><a href="/">Home</a></li>
     <li><a href="/articles">News</a></li>
-    <li><a href="#">Blog</a></li>
+    <li><a href="/entries">Blog</a></li>
     <li><a href="/account">{{user.name}}-San</a></li>
     <li><a href="/users/index">Members</a></li>
     {% if logged-in %}

templates/shared/sidebar.html

@@ -10,7 +10,9 @@
 
 <h2>Member Blog</h2>
 <ul>
-  {% for b in blogs %}
-  <li><a href="#">Blog Header</a></li>
+  {% for entry in entries %}
+  <li><a href="/entries/{{entry.id}}">{{entry.title}}</a>
+    by <a href="/user/{{entry.user-id}}/entries">{{member.name}}
+  </li>
   {% endfor %}
 </ul>