cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- added purging of unused mentions from database; 

- fixed function to clean configuration directives relate dto purging entries from database (history, mentions etc.).
This commit is contained in:
cage 2024-09-27 19:57:01 +02:00
parent acc2da4da3
commit 331c3ac847
5 changed files with 55 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
etc/shared.conf
View File

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

26
src/db.lisp
View File

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

4
src/package.lisp
View File

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

4
src/scheduled-events.lisp
View File

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

33
src/software-configuration.lisp
View File

@ -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+)
(gen-simple-access (purge-history-days-offset
:transform-value-fn
(lambda (a)
(num:safe-parse-number a
(defun transform-purge-directive-value (a)
(* -1
(abs (num:safe-parse-number a
:fix-fn (lambda (e)
(declare (ignore e))
100))))
-100)))))
(gen-simple-access (purge-history-days-offset
: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