- 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

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

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))))
+  (purge-by-date-added +table-input-history+ (swconf:config-purge-history-days-offset)))
-    (query (make-delete +table-input-history+
+
-               (:< :date-added (prepare-for-db threshold))))))
+(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)))

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

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

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
+                    :transform-value-fn transform-purge-directive-value)
-                    (lambda (a)
-                      (num:safe-parse-number a
-                                             :fix-fn (lambda (e)
-                                                       (declare (ignore e))
-                                                       100))))
                    +key-purge-history-days-offset+)
 
-(gen-simple-access (purge-cage-days-offset
+(gen-simple-access (purge-cache-days-offset
-                    :transform-value-fn
+                    :transform-value-fn transform-purge-directive-value)
-                    (lambda (a)
+                   +key-purge-cache-days-offset+)
-                      (num:safe-parse-number a
+
-                                             :fix-fn (lambda (e)
+(gen-simple-access (purge-gemlog-seen-post-days-offset
-                                                       (declare (ignore e))
+                    :transform-value-fn transform-purge-directive-value)
-                                                       100))))
+                   +key-purge-gemlog-seen-post-days-offset+)
-                   +key-purge-history-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