Browse Source

end of session commit.

I'm finishing up at the studio. So, just checking in the changes mades
so far.. so I can carry-on at home.
master
Craig Oates 2 years ago
parent
commit
be06811cd6
  1. 2
      rails-to-caveman.asd
  2. 5
      src/config.lisp
  3. 96
      src/model.lisp
  4. 13
      src/view.lisp
  5. 216
      src/web.lisp
  6. 4
      static/locale/ja-jp.lisp
  7. 17
      templates/articles/edit.html
  8. 117
      templates/articles/form.html
  9. 40
      templates/articles/index.html
  10. 14
      templates/articles/new.html
  11. 37
      templates/articles/show.html
  12. 4
      templates/index.html
  13. 7
      templates/layouts/app.html
  14. 2
      templates/shared/errors.html
  15. 2
      templates/shared/header.html
  16. 2
      templates/shared/user_form.html

2
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.

5
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*

96
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))))))))

13
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 "<br>") s)))

216
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))))

4
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)"))

17
templates/articles/edit.html

@ -0,0 +1,17 @@
{% extends "layouts/app.html" %}
{% block title %}{% lisp (title! "Edit article") %}{% endblock %}
{% block content %}
<h1>{% lisp (title!) %}</h1>
<p><a href="/articles/{{article.id}}">Go back article</a></p>
<form class="edit-article" id="edit-article" action="/articles/{{article.id}}" method="post">
<input type="hidden" name="AUTHENTICITY-TOKEN" value="{{token}}" />
<input type="hidden" name="METHOD" value="post">
{% include "articles/form.html" %}
<div><input type="submit" name="commit" value="Commit"></div>
</form>
{% endblock %}

117
templates/articles/form.html

