commit cd6b51182f09055b460aebd9a66518e54f02e631
parent ede655180d70092fcc432b6b1b2e634a6565c5d5
Author: Natasha Kerensikova <natgh@instinctive.eu>
Date: Fri, 26 Jan 2024 18:51:07 +0000
Object and subject can be hidden
Diffstat:
4 files changed, 96 insertions(+), 16 deletions(-)
diff --git a/src/pref-matrix.scm b/src/pref-matrix.scm
@@ -238,7 +238,8 @@
(define (object-list tid)
(query (map-rows car)
- (sql db "SELECT name FROM object WHERE topic_id=? ORDER BY name;")
+ (sql db "SELECT name FROM object
+ WHERE topic_id=? AND hidden=0 ORDER BY name;")
tid))
(define (subject-id tid name)
@@ -249,7 +250,8 @@
(define (subject-list tid)
(query (map-rows car)
- (sql db "SELECT name FROM subject WHERE topic_id=? ORDER BY name;")
+ (sql db "SELECT name FROM subject
+ WHERE topic_id=? AND hidden=0 ORDER BY name;")
tid))
(define (subject-pref tid name)
@@ -258,6 +260,7 @@
OUTER LEFT JOIN object ON object.id = obj_id
OUTER LEFT JOIN subject ON subject.id = sub_id
WHERE subject.topic_id=? AND subject.name=?
+ AND object.hidden=0
ORDER BY object.name")
tid name))
@@ -364,25 +367,63 @@
(define-traced (new-object topic name)
(let ((tid (writable-topic-id topic)))
- (if (or (not tid) (zero? (string-length name)) (object-id tid name))
+ (if (or (not tid) (zero? (string-length name)))
#f
- (begin
- (exec (sql db "INSERT INTO object(topic_id,name) VALUES (?,?);")
- tid name)
- (let ((result (last-insert-rowid db)))
- (unless replaying? (generate-topic-json tid))
- result)))))
+ (let ((row (query fetch-row
+ (sql db "SELECT id,hidden FROM object
+ WHERE topic_id=? AND name=?;")
+ tid
+ name)))
+ (cond ((null? row)
+ (exec
+ (sql db "INSERT INTO object(topic_id,name) VALUES (?,?);")
+ tid name)
+ (let ((result (last-insert-rowid db)))
+ (unless replaying? (generate-topic-json tid))
+ result))
+ ((zero? (cadr row)) #f)
+ (else
+ (exec (sql db "UPDATE object SET hidden=0 WHERE id=?;")
+ (car row))
+ (unless replaying? (generate-topic-json tid))
+ (car row)))))))
+
+(define-half-traced (hide-object topic name)
+ (let* ((tid (writable-topic-id topic))
+ (oid (if tid (object-id tid name) #f)))
+ (when oid
+ (exec (sql db "UPDATE object SET hidden=1 WHERE id=?;") oid)
+ (unless replaying? (generate-topic-json tid)))))
(define-traced (new-subject topic name)
(let ((tid (writable-topic-id topic)))
- (if (or (not tid) (zero? (string-length name)) (subject-id tid name))
+ (if (or (not tid) (zero? (string-length name)))
#f
- (begin
- (exec (sql db "INSERT INTO subject(topic_id,name) VALUES (?,?);")
- tid name)
- (let ((result (last-insert-rowid db)))
- (unless replaying? (generate-topic-json tid))
- result)))))
+ (let ((row (query fetch-row
+ (sql db "SELECT id,hidden FROM subject
+ WHERE topic_id=? AND name=?;")
+ tid
+ name)))
+ (cond ((null? row)
+ (exec
+ (sql db "INSERT INTO subject(topic_id,name) VALUES (?,?);")
+ tid name)
+ (let ((result (last-insert-rowid db)))
+ (unless replaying? (generate-topic-json tid))
+ result))
+ ((zero? (cadr row)) #f)
+ (else
+ (exec (sql db "UPDATE subject SET hidden=0 WHERE id=?;")
+ (car row))
+ (unless replaying? (generate-topic-json tid))
+ (car row)))))))
+
+(define-half-traced (hide-subject topic name)
+ (let* ((tid (writable-topic-id topic))
+ (sid (if tid (subject-id tid name) #f)))
+ (when sid
+ (exec (sql db "UPDATE subject SET hidden=1 WHERE id=?;") sid)
+ (unless replaying? (generate-topic-json tid)))))
(define-half-traced (set-config key val)
(exec (sql db "INSERT OR REPLACE INTO config(key,val) VALUES (?,?);")
@@ -452,6 +493,26 @@
(lambda () (cmd-sleep) . body))
cmd-list)))))
+(defcmd hide-object
+ (let* ((data (read-urlencoded-request-data (current-request)))
+ (topic (alist-ref 'topic data eq? #f))
+ (name (alist-ref 'name data eq? #f)))
+ (if name
+ (begin
+ (with-db (hide-object topic name))
+ (send-status 'ok))
+ (send-status 'bad-request "Missing parameter"))))
+
+(defcmd hide-subject
+ (let* ((data (read-urlencoded-request-data (current-request)))
+ (topic (alist-ref 'topic data eq? #f))
+ (name (alist-ref 'name data eq? #f)))
+ (if name
+ (begin
+ (with-db (hide-subject topic name))
+ (send-status 'ok))
+ (send-status 'bad-request "Missing parameter"))))
+
(defcmd new-topic
(let* ((data (read-urlencoded-request-data (current-request)))
(name (alist-ref 'name data eq? #f)))
diff --git a/test/run.sh b/test/run.sh
@@ -194,6 +194,21 @@ check_text test-4-7b.json test-two.json
do_post '/set-pref' 200 -d 'topic=one' -d 'sub=bar' -d 'thing=2' -d 'common=5'
check_text test-4-7a.json test-one.json
check_text test-4-7b.json test-two.json
+do_post '/hide-subject' 200 -d 'topic=one' -d 'name=foo'
+check_text test-4-8a.json test-one.json
+check_text test-4-7b.json test-two.json
+do_post '/hide-object' 200 -d 'topic=two' -d 'name=common'
+check_text test-4-8a.json test-one.json
+check_text test-4-8b.json test-two.json
+do_post '/hide-object' 200 -d 'topic=two' -d 'name=non-existent'
+check_text test-4-8a.json test-one.json
+check_text test-4-8b.json test-two.json
+do_post '/new-object' 200 -d 'topic=two' -d 'name=common'
+check_text test-4-8a.json test-one.json
+check_text test-4-7b.json test-two.json
+do_post '/new-subject' 200 -d 'topic=one' -d 'name=foo'
+check_text test-4-7a.json test-one.json
+check_text test-4-7b.json test-two.json
kill "${SRV_PID}"
trap 'rm -f ${TO_CLEAN}' EXIT
diff --git a/test/test-4-8a.json b/test/test-4-8a.json
@@ -0,0 +1 @@
+[["common","some"],{"bar":{"common":5}}]
+\ No newline at end of file
diff --git a/test/test-4-8b.json b/test/test-4-8b.json
@@ -0,0 +1 @@
+[["thing"],{"baz":{},"foo":{"thing":2}}]
+\ No newline at end of file
