From c267f3d0f55e7a9adc9a6f6c5c546859bfd3f645 Mon Sep 17 00:00:00 2001 From: Craig Oates Date: Mon, 3 Jan 2022 02:31:45 +0000 Subject: [PATCH] Chapter 9 commit. --- app.lisp | 2 +- rails-to-caveman.asd | 2 +- src/config.lisp | 8 +- src/db.lisp | 2 +- src/locale.lisp | 2 +- src/main.lisp | 8 +- src/model.lisp | 63 ++++++++++-- src/view.lisp | 40 +++++--- src/web.lisp | 185 +++++++++++++++++++++++++--------- templates/articles/form.html | 4 + templates/articles/index.html | 7 +- templates/index.html | 12 ++- templates/shared/sidebar.html | 4 +- 13 files changed, 252 insertions(+), 87 deletions(-) diff --git a/app.lisp b/app.lisp index 01f294e..d93840e 100644 --- a/app.lisp +++ b/app.lisp @@ -1,6 +1,6 @@ (ql:quickload :rails-to-caveman) -(defpackage rails-to-caveman.app +(defpackage #:rails-to-caveman.app (:use #:cl) (:import-from #:lack.builder #:builder) diff --git a/rails-to-caveman.asd b/rails-to-caveman.asd index aef781c..2b98014 100644 --- a/rails-to-caveman.asd +++ b/rails-to-caveman.asd @@ -32,7 +32,7 @@ ((:module "src" :components ((:file "main" :depends-on ("config" "view" "db")) (:file "web" :depends-on ("view" "model")) - (:file "view" :depends-on ("config")) + (:file "view" :depends-on ("locale" "config")) (:file "db" :depends-on ("config")) (:file "model" :depends-on ("db")) (:file "locale" :depends-on ("config")) ; <--- This! diff --git a/src/config.lisp b/src/config.lisp index 7e00baf..46d6226 100644 --- a/src/config.lisp +++ b/src/config.lisp @@ -1,11 +1,11 @@ -(in-package #:cl-user) -(defpackage rails-to-caveman.config +;; (in-package #:cl-user) +(defpackage #:rails-to-caveman.config (:use #:cl) (:import-from #:envy #:config-env-var #:defconfig) - (:import-from #:rails-to-caveman.locale - #:define-dictionary) + (:import-from #:uiop + #:getenv) (:export #:config #:*application-root* #:*static-directory* diff --git a/src/db.lisp b/src/db.lisp index 12c4607..036640e 100644 --- a/src/db.lisp +++ b/src/db.lisp @@ -1,4 +1,4 @@ -(in-package #:cl-user) +;; (in-package #:cl-user) (defpackage rails-to-caveman.db (:use :cl) (:import-from #:rails-to-caveman.config diff --git a/src/locale.lisp b/src/locale.lisp index ad68924..54a7d27 100644 --- a/src/locale.lisp +++ b/src/locale.lisp @@ -1,4 +1,4 @@ -(in-package #:cl-user) +;; (in-package #:cl-user) (defpackage #:rails-to-caveman.locale (:use #:cl) (:export #:define-dictionary diff --git a/src/main.lisp b/src/main.lisp index b6dbe6d..59bd16f 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -1,8 +1,8 @@ -(in-package #:cl-user) -(defpackage rails-to-caveman +;; (in-package #:cl-user) +(defpackage #:rails-to-caveman (:use #:cl) - (:import-from #:rails-to-caveman.config - #:config) + ;; (:import-from #:rails-to-caveman.config + ;; #:config) (:import-from #:clack #:clackup) (:export #:start diff --git a/src/model.lisp b/src/model.lisp index ac923b8..6c04484 100644 --- a/src/model.lisp +++ b/src/model.lisp @@ -1,15 +1,16 @@ -(in-package #:cl-user) -(defpackage rails-to-caveman.model +;; (in-package #:cl-user) +(defpackage #:rails-to-caveman.model (:use #:cl #:rails-to-caveman.db #:mito - #:local-time - #:ratify - #:ratify-types - #:cl-ppcre) - (:import-from #:ratify-types - #:parse-string - ) + #:local-time) + ;; #:ratify + ;; #:ratify-types) + ;; #:cl-ppcre) + (:import-from #:ratify + #:test-email) + ;; (:import-from #:cl-ppcre + ;; #:parse-string) (:export #:user #:validate-user #:seeds @@ -391,6 +392,48 @@ reference for future projects. This is a learning project after all. (:assert (<= (length body) 2000))) (date-released (:require t) (:key #'local-time:parse-timestring)) - (date-expired (:key #'local-time:parse-timestring)) + (date-expired (:key #'local-time:parse-timestring) + (:assert (local-time:timestamp< + (date-released-of article) + date-expired) + "Date expired too old")) (member-only (:require t) (:key (lambda(x)(zerop(parse-integer x)))))))) + +(defmethod initialize-instance + :around ((o article) + &rest args + &key date-released + released-year + released-month + released-day + released-hour + released-min + date-expiration + expired-year + expired-month + expired-day + expired-hour + expired-min + no-expiration-p + &allow-other-keys) + (apply #'call-next-method o + `(,@ (when (and (null date-released) released-year) + `(:date-released + ,(format nil "~A-~A-~AT~A:~A:00" + released-year + released-month + released-day + released-hour + released-min))) + ,@(when (and (not no-expiration-p) + (null date-expiration) + expired-year) + `(:date-expired + ,(format nil "~A-~A-~AT~A:~A:00" + expired-year + expired-month + expired-day + expired-hour + expired-min))) + ,@args))) diff --git a/src/view.lisp b/src/view.lisp index 52f89d1..fb3863a 100644 --- a/src/view.lisp +++ b/src/view.lisp @@ -1,7 +1,7 @@ -(in-package #:cl-user) +;; (in-package #:cl-user) (defpackage #:rails-to-caveman.view - (:use #:cl - #:rails-to-caveman.locale) + (:use #:cl) + ;; #:rails-to-caveman.locale) (:import-from #:rails-to-caveman.config #:*template-directory*) (:import-from #:caveman2 @@ -41,20 +41,16 @@ (defpackage rails-to-caveman.djula (:use #:cl - #:3bmd) - (:import-from #:rails-to-caveman.config - #:config - #:appenv - #:developmentp - #:productionp - #:rails-to-caveman.locale) + #:3bmd + #:rails-to-caveman.locale + #:cl-who) (:import-from #:caveman2 #:url-for) (:import-from #:cl-ppcre #:regexp-replace-all) (:export #:title! ; Added in Chapter 3 (Mockup section). - ) - ) + #:date-options + )) ;; in-package and let code added in Chapter 3, also. This is ;; preperation for Switching Layout Templates section. (in-package #:rails-to-caveman.djula) ; Make sure this states your app name. @@ -87,3 +83,23 @@ (with-output-to-string (s) (3bmd:parse-string-and-print-to-stream (ppcre:regex-replace-all #\newline it "
") s))) + +#| LACK OF 'DJULA' DOES NOT MEAN IT IS NOT PART OF IT (date-options) +==================================================================== +Even though it does not have 'djula' attached to it. This is a +filter which is applied in '/templates/articles/forms.html' +primarily. The guide (Chapter 9) does not state where to put this +function but you get errors when you try and render the form in the +browser and that is where it specifies there is no 'djula filter' +function going by that name. +|# +(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/src/web.lisp b/src/web.lisp index 7132a30..da65527 100644 --- a/src/web.lisp +++ b/src/web.lisp @@ -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) - :token ,(token) - :alert "Bitchin"))) + "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 ,(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) - :blogs (1 2 3 4 5) - :token ,(token) - :articles ,(with-connection (db) - (mito:retrieve-dao 'rails-to-caveman.model::article)) - ,@(roles))))) + (render "articles/index.html" + `(:user ,(current-user) + :news ,(articles-make 5) + :blogs (1 2 3 4 5) + :token ,(token) + :articles + ,(hermetic:auth (:adminstrator) + (with-connection (db) + (mito:retrieve-dao 'rails-to-caveman.model::article)) + (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))))) diff --git a/templates/articles/form.html b/templates/articles/form.html index 213bebd..762b3fe 100644 --- a/templates/articles/form.html +++ b/templates/articles/form.html @@ -62,6 +62,10 @@ +
+ + diff --git a/templates/index.html b/templates/index.html index 6a6ee7a..42d0929 100644 --- a/templates/index.html +++ b/templates/index.html @@ -23,9 +23,15 @@ This message is passed from the router in /src/web.lisp. There is no guarantee it will contain anything n it, though. --> -

{{ message }}

-{% for b in numbers %} -
  • Blog Header
    • + +{% for article in articles %} +

    {{article.title}}

    +

    {{article.body | truncatechars:80}} +More +

    +{% endfor %} + +{% for blog in blogs %} {% endfor %} {% if alert %} diff --git a/templates/shared/sidebar.html b/templates/shared/sidebar.html index 4f7a47a..854a325 100644 --- a/templates/shared/sidebar.html +++ b/templates/shared/sidebar.html @@ -3,8 +3,8 @@ {% endif %}

    Latest News