logbot-genesis 1 (in-package #:logbot)
logbot-genesis 2
logbot-genesis 3
logbot-genesis 4 (defun get-and-purge-outbox-messages (db)
logbot-genesis 5 (postmodern:with-connection db
logbot-genesis 6 (postmodern:query
logbot-genesis 7 "with deleted as (
logbot-genesis 8 delete from outbox
logbot-genesis 9 returning target, message, queued_at
logbot-genesis 10 )
logbot-genesis 11 select target,
logbot-genesis 12 message
logbot-genesis 13 from deleted
logbot-genesis 14 order by queued_at"
logbot-genesis 15 :rows)))
logbot-genesis 16
logbot-genesis 17 (defun make-log-entry (db target message host source user)
logbot-genesis 18 (postmodern:with-connection db
logbot-genesis 19 (postmodern:execute
logbot-genesis 20 "insert into log (target, message, host, source, \"user\")
logbot-genesis 21 values ($1, $2, $3, $4, $5)"
logbot-genesis 22 target
logbot-genesis 23 message
logbot-genesis 24 (if (string= "" host) :null host)
logbot-genesis 25 source
logbot-genesis 26 (if (null user) :null user))))
logbot-genesis 27
logbot-genesis 28
logbot-genesis 29 (defclass logbot (ircbot)
logbot-genesis 30 ((pg-thread :accessor logbot-pg-thread :initform nil)
logbot-genesis 31 (db :reader logbot-db :initarg :db)))
logbot-genesis 32
logbot-genesis 33 (defmethod ircbot-connect :after ((bot logbot))
logbot-genesis 34 (let ((conn (ircbot-connection bot)))
logbot-genesis 35 (add-hook conn 'irc-mode-message (lambda (message)
logbot-genesis 36 (logbot-check-mode bot message)))
logbot-genesis 37 (add-hook conn 'irc-privmsg-message (lambda (message)
logbot-genesis 38 (destructuring-bind (target message-text) (arguments message)
logbot-genesis 39 (make-log-entry (logbot-db bot)
logbot-genesis 40 target
logbot-genesis 41 message-text
logbot-genesis 42 (host message)
logbot-genesis 43 (source message)
logbot-genesis 44 (user message)))))))
logbot-genesis 45
logbot-genesis 46 (defmethod ircbot-send-message :after ((bot logbot) target message-text)
logbot-genesis 47 (let* ((b-connection (ircbot-connection bot))
logbot-genesis 48 (b-user (user b-connection)))
logbot-genesis 49 (make-log-entry (logbot-db bot)
logbot-genesis 50 target
logbot-genesis 51 message-text
logbot-genesis 52 (hostname b-user)
logbot-genesis 53 (nickname b-user)
logbot-genesis 54 (username b-user))))
logbot-genesis 55
logbot-genesis 56 (defmethod logbot-check-mode ((bot logbot) message)
logbot-genesis 57 (if (= 3 (length (arguments message)))
logbot-genesis 58 (destructuring-bind (channel mode nick) (arguments message)
logbot-genesis 59 (when (and (string= (host message) "services.")
logbot-genesis 60 (string= channel (ircbot-channel bot))
logbot-genesis 61 (or (string= mode "+o") (string= mode "+v"))
logbot-genesis 62 (string= nick (ircbot-nick bot)))
logbot-genesis 63
logbot-genesis 64 (when (null (logbot-pg-thread bot))
logbot-genesis 65 (logbot-start-pg-thread bot)
logbot-genesis 66 (logbot-send-outbox bot))))))
logbot-genesis 67
logbot-genesis 68 (defmethod logbot-send-outbox ((bot logbot))
logbot-genesis 69 (loop
logbot-genesis 70 for (target message)
logbot-genesis 71 in (get-and-purge-outbox-messages (logbot-db bot))
logbot-genesis 72 do (ircbot-send-message bot target message)))
logbot-genesis 73
logbot-genesis 74 (defmethod logbot-start-pg-thread ((bot logbot))
logbot-genesis 75 (setf (logbot-pg-thread bot)
logbot-genesis 76 (sb-thread:make-thread
logbot-genesis 77 (lambda ()
logbot-genesis 78 (postmodern:with-connection (logbot-db bot)
logbot-genesis 79 (postmodern:execute "listen outbox_new_message")
logbot-genesis 80 (loop
logbot-genesis 81 (if (string= (cl-postgres:wait-for-notification postmodern:*database*)
logbot-genesis 82 "outbox_new_message")
logbot-genesis 83 (logbot-send-outbox bot)))))
logbot-genesis 84 :name "logbot-pg")))
logbot-genesis 85
logbot-genesis 86 (defun make-logbot (server port nick password channel db)
logbot-genesis 87 (make-instance 'logbot
logbot-genesis 88 :server server
logbot-genesis 89 :port port
logbot-genesis 90 :nick nick
logbot-genesis 91 :password password
logbot-genesis 92 :channel channel
logbot-genesis 93 :db db))