mirror of
https://codeberg.org/cage/tinmop/
synced 2024-12-11 22:35:20 +01:00
- [DB changes] added a reference to a a row of table 'status' to each row of table 'mention'
This changes is needed to prevent mention lookup code to find the wrong acct, as matching is based only from the username (that is the string on the left of the '@'). Two different acct can share the same username, so the old code returned the first acct the db provided matching the username, not necessarily the correct one. E.g. table mention username | acct ---------+---------- foo | foo@bar foo | foo@baz looking for the first row that match "foo" → "foo@bar", but the post mentioned the "foo@baz" now the table has changed to; username | acct | status-id ---------+------------+---------- foo | foo@bar | 1 foo | foo@baz | 2 search looks for the first row that match "foo" for the status-id = 1: the correct value is returned: 'foo@baz'. this changes is not a solution, for example in a table like this: username | acct | status-id ---------+------------+---------- foo | foo@bar | 1 ---------+------------+---------- foo | foo@bar | 2 ---------+------------+--------- foo | foo@baz | 2 the same query as the one above can return the wrong row, containing "foo@bar" - changed function name: 'html-utils:strip-footnote-reference' → 'html-utils:strip-footnote-reference-word'.
This commit is contained in:
cage
parent
bb57160811
commit
c790da4407
39
src/db.lisp
39
src/db.lisp
@ -412,7 +412,7 @@
|
||||
+make-close+)))
|
||||
|
||||
(defun make-mention ()
|
||||
(query-low-level (strcat (prepare-table +table-mention+)
|
||||
(query-low-level (strcat (prepare-table +table-mention+ :integer-id-p t :autoincrementp t)
|
||||
" username TEXT NOT NULL,"
|
||||
;; this is the actual user identification
|
||||
" acct TEXT NOT NULL,"
|
||||
@ -420,7 +420,7 @@
|
||||
" url TEXT NOT NULL,"
|
||||
;; local value, timestamp
|
||||
" \"date-added\" TEXT NOT NULL,"
|
||||
" UNIQUE(id) ON CONFLICT FAIL"
|
||||
" \"status-id\" TEXT NOT NULL"
|
||||
+make-close+)))
|
||||
|
||||
(defun make-followed-user ()
|
||||
@ -1327,25 +1327,29 @@ than (swconf:config-purge-history-days-offset) days in the past"
|
||||
+tag-separator+)
|
||||
"")))
|
||||
|
||||
(defmethod update-db ((object tooter:mention) &key &allow-other-keys)
|
||||
(defmethod update-db ((object tooter:mention) &key (status-id nil) &allow-other-keys)
|
||||
(with-accessors ((id tooter:id)
|
||||
(username tooter:username)
|
||||
(account-name tooter:account-name)
|
||||
(url tooter:url)) object
|
||||
(assert status-id)
|
||||
(let ((actual-username (clean-chars username))
|
||||
(actual-acct (clean-chars account-name))
|
||||
(now (prepare-for-db (local-time-obj-now))))
|
||||
(insert-or-update +table-mention+
|
||||
(:id
|
||||
:username
|
||||
:acct
|
||||
:url
|
||||
:date-added)
|
||||
(id
|
||||
actual-username
|
||||
actual-acct
|
||||
url
|
||||
now)))))
|
||||
(when (not (mentioned-username->account actual-username
|
||||
status-id
|
||||
:add-mention-prefix nil))
|
||||
(query (make-insert +table-mention+
|
||||
(:username
|
||||
:acct
|
||||
:url
|
||||
:date-added
|
||||
:status-id)
|
||||
(actual-username
|
||||
actual-acct
|
||||
url
|
||||
now
|
||||
status-id)))))))
|
||||
|
||||
(defmethod update-db ((object tooter:status)
|
||||
&key
|
||||
@ -1378,7 +1382,7 @@ than (swconf:config-purge-history-days-offset) days in the past"
|
||||
(poll tooter:poll)
|
||||
(mentions tooter:mentions)) object
|
||||
(update-db account)
|
||||
(mapcar #'update-db mentions)
|
||||
(mapcar (lambda (a) (update-db a :status-id id)) mentions)
|
||||
(let* ((account-id (tooter:id account))
|
||||
(actual-created-at (decode-datetime-string created-at))
|
||||
(actual-application (prepare-for-db application))
|
||||
@ -1924,11 +1928,12 @@ the message identified by the tuple."
|
||||
(cons (msg-utils:add-mention-prefix local-name)
|
||||
(msg-utils:add-mention-prefix username))))))
|
||||
|
||||
(defun mentioned-username->account (username &key (add-mention-prefix t))
|
||||
(defun mentioned-username->account (username status-id &key (add-mention-prefix t))
|
||||
"Returns an alist of all known accounts as ('@'local-username . '@'acct)."
|
||||
(let* ((query (select :acct
|
||||
(from +table-mention+)
|
||||
(where (:= :username username))))
|
||||
(where (:and (:= :username username)
|
||||
(:= :status-id status-id)))))
|
||||
(acct (second (fetch-single query))))
|
||||
(if add-mention-prefix
|
||||
(msg-utils:add-mention-prefix acct)
|
||||
|
||||
@ -141,7 +141,7 @@
|
||||
enforce-end-string))
|
||||
|
||||
(let ((scanner (cl-ppcre:create-scanner (footnote-reference-re))))
|
||||
(defun strip-footnote-reference (word)
|
||||
(defun strip-footnote-reference-word (word)
|
||||
(cl-ppcre:regex-replace scanner word "")))
|
||||
|
||||
(defun block-tag-p (node)
|
||||
|
||||
@ -40,12 +40,13 @@
|
||||
(let ((words (split-words message-line))
|
||||
(mention-prefix-length (length +mention-prefix+)))
|
||||
(mapcar (lambda (a)
|
||||
(html-utils:strip-footnote-reference (subseq a mention-prefix-length))) ; remove the @
|
||||
(html-utils:strip-footnote-reference-word (subseq a
|
||||
mention-prefix-length))) ; remove the #\@
|
||||
(remove-if-not (lambda (word)
|
||||
(cl-ppcre:scan (strcat "^" +mention-prefix+) word))
|
||||
words))))
|
||||
|
||||
(defun usernames->usernames-table (message)
|
||||
(defun usernames->usernames-table (message status-id)
|
||||
"Returns a list of pairs ('@'username . '@'acct)."
|
||||
(let ((usernames '()))
|
||||
(loop for line in (split-lines message)
|
||||
@ -57,7 +58,7 @@
|
||||
usernames-in-line))))
|
||||
(mapcar (lambda (username)
|
||||
(cons (add-mention-prefix username)
|
||||
(db:mentioned-username->account username)))
|
||||
(db:mentioned-username->account username status-id)))
|
||||
usernames)))
|
||||
|
||||
(defun local-mention->acct (text-line usernames-table)
|
||||
@ -73,8 +74,8 @@
|
||||
(strcat " " actual-mention)))))
|
||||
results))
|
||||
|
||||
(defun expand-mention (text)
|
||||
(let ((mentioned-users-table (usernames->usernames-table text)))
|
||||
(defun expand-mention (text status-id)
|
||||
(let ((mentioned-users-table (usernames->usernames-table text status-id)))
|
||||
(with-output-to-string (stream)
|
||||
(loop for line in (text-utils:split-lines text) do
|
||||
(let ((line-fixed-mentions (local-mention->acct line mentioned-users-table)))
|
||||
|
||||
@ -528,7 +528,7 @@
|
||||
:position-tag
|
||||
:node->link
|
||||
:append-footnote-reference
|
||||
:strip-footnote-reference
|
||||
:strip-footnote-reference-word
|
||||
:footnote-reference-re
|
||||
:html->text))
|
||||
|
||||
|
||||
@ -2103,7 +2103,7 @@
|
||||
:direction :output
|
||||
:if-exists :supersede
|
||||
:if-does-not-exist :create)
|
||||
(let ((mentioned-users-text (msg-utils:expand-mention text)))
|
||||
(let ((mentioned-users-text (msg-utils:expand-mention text status-id)))
|
||||
(write-sequence mentioned-users-text stream)))
|
||||
(croatoan:end-screen)
|
||||
(tui:with-notify-errors
|
||||
|
||||
@ -1326,7 +1326,8 @@ It an existing file path is provided the command will refuse to run."
|
||||
:direction :output
|
||||
:if-exists :supersede
|
||||
:if-does-not-exist :error)
|
||||
(write-sequence body stream))
|
||||
(write-sequence (html-utils:strip-footnote-reference-word body)
|
||||
stream))
|
||||
(croatoan:end-screen)
|
||||
(tui:with-notify-errors
|
||||
(os-utils:open-with-editor temp-file))
|
||||
@ -1397,7 +1398,8 @@ It an existing file path is provided the command will refuse to run."
|
||||
:direction :output
|
||||
:element-type 'character)
|
||||
(format stream "~a~%" (msg-utils:add-mention-prefix reply-username))
|
||||
(let ((mentioned-users-text (msg-utils:expand-mention quoted-text)))
|
||||
(let ((mentioned-users-text (msg-utils:expand-mention quoted-text
|
||||
reply-id)))
|
||||
(write-sequence mentioned-users-text stream))))))
|
||||
(add-signature (file)
|
||||
(when-let ((signature (message-rendering-utils:signature)))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user