From f45c41b38cd8a128ce55b944bc17d4145b851711 Mon Sep 17 00:00:00 2001 From: cage Date: Fri, 27 Sep 2024 19:57:01 +0200 Subject: [PATCH] - added purging of unused mentions from database; - fixed function to clean configuration directives relate dto purging entries from database (history, mentions etc.). --- etc/shared.conf | 10 ++++++++-- src/db.lisp | 26 +++++++++++++++++------- src/package.lisp | 4 +++- src/scheduled-events.lisp | 4 ++++ src/software-configuration.lisp | 35 ++++++++++++++++++++------------- 5 files changed, 55 insertions(+), 24 deletions(-) diff --git a/etc/shared.conf b/etc/shared.conf index c83d50a..ec31a26 100644 --- a/etc/shared.conf +++ b/etc/shared.conf @@ -29,10 +29,16 @@ reply-quoted-character = "> " # delete the command history entries that are older than this number # of days -purge-history-days-offset = -30 +purge-history-days-offset = 30 # delete the cache entries that are older than this number of days -purge-cache-days-offset = -7 +purge-cache-days-offset = 7 + +# delete the cache entries that are older than this number of days +purge-gemlog-seen-post-days-offset = 255 + +# delete the mentions from database that has not been used after this number of days +purge-post-mention-days-offset = 200 # chosen editor (as shell command line) for compose a message editor = "nano --locking" diff --git a/src/db.lisp b/src/db.lisp index 6331f0c..3166fc3 100644 --- a/src/db.lisp +++ b/src/db.lisp @@ -418,6 +418,8 @@ " acct TEXT NOT NULL," ;; profile homepage " url TEXT NOT NULL," + ;; local value, timestamp + " \"date-added\" TEXT NOT NULL," " UNIQUE(id) ON CONFLICT FAIL" +make-close+))) @@ -922,14 +924,21 @@ than `max-id'" (local-time:adjust-timestamp (local-time-obj-now) (offset :day (- (abs days-in-the-past))))) +(defun purge-by-date-added (table threshold) + "Remove expired entry in history. +An entry is expired if older than `threshold' days in the past" + (query (make-delete table + (:< :date-added (prepare-for-db threshold))))) + (defun purge-history () "Remove expired entry in history. An entry is expired if older than (swconf:config-purge-history-days-offset) days in the past" - (let ((threshold (threshold-time (swconf:config-purge-history-days-offset)))) - (query (make-delete +table-input-history+ - (:< :date-added (prepare-for-db threshold)))))) + (purge-by-date-added +table-input-history+ (swconf:config-purge-history-days-offset))) + +(defun purge-post-mentions () + (purge-by-date-added +table-mention+ (swconf:config-purge-post-mention-days-offset))) (defun history-prompt->values (prompt) (mapcar #'second @@ -1324,16 +1333,19 @@ than (swconf:config-purge-history-days-offset) days in the past" (account-name tooter:account-name) (url tooter:url)) object (let ((actual-username (clean-chars username)) - (actual-acct (clean-chars account-name))) + (actual-acct (clean-chars account-name)) + (now (prepare-for-db (local-time-obj-now)))) (insert-or-update +table-mention+ (:id :username :acct - :url) + :url + :date-added) (id actual-username actual-acct - url))))) + url + now))))) (defmethod update-db ((object tooter:status) &key @@ -3165,7 +3177,7 @@ conversation removed (default: remove)" (query (make-delete +table-cache+ (:= :key key)))) -(defun cache-expired-p (key &key (days-in-the-past (swconf:config-purge-cage-days-offset))) +(defun cache-expired-p (key &key (days-in-the-past (swconf:config-purge-cache-days-offset))) "Return non nil if the last time the cache was accessed was older than `days-in-the-past' days (default: `(swconf:config-purge-cache-days-offset)'" (let ((row (cache-get key))) diff --git a/src/package.lisp b/src/package.lisp index 2b28ed0..9f87bcf 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -965,6 +965,7 @@ :next-in-history :most-recent-history-id :purge-history + :purge-post-mentions :history-prompt->values :all-poll-options :find-poll @@ -1480,7 +1481,8 @@ :config-post-allowed-language :config-post-comment-prefix :config-purge-history-days-offset - :config-purge-cage-days-offset + :config-purge-cache-days-offset + :config-purge-post-mention-days-offset :config-notification-life :config-gemini-fragment-as-regex-p :config-notify-window-geometry diff --git a/src/scheduled-events.lisp b/src/scheduled-events.lisp index 38f9c97..1aaa837 100644 --- a/src/scheduled-events.lisp +++ b/src/scheduled-events.lisp @@ -72,6 +72,9 @@ (gen-at-boot-function purge-history (db:purge-history)) +(gen-at-boot-function purge-mentions + (db:purge-post-mentions)) + (gen-at-boot-function refresh-gemlog-posts (when (swconf:gemini-update-gemlog-at-start-p) (ui:gemlog-refresh-all))) @@ -96,6 +99,7 @@ (refresh-gemlog-subscriptions ticks) (purge-gemlog-entries ticks) (purge-history) + (purge-mentions) (refresh-gemlog-posts) (sync-gempub-library) (look-for-announcement-on-boot)) diff --git a/src/software-configuration.lisp b/src/software-configuration.lisp index 26e5ea9..092c370 100644 --- a/src/software-configuration.lisp +++ b/src/software-configuration.lisp @@ -669,6 +669,8 @@ language purge-history-days-offset purge-cache-days-offset + purge-gemlog-seen-post-days-offset + purge-post-mention-days-offset mentions montage search-engine) @@ -1077,23 +1079,28 @@ +key-comment-line+ +key-prefix+) +(defun transform-purge-directive-value (a) + (* -1 + (abs (num:safe-parse-number a + :fix-fn (lambda (e) + (declare (ignore e)) + -100))))) + (gen-simple-access (purge-history-days-offset - :transform-value-fn - (lambda (a) - (num:safe-parse-number a - :fix-fn (lambda (e) - (declare (ignore e)) - 100)))) + :transform-value-fn transform-purge-directive-value) +key-purge-history-days-offset+) -(gen-simple-access (purge-cage-days-offset - :transform-value-fn - (lambda (a) - (num:safe-parse-number a - :fix-fn (lambda (e) - (declare (ignore e)) - 100)))) - +key-purge-history-days-offset+) +(gen-simple-access (purge-cache-days-offset + :transform-value-fn transform-purge-directive-value) + +key-purge-cache-days-offset+) + +(gen-simple-access (purge-gemlog-seen-post-days-offset + :transform-value-fn transform-purge-directive-value) + +key-purge-gemlog-seen-post-days-offset+) + +(gen-simple-access (purge-post-mention-days-offset + :transform-value-fn transform-purge-directive-value) + +key-purge-post-mention-days-offset+) (gen-simple-access (notification-life :transform-value-fn