diff of 027c7996070a3d372e57dce4f52cfd857ecb5097
027c7996070a3d372e57dce4f52cfd857ecb5097
diff --git a/aggressive-murja.asd b/aggressive-murja.asd
index 58bc4f5..56375c8 100644
--- a/aggressive-murja.asd
+++ b/aggressive-murja.asd
@@ -105,7 +105,9 @@
(:file "literal-test")
(:file "tests")
(:file "rss-tests")
- (:file "session-tests"))))
+ (:file "session-tests")
+ (:file "newui-tests")
+ (:file "post"))))
:perform (test-op (op c)
(eval (read-from-string "(fiveam:run! 'murja.tests:main-suite)"))))
diff --git a/src/models/post.lisp b/src/models/post.lisp
index c83a7b6..e6b2507 100644
--- a/src/models/post.lisp
+++ b/src/models/post.lisp
@@ -1,6 +1,6 @@
(defpackage murja.models.post
(:use :cl)
- (:export :get-page :get-post :post-id :post-title :article :creator :tags :created-at :post-hidden? :post-unlisted?)
+ (:export :Post :get-page :get-post :post-id :post-title :article :creator :tags :created-at :post-hidden? :post-unlisted? :next-post-id :previous-post-id)
(:import-from :com.inuoe.jzon :parse))
(in-package :murja.models.post)
@@ -12,18 +12,19 @@
(title :initarg :title :accessor post-title :col-type string)
(content :initarg :content :accessor article :col-type string)
(creator :initarg :creator :initform nil :accessor creator)
- (creator-id :col-type string :reader creator-id)
+ (creator-id :initarg :creator-id :col-type string :reader creator-id :col-references (murja.models.user:user 'murja.models.user::id))
(tags :initarg :tags :accessor tags :col-type string)
(created-at :initarg :created-at :accessor created-at :col-type simple-date:timestamp)
(hidden :initarg :hidden? :accessor post-hidden? :col-type boolean)
- (unlisted :initarg :unlisted? :accessor post-unlisted? :col-type boolean))
+ (unlisted :initarg :unlisted? :accessor post-unlisted? :col-type boolean)
+ (previous :ghost t :initarg :previous :accessor previous-post-id :col-type integer)
+ (next :ghost t :initarg :next :accessor next-post-id :col-type integer))
(:metaclass postmodern:dao-class)
(:keys id)
(:table-name "blog.Post"))
(defmethod print-object ((p Post) output)
- (with-slots (creator id title content creator-id tags created-at hidden unlisted) p
-
+ (with-slots (creator id title content creator-id tags created-at hidden unlisted previous next) p
(format output "#<POST: ~{~{~a: ~s~}~^,~%~t ~}>" (list
(list :id id)
(list :title title)
@@ -37,7 +38,9 @@
(list :tags tags)
(list :created-at created-at)
(list :hidden hidden)
- (list :unlisted unlisted)))))
+ (list :unlisted unlisted)
+ (list :previous previous)
+ (list :next next)))))
;; (postmodern:query "SELECT * FROM blog.Post limit 1" (:dao post :single))
;; (postmodern:get-dao 'Post 349)
@@ -46,11 +49,32 @@
(defun fix-post (p)
(setf (tags p) (parse (tags p)))
(setf (creator p) (postmodern:get-dao 'murja.models.user:user (creator-id p)))
+
+ ;; next-id and previous-id might point to unlisted posts. They should not do that, but I don't know how to wrangle *post-query* sql to support that, so they have to be fixed in lisp.
+ (unless (or (equalp (previous-post-id p) -1)
+ (not (caar (postmodern:query "SELECT unlisted FROM blog.Post WHERE id = $1" (previous-post-id p)))))
+ (setf (previous-post-id p)
+ (or (caar (postmodern:query "SELECT id FROM blog.Post WHERE ID < $1 AND NOT hidden AND NOT unlisted" (previous-post-id p)))
+ -1)))
+
+ (unless (or (equalp (next-post-id p) -1)
+ (not (caar (postmodern:query "SELECT unlisted FROM blog.Post WHERE id = $1" (next-post-id p)))))
+ (setf (next-post-id p)
+ (or (caar (postmodern:query "SELECT id FROM blog.Post WHERE ID > $1 AND NOT hidden AND NOT unlisted" (next-post-id p)))
+ -1)))
p)
-(defun get-post (id)
- (let ((p (postmodern:get-dao 'Post id)))
- (fix-post p)
+(defparameter *post-query*
+ "
+SELECT * FROM
+(SELECT p.*, LAG(id, 1, -1) OVER (ORDER BY created_at) as previous, LEAD(id, 1, -1) OVER (ORDER BY created_at) as next FROM blog.Post p where (NOT p.hidden OR (p.hidden AND $2)))
+where id = $1
+")
+
+(defun get-post (id &key allow-hidden?)
+ (let ((p (postmodern:query *post-query* id allow-hidden? (:dao Post :single))))
+ (when p
+ (fix-post p))
p))
(defun get-page (page page-size &key allow-hidden? modified-since)
diff --git a/src/models/user.lisp b/src/models/user.lisp
index 3158fec..d907ea5 100644
--- a/src/models/user.lisp
+++ b/src/models/user.lisp
@@ -9,7 +9,7 @@
(username :initarg :username :accessor user-username :col-type string)
(password :initarg :password :accessor user-password :col-type string)
(nickname :initarg :nickname :accessor user-nickname :col-type string)
- (img-location :initarg :img-location :accessor user-img-location :col-type string))
+ (img-location :initform "" :initarg :img-location :accessor user-img-location :col-type string))
(:metaclass postmodern:dao-class)
(:keys id)
diff --git a/src/views/components/post.lisp b/src/views/components/post.lisp
index 4f8d274..68a6659 100644
--- a/src/views/components/post.lisp
+++ b/src/views/components/post.lisp
@@ -1,5 +1,6 @@
(defpackage murja.views.components.post
- (:use :cl :murja.newui :cl-hash-util :binding-arrows :murja.models.user :murja.models.post)
+ (:use :cl :murja.newui :cl-hash-util :binding-arrows :murja.models.user )
+ (:import-from :murja.models.post :post-id :post-title :creator :created-at :article)
(:export :post))
(in-package :murja.views.components.post)
diff --git a/test/post.lisp b/test/post.lisp
new file mode 100644
index 0000000..c9bfcfe
--- /dev/null
+++ b/test/post.lisp
@@ -0,0 +1,125 @@
+(defpackage murja.tests.posts
+ (:use :cl :fiveam :murja.models.post :murja.models.user)
+ (:import-from :murja.tests :prepare-db-and-server :drakma->string :url :main-suite :prepare-db-and-server))
+
+(in-package :murja.tests.posts)
+
+(in-suite main-suite)
+
+(defparameter *test-user* (make-instance 'User :id 1 :username "test" :password "testpass" :nickname "Test User"))
+
+(defparameter *test-posts*
+ (list (make-instance 'Post
+ :id 1
+ :title "Test"
+ :content "lol"
+ :creator-id 1
+ :created-at (simple-date:encode-timestamp 2002 12 12 1 2 3)
+ :hidden? nil
+ :unlisted? nil
+ :next nil
+ :previous nil
+ :tags "[]")
+ (make-instance 'Post
+ :id 2
+ :title "Test2"
+ :content "lol"
+ :creator-id 1
+ :created-at (simple-date:encode-timestamp 2004 1 12 2 1 3)
+ :hidden? t
+ :unlisted? t
+ :next nil
+ :previous nil
+ :tags "[]")
+ (make-instance 'Post
+ :id 3
+ :title "Test3"
+ :content "lol"
+ :creator-id 1
+ :created-at (simple-date:encode-timestamp 2005 1 12 2 1 3)
+ :hidden? nil
+ :unlisted? t
+ :next nil
+ :previous nil
+ :tags "[]")
+
+ (make-instance 'Post
+ :id 4
+ :title "This shouldn't be visible"
+ :content "lol"
+ :creator-id 1
+ :created-at (simple-date:encode-timestamp 2004 1 12 2 1 3)
+ :hidden? t
+ :unlisted? t
+ :next nil
+ :previous nil
+ :tags "[]")
+ (make-instance 'Post
+ :id 5
+ :title "Newst test "
+ :content "lol"
+ :creator-id 1
+ :created-at (simple-date:encode-timestamp 2010 1 12 2 1 3)
+ :hidden? nil
+ :unlisted? nil
+ :next nil
+ :previous nil
+ :tags "[]")))
+
+(defmacro within-post-test-db (&body body)
+ `(progn
+ (setf murja.middleware.db:*automatic-tests-on?* t)
+ (setf lisp-fixup:*dev?* t)
+ ;; with-db connects automatically to the test-db if *automatic-tests-on?* != nil
+ (murja.middleware.db:with-db
+ (unwind-protect
+ (progn
+ (postmodern:execute "DROP SCHEMA IF EXISTS blog CASCADE;")
+ (postmodern:execute "DROP TABLE IF EXISTS public.ragtime_migrations")
+ (postmodern:execute "DROP TABLE IF EXISTS public.migrations_tracker")
+ (murja.migrations:migrate)
+ (postmodern:insert-dao *test-user*)
+ (mapcar #'postmodern:insert-dao *test-posts*)
+ ,@body)
+
+ (postmodern:execute "DROP SCHEMA IF EXISTS blog CASCADE;")
+ (postmodern:execute "DROP TABLE IF EXISTS public.ragtime_migrations")
+ (postmodern:execute "DROP TABLE IF EXISTS public.migrations_tracker")
+ (setf lisp-fixup:*dev?* nil)
+ (setf murja.middleware.db:*automatic-tests-on?* nil)))))
+
+
+(def-test post-model-test ()
+ (within-post-test-db
+ ;; test data is inserted as expected
+ (is (equalp 1
+ (caar (postmodern:query "SELECT count(*) FROM blog.Users"))))
+ (is (equalp 5
+ (caar (postmodern:query "SELECT count(*) FROM blog.Post"))))
+ (is (equalp 3
+ (caar (postmodern:query "SELECT count(*) FROM blog.Post WHERE hidden or unlisted"))))
+
+ ;; test that previous and next links are calculated correctly
+ (let ((post-3 (murja.models.post:get-post 3)))
+ (is-true post-3)
+ (is (equalp
+ 1
+ (previous-post-id post-3)))
+
+ (is (equalp
+ 5
+ (next-post-id post-3))))
+
+ ;; test that completely public post-1 skips both hidden posts and the unlisted post-3
+ (let ((post-1 (murja.models.post:get-post 1)))
+ (is-true post-1)
+ ;; no previous-id
+ (is (equalp -1
+ (previous-post-id post-1)))
+
+ ;; the next link skips correctly hiddens and unlisteds
+ (is (equalp 5
+ (next-post-id post-1))))))
+
+;; (fiveam:explain!
+;; (fiveam:run 'post-model-test))