You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
419 lines
14 KiB
419 lines
14 KiB
(in-package #:cl-user) |
|
(defpackage #:rails-to-caveman.web |
|
(:use #:cl |
|
#:caveman2 |
|
#:rails-to-caveman.config |
|
#:rails-to-caveman.view |
|
#:rails-to-caveman.db |
|
#:rails-to-caveman.model |
|
#:sxql |
|
#:mito) |
|
(:export #:*web*)) |
|
(in-package #:rails-to-caveman.web) |
|
|
|
;; for @route annotation |
|
(syntax:use-syntax :annot) |
|
|
|
;; |
|
;; Application |
|
|
|
(defclass <web> (<app>) ()) |
|
(defvar *web* (make-instance '<web>)) |
|
(clear-routing-rules *web*) |
|
|
|
;; |
|
;; Routing rules |
|
|
|
(defroute "/" () |
|
(render #P"index.html" |
|
;; Use to pass message to view -- it is expecting a |
|
;; `MESSAGE' item. You do not need to add it, though. Or, |
|
;; you can pass it an empty value/string if you do not want |
|
;; to leave the code commented out. |
|
|
|
;; '(:message "This is not a message") ; Added Chapter 3. |
|
'(:numbers (1 2 3 4 5)) |
|
)) |
|
|
|
(defroute "/users/index"() |
|
(render "users/index.html" |
|
`(:users ,(with-connection (db) |
|
(mito:select-dao 'rails-to-caveman.model::user |
|
(sxql:order-by :number))) |
|
:token ,(token) |
|
:notice (flash-gethash |
|
:notice ningle:*request*)))) |
|
|
|
(defroute "/users/search" (&key |q|) |
|
(render "users/index.html" |
|
`(:users ,(with-connection (db) |
|
(mito:select-dao 'rails-to-caveman.model::user |
|
(sxql:where |
|
`(:or (:like :name ,|q|) |
|
(:like :full-name ,|q|))) |
|
(sxql:order-by :number)))))) |
|
|
|
(defroute "/users/:id" (&key id) |
|
(let ((id (ignore-errors (parse-integer id)))) |
|
(if (null id) |
|
(myway.mapper:next-route) |
|
(let ((user (with-connection (db) |
|
(mito:find-dao 'rails-to-caveman.model::user |
|
:id id)))) |
|
;; (setf id (parse-integer id)) |
|
(if user |
|
(render "users/show.html" |
|
`(:user ,(with-connection (db) |
|
(mito:find-dao 'rails-to-caveman.model::user |
|
:id id)) |
|
:notice ,(flash-gethash |
|
:notice ningle:*session*))) |
|
(on-exception *web* 404)))))) |
|
|
|
(defroute "/user/new" () |
|
(render #P"users/new.html" |
|
`(:users ,(with-connection (db) |
|
(make-instance 'rails-to-caveman.model::user)) |
|
:token ,(token)))) |
|
|
|
(defroute "/users/:id/edit" (&key id) |
|
(let* ((id (ignore-errors (parse-integer id))) |
|
(user (with-connection (db) ; NOTE `USER' AND NOT USERS. |
|
(and id |
|
(mito:find-dao 'rails-to-caveman.model::user |
|
:id id))))) |
|
(if user (render "users/edit.html" |
|
`(:user ,user :token ,(token))) |
|
(on-exception *web* 404)))) |
|
|
|
(defroute ("/user/:id" :method :post) |
|
(&key |authenticity-token| |
|
id |
|
(|number| "") |
|
|name| |
|
|full-name| |
|
(|sex| "") |
|
|birthday-year| |
|
|birthday-month| |
|
|birthday-day| |
|
|email| |
|
(|administrator| "")) |
|
(if (not (string= |authenticity-token| (token))) |
|
'(403 () ("Denied")) |
|
(with-connection (db) |
|
(let ((id (ignore-errors (parse-integer id))) |
|
(user (and id |
|
(mito:find-dao |
|
'rails-to-caveman.model::user :id id)))) |
|
(if (null user) |
|
'(500 () ("Could not edit because user doesn't exist."))) |
|
(progn |
|
|
|
#| CHAPTER 6 CODE NOT WORKING HERE. |
|
================================= |
|
|
|
I could not get this part of the code (setf) to work when |
|
following the tutorial. Because of this, I have decided to |
|
leave the code the tutorial (in Chapter 6) |
|
provided. Hopefully, there are other code examples which |
|
will provide an answer to get this part of the code |
|
working. |
|
|
|
For now, this route (I.E. when you try to update a user) the site will |
|
throw an error and not update it. |
|
|# |
|
|
|
(setf (rails-to-caveman.model::number-of user) (parse-integer |number| :junk-allowed t) |
|
(rails-to-caveman.model::name-of user) |name| |
|
(rails-to-caveman.model::full-name-of user) |full-name| |
|
(rails-to-caveman.model::sex-of user) (parse-integer |sex| :junk-allowed t) |
|
(rails-to-caveman.model::birthday-of user) (local-time:parse-timestring |
|
(format nil "~A-~A-~A" |
|
|birthday-year| |
|
|birthday-month| |
|
|birthday-day|)) |
|
(rails-to-caveman.model::email-of user) |email| |
|
(rails-to-caveman.model::administrator-of user) (eq rails-to-caveman.model::+true+ |
|
(zerop (parse-integer |
|
|administrator| |
|
:junk-allowed t)))) |
|
(mito:save-dao user) |
|
(setf (gethash :notice ningle:*session*) "Updated") |
|
`(303 (:location ,(format nil "/users/~D" id)))))))) |
|
|
|
(defroute ("/user" :method :post) |
|
(&key |authenticity-token| |
|
(|number| "") |
|
|name| |
|
|full-name| |
|
(|sex| "") |
|
|birthday-year| |
|
|birthday-month| |
|
|birthday-day| |
|
|email| |
|
(|administrator| "")) |
|
(if(not(string= |authenticity-token| (token))) |
|
'(403 () ("Denied")) |
|
(with-connection (db) |
|
(let ((user (mito:create-dao |
|
'rails-to-caveman.model::user |
|
:number (parse-integer |number| :junk-allowed t) |
|
:name |name| |
|
:full-name |full-name| |
|
:sex (parse-integer |sex| :junk-allowed t) |
|
:birthday (local-time:parse-timestring |
|
(format nil "~A-~A-~A" |
|
|birthday-year| |
|
|birthday-month| |
|
|birthday-day|)) |
|
:email |email| |
|
:administrator (eq |
|
rails-to-caveman.model::+true+ |
|
(zerop |
|
(parse-integer |administrator| |
|
:junk-allowed t)))))) |
|
(setf(gethash :notice ningle:*session*)"Stored!") |
|
`(303 (:location ,(format |
|
nil "/users/~D"(mito:object-id user)))))))) |
|
|
|
(defroute delete-user ("/users/:id" :method :delete) |
|
(&key |authenticity-token| id) |
|
(if (not (string= |authenticity-token| (token))) |
|
`(403 (:content-type "text/plain") ("Denied")) |
|
(with-connection (db) |
|
(let* ((id (ignore-errors (parse-integer id))) |
|
(user (and id |
|
(mito:find-dao 'rails-to-caveman.model::user |
|
:id id)))) |
|
(if (null user) |
|
`(500 (:content-type "text-plain") |
|
(,(format nil |
|
"~%Could not delete. User doesn't exist. Id ~S" |
|
id))) |
|
(progn (mito:delete-dao user) |
|
(setf (gethash :notice ningle:*session* "Deleted.") |
|
`(303 (:location "/users/index"))))))))) |
|
|
|
(defroute ("/users/:id" :method :post) |
|
(&key |authenticity-token| |
|
id |
|
(|number| "") |
|
|name| |
|
|full-name| |
|
(|sex| "") |
|
|birthday-year| |
|
|birthday-month| |
|
|birthday-day| |
|
|email| |
|
(|administrator| "") |
|
|_method|) |
|
(if (not (string= |authenticity-token| (token))) |
|
`(403 () ("Denied")) |
|
(cond ((string= |_method| "delete") |
|
(delete-user |
|
(acons "ID" id (lack.request:request-body-parameters |
|
ningle:*request*)))) |
|
((find |_method| `("" "post")) |
|
(with-connection (db) |
|
(let ((id (ignore-errors (parse-integer id))) |
|
(user (and id (mito:find-dao |
|
'rails-to-caveman.model::user |
|
:id id)))) |
|
(if (null user) |
|
'(500 (:content-type "text/plan" |
|
("Could not find the user.")) |
|
(progn (setf (rails-to-caveman.model::number-of user) |
|
(parse-integer |number| :junk-allowed t) |
|
(rails-to-caveman.model::name-of user) |
|
|name| |
|
(rails-to-caveman.model::full-name-of user) |
|
(rails-to-caveman.model::sex-of user) |
|
(parse-integer |sex| :junk-allowed t) |
|
(rails-to-caveman.model::birthday-of user) |
|
(local-time:parse-timestring |
|
(format nil "~A-~A-~A" |
|
|birthday-year| |
|
|birthday-month| |
|
|birthday-day|)) |
|
(rails-to-caveman.model::email-of user) |
|
|email| |
|
(rails-to-caveman.model::administrator user) |
|
(eq rails-to-caveman.model::+true+ |
|
(zerop (parse-integer |
|
|administrator| |
|
:junk-allowed t)))) |
|
(mito:save-dao user) |
|
(setf (gethash |
|
:notice ningle:*session*) |
|
"Updated") |
|
`(303 (:location ,(format nil |
|
"/users/~D" |
|
id))))))))) |
|
(t `(400 (:content-type "text/plain") |
|
(,(format nil "Unsupported method ~S" |
|
|_method|))))))) |
|
|
|
|
|
|
|
|
|
(defroute "/about" () |
|
;; about.html should be in the /templates directory. |
|
(render #P"about.html" '(:page-title "About"))) |
|
|
|
(defroute "/hello/:name" (&key name) |
|
;; Substitutes ':name' with `NAME'. |
|
(format nil "Hello, ~A" name)) |
|
|
|
(defroute "/say/*/to/*" (&key splat) |
|
;; If route is /say/hello/to/world (in the browser). It will match |
|
;; to /say/hello/to/world. 'hello' and 'world' are the wildcard |
|
;; values in this example. |
|
(format nil "~A" splat)) |
|
|
|
(defroute ("/hello/([\\w]+)" :regexp t) (&key captures) |
|
;; Parse the second part of the URL via a regular expression |
|
;; (regexp). The result of the parsed regexp text is stored in |
|
;; `CAPTURES', hence the use of 'first' in the format string. |
|
(format nil "Hello, ~A!" (first captures))) |
|
|
|
(defroute "/hello/?:name?" (&key name) |
|
;; Generates two types of routes: |
|
|
|
;; 1. /hello/earth |
|
;; 2. /hello?NAME=earth |
|
|
|
;; The query string must be in UPPERCASE. Otherwise, the `NAME' will |
|
;; be bound to `nil'. |
|
(format nil "Hello, ~A" name)) |
|
|
|
(defroute "/hello/?:name?" (&key |name|) |
|
;; If you want the query string in lowercase, enclose `name' (in |
|
;; this case) with vertical bars '|'. This will force you to have |
|
;; only one route (unlike the route above). `NAME' will now bind to |
|
;; `NIL'. |
|
|
|
;; 1. /hello?name=earth |
|
;; 2. /hello?NAME=earth <--- no longer works ('earth' binds to nil). |
|
;; 3. /hello/earth <--- no longer works |
|
(format nil "Hello, ~A" |name|)) |
|
|
|
(defroute "/lesson/step*/:name" (&key splat name) |
|
;; Directory style: Working with Parameters. |
|
;; Example URL: /lesson/step1/Sato |
|
(case (parse-integer (car splat) :junk-allowed t) |
|
(1 (format nil "Hello, ~A" name)))) |
|
|
|
(defroute "/lesson/step*" (&key splat (|name| "Anonymous")) |
|
;; 'Anonymous' is the default value for `|name|'. |
|
;; Query style: Working with Parameters. |
|
;; Example URL: /lesson/step1?name=Sato |
|
(case (parse-integer (car splat) :junk-allowed t) |
|
(1 (format nil "Hello, ~A" |name|)))) |
|
|
|
(defroute "/lesson/step*" (&key splat name) |
|
;; If /lesson/step1 is used, it will be redirected to /lesson/step2, |
|
;; then /lesson/step3 and finally /lesson/step4. No matter where you |
|
;; start (along as it is below 4), the redirects will always take |
|
;; you to /lesson/step4. |
|
|
|
;; The example includes `NAME' BUT it is never used. I am keeping it |
|
;; here for consistency between the reference material and this code |
|
;; base. |
|
(case (parse-integer (car splat) :junk-allowed t) |
|
(1 '(302 (:location "/lesson/step2"))) |
|
(2 '(302 (:location "/lesson/step3"))) |
|
(3 '(302 (:location "/lesson/step4"))) |
|
(4 "Moved to step4") |
|
|
|
;; To be honest, I do not know what this is actually doing. It is |
|
;; mentioned in 'STEP5 Flash' in Chapter 3 (I.E. Tutorial 3: |
|
;; Routing). This applies to case's 5 and 6. |
|
(5 (setf (gethash :notice *session*) "Move to step6") |
|
`(302 (:location "/lesson/step6"))) |
|
(6 (let((notice (gethash :notice *session*))) |
|
(remhash :notice *session*) notice)) |
|
|
|
;; This is part of an example about using djula (which is a |
|
;; template engine used by Caveman2. djula is a port of Python's |
|
;; Django template engine. |
|
;; step7.html should be in the /templates directory. |
|
(7 (render "step7.html" |
|
`(:price ,(floor(* 2000 1.08))))) |
|
(8 (render "step7.html" '(:price 1000))) |
|
(9 (render "step9.html" |
|
'(:comment "<script>alert('danger')</script>Hello"))) |
|
;; If you dare to embed HTML, add safe after the variable |
|
;; reference on the View side (step10.html). |
|
(10 (render "step10.html" |
|
'(:comment "<strong>safe html</strong>"))) |
|
(11 `(200 (:content-type "text/html; charset=utf-8") |
|
(, (let ((population 704414) (surface 141.31)) |
|
(render "step11.html" |
|
`(:contents |
|
,(format nil |
|
;; ~D = Decimal |
|
|
|
;; ~,,2F = Fixed-Format |
|
;; Floating-Point |
|
|
|
;; ~,,2F = Print exactly two |
|
;; digits after the decimal |
|
;; point and many as necessary |
|
;; before the decimal point. |
|
"Population: ~D Floor Surface: ~D Population/Surface: ~,,2F" |
|
population |
|
(floor surface) |
|
(/ population surface)))))))) |
|
(12 (render "step11.html" |
|
`(:contents ,(local-time:format-timestring |
|
nil |
|
(local-time:now) |
|
:format '((:year 4)"/"(:month 2)"/"(:day 2)"(" :short-weekday ") " |
|
(:hour 2)":"(:min 2)":"(:sec 2)))))) |
|
(13 `(200 (:content-type "text/html; charset=utf-8") |
|
;; This view uses 'format' in step13.html (view in |
|
;; /templates directory). |
|
(,(render "step13.html" '(:population 127767944))))) |
|
(14 (render "step14.html" |
|
;; The view uses a custom filter which was added to |
|
;; view.lisp. |
|
`(:contents ,(format nil "foo~%bar~%bazz")))) |
|
;; The view demonstrates how to form links. |
|
(15 (render "step15.html")) |
|
;; The view demonstrates how to display images. |
|
;; Images are stored in the /static/images directory. |
|
(16 (render "step16.html")) |
|
;; Provides control branches which you can navigate via djula in |
|
;; step17.html (/templates directory). |
|
(17 `(200 (:content-type "text/html; charset=utf-8") |
|
;; Adjust `STOCK' to adjust what is viewed in step17.html. |
|
(,(let((stock 10)) |
|
(render "step17.html" |
|
`(:stock-zerop ,(< 0 stock) :stock ,stock)))))) |
|
;; This creates a list (cons list) which is then cycled through in |
|
;; /templates/step18.html using the djula template engine.. |
|
(18 (render "step18.html" |
|
'(:items |
|
((:pan . 2680) |
|
(:glass . 2550) |
|
(:pepper-mill . 4515) |
|
(:peeler . 945))))))) |
|
|
|
(defun token () |
|
"CSRF token." |
|
(cdr (assoc "lack.session" |
|
(lack.request:request-cookies ningle:*request*) |
|
:test #'string=) ;string equality (always forget this) |
|
)) |
|
|
|
(defun flash-gethash (key table) |
|
(let ((value (gethash key table))) |
|
(remhash key table) |
|
value)) |
|
;; |
|
;; Error pages |
|
|
|
(defmethod on-exception ((app <web>) (code (eql 404))) |
|
(declare (ignore app)) |
|
(merge-pathnames #P"_errors/404.html" |
|
*template-directory*))
|
|
|