@ -0,0 +1,117 @@
{% include "shared/errors.html" %}
<table class="attr">
<tr>
<th><label for="title">Title</label></th>
<td><input name="TITLE" id="title" type="text" value="{{article.title}}"/></td>
</tr>
<tr>
<th><label for="body">Body</label></th>
<td><textarea rows="10" cols="45" name="BODY" id="body">{{article.body}}</textarea></td>
</tr>
<tr>
<th><label for="released-year">Date released</label></th>
<td>
<!-- NOTE TAKEN FROM CHAPTER 9:
Regarding the above template, the above code
article.date-releasedstarts from a variable reference such
as , for example. For unknown reasons, if you use this
origin variable as article a code that receives the object
itself, the last SAFEfilter will not work for some reason.
I'm wondering if it's a bug on the DJULA side, but I'm not
confident. -->
<select id="released-year" name="RELEASED-YEAR">
{{ article.date-released
| 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="released-month" name="RELEASED-MONTH">
{{ article.date-released
| lisp: (lambda(timestamp)
(date-options :start 1 :end 12
:target (local-time:timestamp-month timestamp)))
| safe }}
</select>
<select id="released-day" name="RELEASED-DAY">
{{ article.date-released
| lisp: (lambda(timestamp)
(date-options :start 1 :end 31
:target (local-time:timestamp-day timestamp)))
| safe }}
</select>
-
<select id="released-hour" name="RELEASED-HOUR">
{{ article.date-released
| lisp: (lambda(timestamp)
(date-options :end 59 :target (local-time:timestamp-hour timestamp)))
| safe }}
</select>
<select id="released-min" name="RELEASED-MIN">
{{ article.date-released
| lisp: (lambda(timestamp)
(date-options :end 59 :target (local-time:timestamp-minute timestamp)))
| safe }}
</select>
</td>
</tr>
<tr>
<th><label for="expired-year">Date expired</label></th>
<td>
<select id="expired-year" name="EXPIRED-YEAR">
{{ article.date-expired
| lisp: (lambda(arg)
(let((year(local-time:timestamp-year(local-time:now)))
(timestamp(or arg (local-time:now))))
(date-options :start 2000 :end (1+ year)
:target (local-time:timestamp-year timestamp))))
| safe }}
</select>
<select id="expired-month" name="EXPIRED-MONTH">
{{ article.date-expired
| lisp: (lambda(arg)
(date-options :start 1 :end 12
:target (local-time:timestamp-month (or arg
(local-time:now)))))
| safe }}
</select>
<select id="expired-day" name="EXPIRED-DAY">
{{ article.date-expired
| lisp: (lambda(arg)
(let((timestamp(or arg (local-time:now))))
(date-options :start 1 :end 31
:target (local-time:timestamp-day timestamp))))
| safe }}
</select>
-
<select id="expired-hour" name="EXPIRED-HOUR">
{{ article.date-expired
| lisp: (lambda(arg)
(let((timestamp(or arg (local-time:now))))
(date-options :end 59
:target (local-time:timestamp-hour timestamp))))
| safe }}
</select>
<select id="expired-min" name="EXPIRED-MIN">
{{ article.date-expired
| lisp: (lambda(arg)
(let((timestamp(or arg (local-time:now))))
(date-options :end 59
:target (local-time:timestamp-minute timestamp))))
| safe }}
</select>
</td>
</tr>
<tr>
<th>Member only</th>
<td>
<label for="member-only">Member only</label>
<!-- <input name="MEMBER-ONLY" type="hidden" value="0"> -->
<input type="checkbox" id="member-only" name="MEMBER-ONLY" value="1" {% if article.member-only %}checked{% endif %} />
</td>
</tr>
</table>

40
templates/articles/index.html

@ -0,0 +1,40 @@
{% extends "layouts/app.html" %}
{% block title %}{% lisp (title! "List of articles") %}{% endblock %}
{% block content %}
<h1>{% lisp (title!) %}</h1>
<div class="toolbar"><a href="/articles/new">Write new article</a></div>
{% if articles %}
<table class="list">
<thead>
<tr>
<th>title</th>
<th>date</th>
<th>operation</th>
</tr>
</thead>
<tbody>
{% for article in articles %}
<tr>
<td><a href="/articles/{{article.id}}">{{article.title}}</a></td>
<td>{{ article.date-released
| date: ((:year 4)"/"(:month 2)"/"(:day 2)" "(:hour 2)":"(:min 2))
}}</td>
<td>
<a href="/articles/{{article.id}}/edit">Edit</a>|
<form action="/articles/{{article.id}}/delete" method="post">
<input type="hidden" name="AUTHENTICITY-TOKEN" value="{{token}}">
<input type="hidden" name="METHOD" value="delete">
<input type="submit" value="Delete">
</form>
</td>
</tr>
{% endfor %}
</tbody>
</table>
{% else %}
<p>No articles</p>
{% endif %}
{% endblock %}

14
templates/articles/new.html

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

37
templates/articles/show.html

@ -0,0 +1,37 @@
{% extends "layouts/app.html" %}
{% block title %}{{article.title}} - {% lisp (title!) %}{% endblock %}
{% block content %}
<h1>{{article.title}}</h1>
{% if logged-in %}
<div class="toolbar"><a href="/articles/{{article.id}}/edit">Edit</a></div>
{% endif %}
<table class="attr">
<tr>
<th width="100">Title</th>
<td>{{article.title}}</td>
</tr>
<tr>
<th>Article</th>
<td>{{ article.body | simple-format | safe }}</td>
</tr>
<tr>
<th>Released at</th>
<td>{{ article.date-released | date: ((:year 4)"/"(:month 2)"/"(:day 2)" "(:hour 2)":"(:min 2)) }}</td>
</tr>
<tr>
<th>Expired at</th>
<td>
{% if article.date-expired %}
{{ article.date-expired | date: ((:year 4)"/"(:month 2)"/"(:day 2)" "(:hour 2)":"(:min 2)) }}
{% endif %}
</td>
</tr>
<tr>
<th>Member only</th>
<td>{% if article.member-only-p %}Is a member{% else %}Is not a member{% endif %}</td>
</tr>
</table>
{% endblock %}

4
templates/index.html

@ -15,6 +15,10 @@
{% block title %}Rails to Caveman2 Demo.{% endblock %}
{% block content %}
{% if notice %}
<p class="alert">{{notice}}</p>
{% endif %}
{% include "shared/errors.html" %}
<!--
This message is passed from the router in /src/web.lisp. There is
no guarantee it will contain anything n it, though.

7
templates/layouts/app.html

@ -12,14 +12,11 @@
</header>
<main>
{% if notice %}
<p class="notice">{{notice}}</p>
{% endif %}
<p class="notice">{{alert}}</p>
{% endif %}
{% block content %}{% endblock %}
</main>
<aside id="sidebar">
<!-- {REMOVE% lisp (rails-to-caveman.view:render "shared/sidebar.html" -->
<!-- '(:news (1 2 3 4 5) -->
<!-- :blogs (1 2 3 4 5))) %} -->
{% include "shared/sidebar.html" %}
</aside>
<footer>

2
templates/shared/errors.html

@ -1,4 +1,4 @@
{%if errors %}
{% if errors %}
<div id="errors">
<h3>Errors</h3>
<ul>

2
templates/shared/header.html

@ -3,7 +3,7 @@
<nav class="menubar">
<ul>
<li><a href="/">Home</a></li>
<li><a href="#">News</a></li>
<li><a href="/articles">News</a></li>
<li><a href="#">Blog</a></li>
<li><a href="/account">{{user.name}}-San</a></li>
<li><a href="/users/index">Members</a></li>

2
templates/shared/user_form.html

@ -7,7 +7,7 @@
{% if administrator %}
<tr>
<th>{%filter i18n %}Administrator{% endfilter %}</th>
<th>{% filter i18n %}Administrator{% endfilter %}</th>
<td>
<input name="ADMINISTRATOR" type="hidden" value="0"/>
<input type="checkbox" value="1" name="administrator" id="user-administrator"/>

Loading…
Cancel
Save