logbot-genesis 1 (in-package #:logbot)
logbot-genesis 2
logbot-genesis 3
logbot-multiple-c... 4 (defun get-and-purge-outbox-messages (db target)
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-multiple-c... 9 where target = $1
logbot-multiple-c... 10 returning message, queued_at
logbot-genesis 11 )
logbot-multiple-c... 12 select message
logbot-genesis 13 from deleted
logbot-multiple-c... 14 order by queued_at" target
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-multiple-c... 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-multiple-c... 60 (member channel (ircbot-channels bot) :test #'string=)
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-multiple-c... 66 (logbot-send-outbox bot channel))))))
logbot-genesis 67
logbot-multiple-c... 68 (defmethod logbot-send-outbox ((bot logbot) target)
logbot-genesis 69 (loop
logbot-multiple-c... 70 for (message)
logbot-multiple-c... 71 in (get-and-purge-outbox-messages (logbot-db bot) target)
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-multiple-c... 81 (multiple-value-bind (channel payload pid)
logbot-multiple-c... 82 (cl-postgres:wait-for-notification postmodern:*database*)
logbot-multiple-c... 83 (declare (ignore pid))
logbot-multiple-c... 84 (if (string= channel
logbot-multiple-c... 85 "outbox_new_message")
logbot-multiple-c... 86 (logbot-send-outbox bot payload))))))
logbot-genesis 87 :name "logbot-pg")))
logbot-genesis 88
logbot-multiple-c... 89 (defun make-logbot (server port nick password channels db)
logbot-genesis 90 (make-instance 'logbot
logbot-genesis 91 :server server
logbot-genesis 92 :port port
logbot-genesis 93 :nick nick
logbot-genesis 94 :password password
logbot-multiple-c... 95 :channels channels
logbot-genesis 96 :db db))