Add tutorial 32 clog-web-content

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
+  "This is used to create PAGE based content. If more than one entry in
-value where key=PAGE or if FOLLOW-URL-PAGE is true PAGE is default
+TABLE is keyed for same PAGE, if theme is configured for it, displays
-page if no second on path otherwise page is the second on path (first
+a table of contents, followed by each content record, followed by
-must be base-url). ON-CONTENT, ON-COMMENT are called with (obj value)
+comments for the whole page.
-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
+Creates content for CLOG-WEB:CREATE-WEB-PAGE based on TABLE where
-nil is return aborted. ON-DELETE called with (obj page comment-id) if
+key=PAGE (or if FOLLOW-URL-PAGE is true PAGE is default page and if no
-returns nil aborted. If comment-table is nil no comments are
+second on path otherwise page is the second on path, first must be
-shown. User must authorize on action set by CAN-COMMENT, CAN-ADMIN,
+base-url). e.g.
-CAN-SHOW-COMMENTS and if CAN-EDIT unless they are set to nil."
+
+(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)))

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.

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