Chapter 9 commit.

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)

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!

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*

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

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

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

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

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

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

templates/articles/form.html

@@ -62,6 +62,10 @@
   <tr>
     <th><label for="expired-year">Date expired</label></th>
     <td>
+      <div>
+	<label for="no-expiration">No expiration</label>
+	<input type="checkbox" {% if no-expiration-p %}checked{% endif %}
+	       name="NO-EXPIRATION-P" id="no-expiration"/>
       <select id="expired-year" name="EXPIRED-YEAR">
         {{ article.date-expired
         | lisp: (lambda(arg)

templates/articles/index.html

@@ -19,12 +19,13 @@
     {% for article in articles %}
     <tr>
       <td><a href="/articles/{{article.id}}">{{article.title}}</a></td>
-      <td>{{ article.date-released
+      <td>{{article.date-released
         | date: ((:year 4)"/"(:month 2)"/"(:day 2)" "(:hour 2)":"(:min 2))
-        }}</td>
+        }}
+      </td>
       <td>
         <a href="/articles/{{article.id}}/edit">Edit</a>|
-        <form action="/articles/{{article.id}}/delete" method="post">
+        <form action="/articles/{{article.id}}" method="post">
           <input type="hidden" name="AUTHENTICITY-TOKEN" value="{{token}}">
           <input type="hidden" name="METHOD" value="delete">
           <input type="submit" value="Delete">

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.
   -->
-<h2>{{ message }}</h2>
-{% for b in numbers %}
-<li><a href="#">Blog Header</a></li>
+
+{% for article in articles %}
+<h2>{{article.title}}</h2>
+<p>{{article.body | truncatechars:80}}
+<a href="/article/{{article.id}}">More</a>
+</p>
+{% endfor %}
+
+{% for blog in blogs %}
 {% endfor %}
 
 {% if alert %}

templates/shared/sidebar.html

@@ -3,8 +3,8 @@
 {% endif %}
 <h2>Latest News</h2>
 <ul>
-  {% for n in news %}
-  <li><a href="#">News Header</a></li>
+  {% for n in articles %}
+  <li><a href="/articles/{{n.id}}">{{n.title}}</a></li>
   {% endfor %}
 </ul>