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