focks
/
glacier
1
0
Fork 0
Code Issues 1 Pull Requests Packages Projects Releases Wiki Activity

fixed issue where posting a status without a poll threw an error 

rearranged some code and broke out several things into files
retooled the cw-mapping to be more robust
cw-mappings check mapping files to see if theyve been updated before posting
This commit is contained in:
a. fox 2023-01-14 23:13:42 -05:00
parent 2a50c3bf32
commit 2175efedfa
6 changed files with 112 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
bot.lisp
View File

@ -1,24 +1,5 @@
(in-package #:glacier)
(defvar *bot* nil
"global bot object")
(defvar *commands* (make-hash-table :test #'equal)
"hash table containing the bot's commands
KEY is the command as a string
VALUE is a function that accepts a tooter:status object as a parameter")
(defvar *command-prefix* "!"
"character or string that prefixes a command")
(defvar *privileged-commands* (make-hash-table :test #'equal)
"hash table containing commands that will only be ran if the mention
is from an account the bot follows
KEY is the command as a string
VALUE is a function that accepts a tooter:status object as a parameter")
(defclass bot-client (tooter:client) ()
(:default-initargs
:name "GlacierBot"
@ -56,15 +37,10 @@ VALUE is a function that accepts a tooter:status object as a parameter")
;; load our mappings if provided and they exist
(when (config :cw-mappings)
(setf (config :cw-mappings)
(loop :with mappings
:for f in (ensure-list (config :cw-mappings))
:when (uiop:file-exists-p f)
:do (setf mappings
(append mappings
(parse-mapping-file f)))
:finally (return mappings))))
(setf *cw-mappings* (load-mapping-files (config :cw-mappings))
*mappings-write-date* (map 'list #'file-write-date
(ensure-list (config :cw-mappings)))))
(let* ((client (make-instance 'bot-client

32
extensions.lisp
View File

@ -92,23 +92,33 @@ if INCLUDE-MENTIONS is non-nil, include mentions besides the primary account bei
:in-reply-to (tooter:id status))))
(defun post (text &key (visibility :unlisted) cw sensitive media
poll-options poll-multiple-choice-p poll-timeout poll-hide-totals-p)
poll-options poll-timeout
(poll-hide-totals-p nil h-p) (poll-multiple-choice-p nil m-p))
"a thin wrapper around tooter:make-status
will automatically generate a content warning if cw-mappings was provided when the bot was created
Note: POLL-TIMEOUT is the number of seconds until the poll ends
see documentation for that function"
(tooter:make-status (bot-client *bot*)
text
:visibility visibility
:spoiler-text (or cw (generate-cw text (config :cw-mappings)))
:media (upload-media media)
:sensitive sensitive
:poll-options poll-options
:poll-expire-seconds poll-timeout
:poll-multiple poll-multiple-choice-p
:poll-hide-totals poll-hide-totals-p))
(when (and *cw-mappings* (mappings-updated-p (config :cw-mappings)))
(setf *cw-mappings* (load-mapping-files (config :cw-mappings))
*mappings-write-date* (map 'list #'file-write-date
(ensure-list (config :cw-mappings)))))
(let ((args `(,(bot-client *bot*) ,text
:visibility ,visibility
:spoiler-text ,(or cw (generate-cw text *cw-mappings*))
:media ,(upload-media media)
:sensitive ,sensitive
:poll-options ,poll-options
:poll-expire-seconds ,poll-timeout)))
(when m-p
(setf args (append args (list :poll-multiple poll-multiple-choice-p))))
(when h-p
(setf args (append args (list :poll-hide-totals poll-hide-totals-p))))
(apply #'tooter:make-status args)))
;; strips out html-tags/bot-username if we have that set in our config
(defmethod tooter:decode-entity :after ((status tooter:status) data)

4
glacier.asd
View File

@ -10,7 +10,9 @@
#:tooter #:cl-ppcre #:alexandria)
:serial t
:components ((:file "package")
(:file "variables")
(:file "util")
(:file "mappings")
(:file "bot")
(:file "extensions")
(:file "util")
(:file "glacier")))

59
mappings.lisp Normal file
View File

@ -0,0 +1,59 @@
(in-package :glacier)
(defun generate-cw (status-text mappings)
"returns a content warning based off of our cw-mappings and the STATUS-TEXT"
(when mappings
(let ((cw-list (loop :with text := (str:split " " (str:downcase status-text))
:for mapping :in mappings
:for cw := (first mapping)
:for trigger-words := (car (rest mapping))
;; i could probably do something with regexes to simplify this
;; but also :shrug: it works
:collect (loop :for trigger :in trigger-words
:if (member trigger text :test #'str:containsp)
:return cw)
:into cws
:finally
(return (remove-if #'not cws)))))
(str:join ", " (remove-duplicates cw-list :test #'string=)))))
(defun load-mapping-files (files)
"loads the content warning mappings from FILES
returns an alist containing all mappings"
(loop :with mappings
:for f :in (ensure-list files)
:when (uiop:file-exists-p f)
:do (setf mappings
(append mappings
(parse-mapping-file f)))
:finally (return mappings)))
(defun parse-mapping-file (file)
"parses mapping FILE, returning an alist of the mappings of the from (CW (words))"
(let ((lines (str:lines (str:from-file file))))
(loop :with cw-def
:with trigger-def
:with file-def
:for line :in lines
:when (and (not cw-def) (str:starts-with-p "warning:" line))
:do (setf cw-def (str:trim (str:replace-first "warning:" "" line)))
:when (and cw-def (str:starts-with-p "words:" line))
:do (setf trigger-def (map 'list #'str:trim (str:split "," (str:replace-first "words:" "" line))))
:when (and cw-def trigger-def)
:do (setf file-def (append file-def (list (list cw-def trigger-def)))
cw-def nil
trigger-def nil)
:finally (return file-def))))
(defun mappings-updated-p (files)
"checks to see if any mapping FILES has been updated since our last check"
(let ((mod-times (map 'list #'file-write-date (ensure-list files))))
(some #'> mod-times *mappings-write-date*)))

40
util.lisp
View File

@ -4,46 +4,6 @@
follow-request-p bot-post-p agetf seconds-until-midnight
current-day dow-for ensure-list))
(defun generate-cw (status-text mappings)
"returns a content warning based off of our cw-mappings and the STATUS-TEXT"
(when mappings
(let ((cw-list (loop :with text := (str:split " " (str:downcase status-text))
:for mapping :in mappings
:for cw := (first mapping)
:for trigger-words := (car (rest mapping))
;; i could probably do something with regexes to simplify this
;; but also :shrug: it works
:collect (loop :for trigger :in trigger-words
:if (member trigger text :test #'str:containsp)
:return cw)
:into cws
:finally
(return (remove-if #'not cws)))))
(str:join ", " (remove-duplicates cw-list :test #'string=)))))
(defun parse-mapping-file (file)
"parses mapping FILE, returning an alist of the mappings of the from (CW (words))"
(let ((lines (str:lines (str:from-file file))))
(loop :with cw-def
:with trigger-def
:with file-def
:for line :in lines
:when (and (not cw-def) (str:starts-with-p "warning:" line))
:do (setf cw-def (str:trim (str:replace-first "warning:" "" line)))
:when (and cw-def (str:starts-with-p "words:" line))
:do (setf trigger-def (map 'list #'str:trim (str:split "," (str:replace-first "words:" "" line))))
:when (and cw-def trigger-def)
:do (setf file-def (append file-def (list (list cw-def trigger-def)))
cw-def nil
trigger-def nil)
:finally (return file-def))))
(defun time-to-seconds (&rest rest)
"takes all values passed as REST, converts the time into seconds, and returns the total

25
variables.lisp Normal file
View File

@ -0,0 +1,25 @@
(in-package :glacier)
(defvar *bot* nil
"global bot object")
(defvar *commands* (make-hash-table :test #'equal)
"hash table containing the bot's commands
KEY is the command as a string
VALUE is a function that accepts a tooter:status object as a parameter")
(defvar *command-prefix* "!"
"character or string that prefixes a command")
(defvar *privileged-commands* (make-hash-table :test #'equal)
"hash table containing commands that will only be ran if the mention
is from an account the bot follows
KEY is the command as a string
VALUE is a function that accepts a tooter:status object as a parameter")
(defvar *mappings-write-date* nil
"")
(defvar *cw-mappings* nil
"")