From 422f7c293b2dc54c7e97342d63dd7db0f008621b Mon Sep 17 00:00:00 2001 From: David Botton Date: Wed, 11 May 2022 22:18:26 -0400 Subject: [PATCH] Add tutorial 32 clog-web-content --- source/clog-web-dbi.lisp | 41 +++++++--- tutorial/31-tutorial.lisp | 2 + tutorial/32-tutorial.lisp | 163 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 193 insertions(+), 13 deletions(-) create mode 100644 tutorial/32-tutorial.lisp diff --git a/source/clog-web-dbi.lisp b/source/clog-web-dbi.lisp index e1e0cd4..4746d46 100644 --- a/source/clog-web-dbi.lisp +++ b/source/clog-web-dbi.lisp @@ -204,17 +204,33 @@ optional WHERE and ORDER-BY sql." (can-comment :content-comment) (can-show-comments :content-show-comments) (can-edit :content-edit) + (content-order-by "createdate") + (comment-order-by "createdate desc") (sql-timestamp-func *sqlite-timestamp*)) - "Create content for CLOG-WEB:CREATE-WEB-PAGE based on dbi TABLE -value where key=PAGE or if FOLLOW-URL-PAGE is true PAGE is default -page if no second on path otherwise page is the second on path (first -must be base-url). ON-CONTENT, ON-COMMENT are called with (obj value) -before display of value the return value is used. ON-NEW, ON-EDIT are -called with (obj value) to allow filter of value before storage, if -nil is return aborted. ON-DELETE called with (obj page comment-id) if -returns nil aborted. If comment-table is nil no comments are -shown. User must authorize on action set by CAN-COMMENT, CAN-ADMIN, -CAN-SHOW-COMMENTS and if CAN-EDIT unless they are set to nil." + "This is used to create PAGE based content. If more than one entry in +TABLE is keyed for same PAGE, if theme is configured for it, displays +a table of contents, followed by each content record, followed by +comments for the whole page. + +Creates content for CLOG-WEB:CREATE-WEB-PAGE based on TABLE where +key=PAGE (or if FOLLOW-URL-PAGE is true PAGE is default page and if no +second on path otherwise page is the second on path, first must be +base-url). e.g. + +(defun on-main (body) + (init-site body) + (create-web-page body + :index `(:menu ,*menu* + :content ,(clog-web-content *sql-connection* + :comment-table \"content\")))) + +ON-CONTENT, ON-COMMENT are called with (obj value) before +display of value the return value is used. ON-NEW, ON-EDIT are called +with (obj value) to allow filter of value before storage, if nil is +return aborted. ON-DELETE called with (obj page comment-id) if returns +nil aborted. If comment-table is nil no comments are shown. User must +authorize on action set by CAN-COMMENT, CAN-ADMIN, CAN-SHOW-COMMENTS +and if CAN-EDIT unless they are set to nil." (lambda (obj) (let* ((body (connection-body obj)) (theme (theme (get-web-site body))) @@ -227,7 +243,7 @@ CAN-SHOW-COMMENTS and if CAN-EDIT unless they are set to nil." (setf page (second url)))) ;; page content display (let ((pages (load-content sql-connection table page - :order-by "createdate desc"))) + :order-by content-order-by))) ;; ask theme for table of contents or to allow add (funcall theme obj :content-contents (list :content pages @@ -241,7 +257,6 @@ CAN-SHOW-COMMENTS and if CAN-EDIT unless they are set to nil." (push :username content) (when on-new (setf content (funcall on-new content))) - (print content) (when content (dbi:do-sql sql-connection @@ -295,7 +310,7 @@ CAN-SHOW-COMMENTS and if CAN-EDIT unless they are set to nil." comment-table) (let ((comments (load-content sql-connection comment-table page :key-col "parent" - :order-by "createdate desc"))) + :order-by comment-order-by))) (dolist (comment comments) (when on-comment (setf comment (funcall on-comment obj comment))) diff --git a/tutorial/31-tutorial.lisp b/tutorial/31-tutorial.lisp index be38cd9..83f3ac7 100644 --- a/tutorial/31-tutorial.lisp +++ b/tutorial/31-tutorial.lisp @@ -15,6 +15,8 @@ (defvar *sql-connection* nil) +;; Default user/pass is username: admin and password: admin + ;; We use authorizations to control what menus appear if logged in or not. ;; We use the :authorize key on create-web-page to limit access as well ;; directly to a page when not using menus. diff --git a/tutorial/32-tutorial.lisp b/tutorial/32-tutorial.lisp new file mode 100644 index 0000000..d63fc83 --- /dev/null +++ b/tutorial/32-tutorial.lisp @@ -0,0 +1,163 @@ +;; In this tutorial we expand on the last using clog-web-content +;; to instantly create a site with user, authentication, and +;; content management including comments. We also use the option +;; :extended-routing to allow handlers to handle routes on the +;; same path. + + +(defpackage #:clog-tut-32 + (:use #:cl #:clog #:clog-web #:clog-auth #:clog-web-dbi) + (:export start-tutorial)) + +(in-package #:clog-tut-32) + +;; +;; Setup website structure, database and CLOG +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar *sql-connection* nil) + +;; Default user/pass is username: admin and password: admin + +;; /content is our root content URL, if you are authorized as an +;; editor or admin you are able to add additional pages by going to +;; the url /content/whatever and then click to add page. If you want +;; it in the menu you would just need to add the url to the +;; menu. There is no need to add handlers for pages under /content as +;; when we initalized CLOG we used the option :extended-routing so +;; that a URL start with /content/ will be sent to the same handler as +;; /content in this case on-main. So our about page has no handler set +;; but functions as we added to out database. + + ; Menu Menu Item URL Handler Actions Auth +(defparameter *menu* `(("Features" (("Home" "/") + ("Login" "/login" on-login :login) + ("Signup" "/signup" on-signup :signup) + ("Content" "/content" on-main :content) + ("Logout" "/logout" on-logout :logout))) + ("Admin" (("User List" "/users" on-users :users))) + ("Help" (("About" "/content/about")))) + "Setup website menu") + +(defun start-tutorial () + ;; Here we add authorizations for content and editting content, not just + ;; access to pages. + (add-authorization '(:guest :member) '(:content-show-comments)) + (add-authorization '(:guest) '(:login :signup)) + (add-authorization '(:member) '(:logout + :content-comment)) + (add-authorization '(:editor) '(:content-edit)) + (add-authorization '(:admin) '(:users :content-admin)) + ;; Setup database connection + (when *sql-connection* + (dbi:disconnect *sql-connection*)) + (let ((db-dir (format nil "~A~A" (asdf:system-source-directory :clog) "tut-32.db"))) + (setf *sql-connection* (dbi:connect :sqlite3 :database-name db-dir)) + (format t "Database location: ~A~%" db-dir)) + ;; Check if need to setup sample data + (handler-case + (dbi:fetch (dbi:execute (dbi:prepare *sql-connection* "select * from config"))) + (error () + (print "Create database and tables.") + (create-base-tables *sql-connection*) + ;; A main page was added, but let's also add an about page: + (dbi:do-sql + *sql-connection* + (sql-insert* "content" `(:key "about" + :title "About Tutorial 32" + :value "All about me." + :createdate (,*sqlite-timestamp*)))))) + ;; Setup clog + (initialize 'on-main + :long-poll-first t + :extended-routing t + :boot-function (clog-web-meta + "clogpower.com - CLOG - the common lisp omnificent gui")) + (clog-web-routes-from-menu *menu*) + (open-browser)) + +;; +;; Look and Feel +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun init-site (body) + "Setup the website, called on each url switch" + ;; Initialize the clog-web environment + (clog-web-initialize body) + ;; Instantly reload other windows open on authentication change + (set-on-authentication-change body (lambda (body) + (url-replace (location body) "/"))) + ;; Initialzie the clog-web-site environment + (let ((profile (get-profile body *sql-connection*))) + (create-web-site body + :settings '(:color-class "w3-blue-gray" + :border-class "" + :signup-link "/signup" + :login-link "/login") + :profile profile + ;; We define the roles simply if logged out a :guest + ;; if logged in a :member and if username is admin + ;; a :member, :editor and :admin. + :roles (if profile + (if (equalp "admin" + (getf profile :|username|)) + '(:member :editor :admin) + '(:member)) + '(:guest)) + :title "CLOG - The Common Lisp Omnificent GUI" + :footer "(c) 2022 David Botton" + :logo "/img/clog-liz.png"))) + +;; +;; URL Path Handlers +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun on-login (body) + (init-site body) + (create-web-page + body + :login `(:menu ,*menu* + :on-submit ,(lambda (obj) + (if (login body *sql-connection* + (name-value obj "username") + (name-value obj "password")) + (url-replace (location body) "/") + (clog-web-alert obj "Invalid" "The username and password are invalid." + :time-out 3 + :place-top t)))) + :authorize t)) + +(defun on-logout (body) + (logout body) + (url-replace (location body) "/")) + +(defun on-signup (body) + (init-site body) + (create-web-page body + :signup `(:menu ,*menu* + :content ,(lambda (body) + (sign-up body *sql-connection*))) + :authorize t)) + +(defun on-main (body) + (init-site body) + (create-web-page body :index `(:menu ,*menu* + :content ,(clog-web-content *sql-connection* + :comment-table "content")))) + +(defun on-users (body) + (init-site body) + (create-web-page body :users + `(:menu ,*menu* + :content ,(lambda (body) + (let ((users (dbi:fetch-all + (dbi:execute + (dbi:prepare + *sql-connection* + "select * from users"))))) + (dolist (user users) + (create-div body :content (getf user :|username|)))))) + :authorize t))