diff --git a/rails-to-caveman.asd b/rails-to-caveman.asd
index 067b578..aef781c 100644
--- a/rails-to-caveman.asd
+++ b/rails-to-caveman.asd
@@ -17,6 +17,8 @@
;; HTML Template
#:djula
+ #:3bmd ; for markdown (Ch.9)
+ #:cl-who ; for markup (Ch.9)
;; for DB
#:mito ; <--- Added in Chapter 4.
diff --git a/src/config.lisp b/src/config.lisp
index f6ad242..7e00baf 100644
--- a/src/config.lisp
+++ b/src/config.lisp
@@ -1,10 +1,11 @@
(in-package #:cl-user)
(defpackage rails-to-caveman.config
- (:use #:cl
- #:rails-to-caveman.locale)
+ (:use #:cl)
(:import-from #:envy
#:config-env-var
#:defconfig)
+ (:import-from #:rails-to-caveman.locale
+ #:define-dictionary)
(:export #:config
#:*application-root*
#:*static-directory*
diff --git a/src/model.lisp b/src/model.lisp
index 747fffe..ac923b8 100644
--- a/src/model.lisp
+++ b/src/model.lisp
@@ -23,45 +23,58 @@
#:sex))
(in-package #:rails-to-caveman.model)
-(defclass user()
- ((number :col-type
- :integer
- :initarg
- :number
+(defclass article ()
+ ((title :initarg :title
+ :col-type (:varchar 80)
+ :accessor title-of)
+ (body :initarg :body
+ :col-type :text
+ :accessor body-of)
+ (date-released :initarg :date-released
+ :col-type :date
+ :accessor date-released-of)
+ (date-expired :initarg :date-expired
+ :col-type (or :null :date)
+ :accessor date-expired-of)
+ (member-only :initarg :member-only
+ :col-type :boolean
+ :initform "1" ; as NIL
+ :accessor member-only))
+ (:metaclass mito:dao-table-class))
+
+(defun user-and-article-table-check ()
+ (with-connection (db)
+ (mito:ensure-table-exists 'user)
+ (mito:ensure-table-exists 'article)))
+
+
+(defclass user ()
+ ((number :col-type :integer
+ :initarg :number
:accessor number-of)
(name :col-type (:varchar 64)
- :initarg
- :name
+ :initarg :name
:accessor name-of)
(full-name
:col-type (or (:varchar 128) :null)
- :initarg
- :full-name
+ :initarg :full-name
:accessor full-name-of)
(email :col-type (or :null :text)
- :initarg
- :email
+ :initarg :email
:accessor email-of)
(birthday :col-type (or :null :date)
- :initarg
- :birthday
+ :initarg :birthday
:accessor birthday-of)
- (sex :col-type
- :integer
- :initarg
- :sex
+ (sex :col-type :integer
+ :initarg :sex
:initform "1" ; <--- This!
:accessor sex-of)
- (administrator :col-type
- :boolean
- :initarg
- :administrator
+ (administrator :col-type :boolean
+ :initarg :administrator
:initform "1" ; as NIL. ; <--- This!
:accessor administrator-of)
- (password :col-type
- :text
- :initarg
- :password
+ (password :col-type :text
+ :initarg :password
:accessor password-of
:inflate #'cl-pass:hash ))
(:metaclass mito:dao-table-class))
@@ -95,13 +108,28 @@
;; function. I have, also, left a note in the
;; 'user' class definition highlighting this.
:administrator (zerop 0)
- :password "asagao!")))))
+ :password "asagao!"))
+ ;; "#.(" is an ARRAY LITERAL. (Noted in 'Loving Common Lisp' book).
+ (let ((body #.(with-output-to-string (*standard-output*)
+ (format t "Morning glory wins.~2%")
+ (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)))))))
(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 'user)
+ (mito:recreate-table 'article))
(seeds))
(defun ids ()
@@ -352,3 +380,17 @@ reference for future projects. This is a learning project after all.
(:assert (<= 1 sex 2)))
(administrator (:require t)
(:key (lambda(x) (zerop (parse-integer x)))))))))
+
+(defun validate-article (article &rest target-slots)
+ (with-check-validate (article) ; target-slots)
+ ((title (:require t)
+ (:type string)
+ (:assert (<= (length title) 80)))
+ (body (:require t)
+ (:type string)
+ (:assert (<= (length body) 2000)))
+ (date-released (:require t)
+ (:key #'local-time:parse-timestring))
+ (date-expired (:key #'local-time:parse-timestring))
+ (member-only (:require t)
+ (:key (lambda(x)(zerop(parse-integer x))))))))
diff --git a/src/view.lisp b/src/view.lisp
index f7e1fbc..52f89d1 100644
--- a/src/view.lisp
+++ b/src/view.lisp
@@ -40,7 +40,8 @@
;; Execute package definition
(defpackage rails-to-caveman.djula
- (:use #:cl)
+ (:use #:cl
+ #:3bmd)
(:import-from #:rails-to-caveman.config
#:config
#:appenv
@@ -49,7 +50,10 @@
#:rails-to-caveman.locale)
(:import-from #:caveman2
#:url-for)
- (:export #:title!) ; Added in Chapter 3 (Mockup section).
+ (:import-from #:cl-ppcre
+ #:regexp-replace-all)
+ (:export #:title! ; Added in Chapter 3 (Mockup section).
+ )
)
;; in-package and let code added in Chapter 3, also. This is
;; preperation for Switching Layout Templates section.
@@ -78,3 +82,8 @@
(rails-to-caveman.locale::find-acceptable-locale
(rails-to-caveman.locale::parse-accept-language
(rails-to-caveman.locale::accept-language)))) it))
+
+(djula::def-filter :simple-format (it)
+ (with-output-to-string (s)
+ (3bmd:parse-string-and-print-to-stream
+ (ppcre:regex-replace-all #\newline it "
") s)))
diff --git a/src/web.lisp b/src/web.lisp
index 8752c66..7132a30 100644
--- a/src/web.lisp
+++ b/src/web.lisp
@@ -7,7 +7,8 @@
#:rails-to-caveman.db
#:rails-to-caveman.model
#:sxql
- #:mito)
+ #:mito
+ #:cl-who)
(:export #:*web*))
(in-package #:rails-to-caveman.web)
@@ -33,9 +34,8 @@
;; '(:message "This is not a message") ; Added Chapter 3.
`(:numbers (1 2 3 4 5)
- :token ,(token))
- ;; :alert "Bitchin")
- ))
+ :token ,(token)
+ :alert "Bitchin")))
(defroute "/users/index"()
(render "users/index.html"
@@ -77,7 +77,7 @@
`(:user ,(current-user)
:new-user ,(with-connection (db)
(rails-to-caveman.model::validate-user
- (make-instance 'rails-to-caveman.model::user)))
+ (make-instance 'rails-to-caveman.model::user)))
:news (1 2 3 4 5)
:blogs (1 2 3 4 5)
,@(roles)
@@ -476,6 +476,201 @@ nil "/users/~D"(mito:object-id user))))))))
'(303 (:location "/")))
'(303 (:location "/")))))
+(defroute "/articles" ()
+ ;; (format t "[INFO] ~A and ~%" articles)
+ (if (not (hermetic:logged-in-p))
+ (render "/index.html"
+ `(:news (1 2 3 4 5)
+ :blogs (1 2 3 4 5)
+ :token ,(token)
+ :alert "Not logged in you muppet."))
+ (render "articles/index.html"
+ `(:user ,(current-user)
+ :news (1 2 3 4 5)
+ :blogs (1 2 3 4 5)
+ :token ,(token)
+ :articles ,(with-connection (db)
+ (mito:retrieve-dao 'rails-to-caveman.model::article))
+ ,@(roles)))))
+
+(defroute ("/articles" :method :post) (&key method)
+ (cond ((string= "put" method) (new-article
+ (lack.request:request-body-parameters ningle:*request*)))
+ (t `(401 () (,(format nil "Unknown method ~S" method))))))
+
+(defroute "/articles/:id" (&key id)
+ (if (null (ignore-errors (parse-integer id)))
+ (myway.mapper:next-route)
+ (render "articles/show.html"
+ `(:article ,(with-connection (db)
+ (mito:find-dao 'rails-to-caveman.model::article :id id))
+ ,@(roles)
+ :user ,(current-user)
+ :news (1 2 3 4 5)
+ :blogs (1 2 3 4 5)))))
+
+(defroute ("/articles/:id" :method :post)(&key method id)
+ (cond ((and (string= "post" method)
+ (ignore-errors(parse-integer id)))
+ (edit-article (acons "ID" id
+ (lack.request:request-body-parameters ningle:*request*))))
+ ((and (string= "delete" method)
+ (ignore-errors(parse-integer id)))
+ (destroy-article (acons "ID" id
+ (lack.request:request-body-parameters ningle:*request*))))
+ (t `(401()(,(format nil "Unknown method ~S"method))))))
+
+(defroute destroy-article ("/article/:id" :method :delete)
+ (&key authenticity-token id)
+ (if (not (string= authenticity-token(token)))
+ '(401()("Denied"))
+ (if (not (hermetic:logged-in-p))
+ '(403 () ("Denied"))
+ (if (null (ignore-errors (setf id (parse-integer id))))
+ (myway.mapper:next-route)
+ (progn (with-connection (db)
+ (mito:delete-by-values 'rails-to-caveman.model::article :id id))
+ `(303 (:location "/articles")))))))
+
+(defroute "/articles/new" ()
+ (render "articles/new.html"
+ `(:article ,(make-instance 'rails-to-caveman.model::article)
+ :user ,(current-user)
+ :new (1 2 3 4 5)
+ :blogs (1 2 3 4 5)
+ ,@(roles)
+ :token ,(token))))
+
+(defroute new-article ("/articles" :method :put)
+ (&key authenticity-token
+ released-year
+ released-month
+ released-day
+ released-hour
+ released-min
+ expired-year
+ expired-month
+ expired-day
+ expired-hour
+ expired-min)
+ ;; (dev:peep ningle:*request*)
+ (force-output)
+ (if (not (string= authenticity-token (token)))
+ `(401 () ("Denied"))
+ (with-connection (db)
+ (let ((render-args `(:user ,(current-user)
+ ,@(roles)
+ :token ,(token)
+ :news (1 2 3 4 5)
+ :blogs (1 2 3 4 5)))
+ (now-time (local-time:now)))
+ (multiple-value-bind (article errors)
+ (rails-to-caveman.model::validate-article
+ (apply #'make-instance 'rails-to-caveman.model::article
+ :allow-other-keys t
+ ;; This deviates from Chapter 9's code because
+ ;; the new article form does not populate the
+ ;; date-released part of the form properly. So,
+ ;; to get around it, date-released is created
+ ;; here instead of it being passed in to this
+ ;; function as values to be parsed.
+ :date-released (format nil "~A-~A-~AT~A:~A:00"
+ (local-time:timestamp-year now-time)
+ (local-time:timestamp-month now-time)
+ (local-time:timestamp-day now-time)
+ (local-time:timestamp-hour now-time)
+ (local-time:timestamp-minute now-time))
+ :date-expired (format nil "~A-~A-~AT~A:~A:00"
+ expired-year
+ expired-month
+ expired-day
+ expired-hour
+ expired-min)
+ (request-params (lack.request:request-body-parameters ningle:*request*))))
+ (if errors
+ (step
+ (render "articles/new.html"
+ (list* :article article
+ :errors errors
+ render-args)))
+ (progn (mito:insert-dao article)
+ (setf (gethash :notice ningle:*session*) "Stored")
+ `(303 (:location
+ ,(format nil "/articles/~D"
+ (mito:object-id article)))))))))))
+
+
+(defroute "/articles/:id/edit" (&key id)
+ (render "articles/edit.html"
+ `(:article ,(with-connection (db)
+ (mito:find-dao
+ 'rails-to-caveman.model::article :id id))
+ :user ,(current-user)
+ ,@(roles)
+ :token ,(token)
+ :news (1 2 3 4 5)
+ :blogs (1 2 3 4 5))))
+
+(defun edit-article (request)
+ (step
+ (destructuring-bind
+ (&key authenticity-token
+ id
+ title
+ body
+ released-min
+ released-hour
+ released-day
+ released-month
+ released-year
+ expired-min
+ expired-hour
+ expired-day
+ expired-month
+ expired-year
+ member-only
+ &allow-other-keys)
+ (request-params request)
+ (if (not (string= authenticity-token (token)))
+ '(401 () ("Denied"))
+ (if (not (hermetic:logged-in-p))
+ '(403 () ("Denied"))
+ (let ((article (with-connection (db)
+ (mito:find-dao
+ 'rails-to-caveman.model::article :id id))))
+ (setf (rails-to-caveman.model::title-of article) title
+ (rails-to-caveman.model::body-of article) body
+ (rails-to-caveman.model::date-released-of article)
+ (format nil "~A-~A-~AT~A:~A:00"
+ released-year
+ released-month
+ released-day
+ released-hour
+ released-min)
+ (rails-to-caveman.model::date-expired-of article)
+ (format nil "~A-~A-~AT~A:~A:00"
+ expired-year
+ expired-month
+ expired-day
+ expired-hour
+ expired-min)
+ (rails-to-caveman.model::member-only article) member-only)
+ (multiple-value-bind (article errors)
+ (rails-to-caveman.model::validate-article
+ (if errors (render "articles/edit.html"
+ `(:article ,article
+ :errors ,errors
+ :user ,(current-user)
+ ,@(roles)
+ :token ,(token)
+ :news (1 2 3 4 5)
+ :blogs (1 2 3 4 5)))
+ (progn (with-connection (db)
+ (mito:save-dao article))
+ (setf (gethash :notice ningle:*session*) "Updated")
+ `(303 (:location ,(format nil "/articles/~D"
+ (mito:object-id article))))))))))))))
+
(defroute "/about" ()
;; about.html should be in the /templates directory.
@@ -673,3 +868,14 @@ nil "/users/~D"(mito:object-id user))))))))
(mito:find-dao
'rails-to-caveman.model::user
:id (gethash :id ningle:*session*))))
+
+(defun date-options (&key (start 0) (end 0) (target start) labels)
+ (loop :for i
+ :upfrom start :to end
+ :collect (cl-who:with-html-output-to-string (*standard-output*)
+ ((:option
+ :value i
+ :selected (when (eql i target) "selected"))
+ (princ (if labels (aref labels i) i))))
+ :into options
+ :finally (return (format nil "~{~A~%~}" options))))
diff --git a/static/locale/ja-jp.lisp b/static/locale/ja-jp.lisp
index b9917bd..68cc5b7 100644
--- a/static/locale/ja-jp.lisp
+++ b/static/locale/ja-jp.lisp
@@ -9,4 +9,6 @@
("Email" . "メールアドレス")
("Administrator" . "管理者")
("Create user" . "登録する")
- ("is required" . "を入力してください。"))
+ ("is required" . "を入力してください。")
+ ("logged in" . "JAPANESE TRANSLATION -- NOT LOGGED IN")
+ ("Stored" . "the article is stored (the japanese version)"))
diff --git a/templates/articles/edit.html b/templates/articles/edit.html
new file mode 100644
index 0000000..5a9ccbe
--- /dev/null
+++ b/templates/articles/edit.html
@@ -0,0 +1,17 @@
+{% extends "layouts/app.html" %}
+{% block title %}{% lisp (title! "Edit article") %}{% endblock %}
+
+{% block content %}
+
+ | + |
---|---|
+ | + |
+ | + + + + + - + + + | +
+ | + + + + - + + + | +
Member only | ++ + + + | +
title | +date | +operation | +
---|---|---|
{{article.title}} | +{{ article.date-released + | date: ((:year 4)"/"(:month 2)"/"(:day 2)" "(:hour 2)":"(:min 2)) + }} | ++ Edit| + + | +
No articles
+{% endif %} +{% endblock %} diff --git a/templates/articles/new.html b/templates/articles/new.html new file mode 100644 index 0000000..5a993d5 --- /dev/null +++ b/templates/articles/new.html @@ -0,0 +1,14 @@ +{% extends "layouts/app.html" %} +{% block title %} {% lisp (title! "Making new article") %} {% endblock %} + +{% block content %} +Title | +{{article.title}} | +
---|---|
Article | +{{ article.body | simple-format | safe }} | +
Released at | +{{ article.date-released | date: ((:year 4)"/"(:month 2)"/"(:day 2)" "(:hour 2)":"(:min 2)) }} | +
Expired at | ++ {% if article.date-expired %} + {{ article.date-expired | date: ((:year 4)"/"(:month 2)"/"(:day 2)" "(:hour 2)":"(:min 2)) }} + {% endif %} + | +
Member only | +{% if article.member-only-p %}Is a member{% else %}Is not a member{% endif %} | +
{{notice}}
+{% endif %} +{% include "shared/errors.html" %} - - {% include "shared/sidebar.html" %}