|
|
|
@ -1,14 +1,17 @@
|
|
|
|
|
(in-package #:cl-user) |
|
|
|
|
(defpackage rails-to-caveman.web |
|
|
|
|
;; (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 |
|
|
|
|
#:cl-who) |
|
|
|
|
(:import-from #:rails-to-caveman.db |
|
|
|
|
#:connection-settings |
|
|
|
|
#:db |
|
|
|
|
#:with-connection) |
|
|
|
|
(:export #:*web*)) |
|
|
|
|
(in-package #:rails-to-caveman.web) |
|
|
|
|
|
|
|
|
@ -26,16 +29,18 @@
|
|
|
|
|
;; 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) |
|
|
|
|
"Top page" |
|
|
|
|
(let ((articless (articles-make 5))) |
|
|
|
|
(format t "[INFO] ~a" articless) |
|
|
|
|
(render #P"index.html" `(:notice ,(flash-gethash :notice ningle:*session*) |
|
|
|
|
:user,(when (hermetic:logged-in-p) |
|
|
|
|
(current-user)) |
|
|
|
|
,@(roles) |
|
|
|
|
:token ,(token) |
|
|
|
|
:alert "Bitchin"))) |
|
|
|
|
:alert ,(flash-gethash :alert ningle:*session*) |
|
|
|
|
;; :news ,articles |
|
|
|
|
:blogs (1 2 3 4 5) |
|
|
|
|
:articles ,articless)))) |
|
|
|
|
|
|
|
|
|
(defroute "/users/index"() |
|
|
|
|
(render "users/index.html" |
|
|
|
@ -477,21 +482,17 @@ nil "/users/~D"(mito:object-id user))))))))
|
|
|
|
|
'(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) |
|
|
|
|
:news ,(articles-make 5) |
|
|
|
|
:blogs (1 2 3 4 5) |
|
|
|
|
:token ,(token) |
|
|
|
|
:articles ,(with-connection (db) |
|
|
|
|
:articles |
|
|
|
|
,(hermetic:auth (:adminstrator) |
|
|
|
|
(with-connection (db) |
|
|
|
|
(mito:retrieve-dao 'rails-to-caveman.model::article)) |
|
|
|
|
,@(roles))))) |
|
|
|
|
(articles-make 5)) |
|
|
|
|
,@(roles)))) |
|
|
|
|
|
|
|
|
|
(defroute ("/articles" :method :post) (&key method) |
|
|
|
|
(cond ((string= "put" method) (new-article |
|
|
|
@ -499,15 +500,30 @@ nil "/users/~D"(mito:object-id user))))))))
|
|
|
|
|
(t `(401 () (,(format nil "Unknown method ~S" method)))))) |
|
|
|
|
|
|
|
|
|
(defroute "/articles/:id" (&key id) |
|
|
|
|
(if (null (ignore-errors (parse-integer id))) |
|
|
|
|
(myway.mapper:next-route) |
|
|
|
|
;; (if (null (ignore-errors (parse-integer id))) |
|
|
|
|
;; myway.mapper:next-route) |
|
|
|
|
;; (let ((article (with-connection (db) |
|
|
|
|
;; (mito:find-dao 'rails-to-caveman.model::article |
|
|
|
|
;; :id id))) |
|
|
|
|
;; (if (find :administrator (hermetic:roles)) |
|
|
|
|
;; #0=(render "articles/show.html" |
|
|
|
|
;; `(:articles (1 2 3 4 5) ;,article |
|
|
|
|
;; ,@(roles) |
|
|
|
|
;; :token ,(token) |
|
|
|
|
;; :user ,(current-user) |
|
|
|
|
;; ;; :news ,(articles-make 5) |
|
|
|
|
;; :news (1 2 3 4 5) |
|
|
|
|
;; :blogs (1 2 3 4 5)) |
|
|
|
|
;; (if (publicp article) |
|
|
|
|
;; #0# '(404 () |
|
|
|
|
;; ("No articles")))))))) |
|
|
|
|
(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))))) |
|
|
|
|
:blogs (1 2 3 4 5)))) |
|
|
|
|
|
|
|
|
|
(defroute ("/articles/:id" :method :post)(&key method id) |
|
|
|
|
(cond ((and (string= "post" method) |
|
|
|
@ -522,6 +538,7 @@ nil "/users/~D"(mito:object-id user))))))))
|
|
|
|
|
|
|
|
|
|
(defroute destroy-article ("/article/:id" :method :delete) |
|
|
|
|
(&key authenticity-token id) |
|
|
|
|
(step |
|
|
|
|
(if (not (string= authenticity-token(token))) |
|
|
|
|
'(401()("Denied")) |
|
|
|
|
(if (not (hermetic:logged-in-p)) |
|
|
|
@ -530,7 +547,7 @@ nil "/users/~D"(mito:object-id user))))))))
|
|
|
|
|
(myway.mapper:next-route) |
|
|
|
|
(progn (with-connection (db) |
|
|
|
|
(mito:delete-by-values 'rails-to-caveman.model::article :id id)) |
|
|
|
|
`(303 (:location "/articles"))))))) |
|
|
|
|
`(303 (:location "/articles")))))))) |
|
|
|
|
|
|
|
|
|
(defroute "/articles/new" () |
|
|
|
|
(render "articles/new.html" |
|
|
|
@ -541,6 +558,34 @@ nil "/users/~D"(mito:object-id user))))))))
|
|
|
|
|
,@(roles) |
|
|
|
|
:token ,(token)))) |
|
|
|
|
|
|
|
|
|
(defroute new-article ("/articles" :method :put) |
|
|
|
|
(&key authenticity-token no-expiration-p) |
|
|
|
|
(if (not (string= authenticity-token (token))) |
|
|
|
|
'(401 () ("Denied")) |
|
|
|
|
(let ((render-args `(:user |
|
|
|
|
,(current-user) |
|
|
|
|
,@(roles) |
|
|
|
|
:token ,(token) |
|
|
|
|
:news ,(articles 5) |
|
|
|
|
:blogs (1 2 3 4 5)))) |
|
|
|
|
(multiple-value-bind (article errors) |
|
|
|
|
(rails-to-caveman.model::validate-article |
|
|
|
|
(apply #'make-instance 'rails-to-caveman.model::article |
|
|
|
|
(request-params (lack.request:request-body-parameters |
|
|
|
|
ningle:*request*)))) |
|
|
|
|
(if errors |
|
|
|
|
(render "articles/new.html" |
|
|
|
|
(list* :article article |
|
|
|
|
:errors errors |
|
|
|
|
:no-expiration-p no-expiration-p |
|
|
|
|
render-args)) |
|
|
|
|
(progn (with-connection (db) |
|
|
|
|
(mito:insert-dao article) |
|
|
|
|
(setf (gethash :notice ningle:*session*)"Stored") |
|
|
|
|
`(303 (:location |
|
|
|
|
,(format nil "/articles/~D" |
|
|
|
|
(mito:object-id article))))))))))) |
|
|
|
|
|
|
|
|
|
(defroute new-article ("/articles" :method :put) |
|
|
|
|
(&key authenticity-token |
|
|
|
|
released-year |
|
|
|
@ -600,7 +645,10 @@ nil "/users/~D"(mito:object-id user))))))))
|
|
|
|
|
(mito:object-id article))))))))))) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defroute "/articles/:id/edit" (&key id) |
|
|
|
|
(step |
|
|
|
|
(render "articles/edit.html" |
|
|
|
|
`(:article ,(with-connection (db) |
|
|
|
|
(mito:find-dao |
|
|
|
@ -609,7 +657,7 @@ nil "/users/~D"(mito:object-id user))))))))
|
|
|
|
|
,@(roles) |
|
|
|
|
:token ,(token) |
|
|
|
|
:news (1 2 3 4 5) |
|
|
|
|
:blogs (1 2 3 4 5)))) |
|
|
|
|
:blogs (1 2 3 4 5))))) |
|
|
|
|
|
|
|
|
|
(defun edit-article (request) |
|
|
|
|
(step |
|
|
|
@ -638,6 +686,7 @@ nil "/users/~D"(mito:object-id user))))))))
|
|
|
|
|
(let ((article (with-connection (db) |
|
|
|
|
(mito:find-dao |
|
|
|
|
'rails-to-caveman.model::article :id id)))) |
|
|
|
|
;; (format t "[INFO] ~A" (getf article 'title)) |
|
|
|
|
(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) |
|
|
|
@ -656,7 +705,7 @@ nil "/users/~D"(mito:object-id user))))))))
|
|
|
|
|
expired-min) |
|
|
|
|
(rails-to-caveman.model::member-only article) member-only) |
|
|
|
|
(multiple-value-bind (article errors) |
|
|
|
|
(rails-to-caveman.model::validate-article |
|
|
|
|
(rails-to-caveman.model::validate-article article) |
|
|
|
|
(if errors (render "articles/edit.html" |
|
|
|
|
`(:article ,article |
|
|
|
|
:errors ,errors |
|
|
|
@ -669,7 +718,7 @@ nil "/users/~D"(mito:object-id user))))))))
|
|
|
|
|
(mito:save-dao article)) |
|
|
|
|
(setf (gethash :notice ningle:*session*) "Updated") |
|
|
|
|
`(303 (:location ,(format nil "/articles/~D" |
|
|
|
|
(mito:object-id article)))))))))))))) |
|
|
|
|
(mito:object-id article))))))))))))) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(defroute "/about" () |
|
|
|
@ -869,13 +918,59 @@ nil "/users/~D"(mito:object-id user))))))))
|
|
|
|
|
'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)))) |
|
|
|
|
(defun publicp (article) |
|
|
|
|
(local-time:timestamp< (date-released-of article) |
|
|
|
|
(local-time:now) |
|
|
|
|
(date-expired-of article))) |
|
|
|
|
|
|
|
|
|
(defun format-to-date (&optional(time (local-time:now))) |
|
|
|
|
(local-time:format-timestring |
|
|
|
|
nil |
|
|
|
|
time |
|
|
|
|
:format '((:year 4)"-"(:month 2)"-"(:day 2)))) |
|
|
|
|
|
|
|
|
|
(defun articles (n &key (logged-in-p (hermetic:logged-in-p)) |
|
|
|
|
(user(and logged-in-p (current-user)))) |
|
|
|
|
(if logged-in-p |
|
|
|
|
(if (rails-to-caveman.model::administrator-of user) |
|
|
|
|
(with-connection (db) |
|
|
|
|
(mito:select-dao 'rails-to-caveman.model::article |
|
|
|
|
(sxql:order-by (:desc :date-released)) |
|
|
|
|
(sxql:limit n)) |
|
|
|
|
(let ((now (rails-to-caveman.web::format-to-date))) |
|
|
|
|
(mito:select-dao 'rails-to-caveman.model::article |
|
|
|
|
(sxql:where (:and (:< :date-released now))) |
|
|
|
|
;; (:< now :date-expired))) |
|
|
|
|
(sxql:order-by (:desc :date-released)) |
|
|
|
|
(sxql:limit n))))) |
|
|
|
|
(let ((now (rails-to-caveman.web::format-to-date))) |
|
|
|
|
(with-connection (db) |
|
|
|
|
(mito:select-dao 'rails-to-caveman.model::article |
|
|
|
|
(sxql:where (:and (:< :date-released now) |
|
|
|
|
(:< now :date-expired) |
|
|
|
|
(:= :only-member rails-to-caveman.model::+false+))) |
|
|
|
|
(sxql:order-by (:desc :date-released)) |
|
|
|
|
(sxql:limit n)))))) |
|
|
|
|
|
|
|
|
|
;; (defun articles (n &key (logged-in-p(hermetic:logged-in-p)) |
|
|
|
|
;; (user (and logged-in-p (current-user)))) |
|
|
|
|
;; (if logged-in-p |
|
|
|
|
;; (if (your-app.model::administrator-of user) |
|
|
|
|
;; (mito:select-dao 'your-app.model::article |
|
|
|
|
;; (sxql:order-by (:desc :date-released)) |
|
|
|
|
;; (sxql:limit n)) |
|
|
|
|
;; (let ((now(your-app.web::format-to-date))) |
|
|
|
|
;; (mito:select-dao 'your-app.model::article |
|
|
|
|
;; (sxql:where |
|
|
|
|
;; (:and (:< :date-released now) |
|
|
|
|
;; (:< now :date-expired))) |
|
|
|
|
;; (sxql:order-by (:desc :date-released)) |
|
|
|
|
;; (sxql:limit n)))) |
|
|
|
|
|
|
|
|
|
;; (let ((now(your-app.web::format-to-date))) |
|
|
|
|
;; (mito:select-dao 'your-app.model::article |
|
|
|
|
;; (sxql:where (:and (:< :date-released now) |
|
|
|
|
;; (:< now :date-expired) |
|
|
|
|
;; (:= :only-member your-app.model::+false+))) |
|
|
|
|
;; (sxql:order-by(:desc :date-released)) |
|
|
|
|
;; (sxql:limit n))))) |
|
|
|
|