scripts/bobot-utils.scm

   1 ;;; This file is automatically loaded by Bobot++. This is required for
   2 ;;; the bot to function.
   3
   4 ;;; This file is covered by the GPL version 2 or (at your option) any
   5 ;;; later version
   6
   7 ;;; the-bot-module must be available to guile-user so that scripts
   8 ;;; loaded with Interp::Load have access to the bot: procedures
   9 (module-use! (resolve-module '(guile-user) #f)
  10              the-bot-module)
  11
  12 (use-modules (srfi srfi-1)
  13              (srfi srfi-13))
  14
  15 (add-to-load-path bot:sys-scripts-dir)
  16 (add-to-load-path (string-append (getenv "HOME") "/.bobotpp/scripts/"))
  17 ;; FIXME: effect is to add current config dir, should be explicit
  18 ;; instead (and we don't want to change cwd to config dir necessarily)
  19 (add-to-load-path (getcwd))
  20
  21 ;;; bot:log: Write as many messages as you want to the log.  If the
  22 ;;; arg is a thunk it will be executed and it's output will be
  23 ;;; written to the log
  24 (define-public (bot:log . messages)
  25   (for-each
  26    (lambda (x)
  27      (if (thunk? x)
  28        (display (x) (bot:logport))
  29        (display x (bot:logport))))
  30    messages)
  31   (bot:flushport))
  32
  33 (define-public bot:load load-from-path)
  34
  35 (define (module->string module)
  36   (apply (lambda (s . rest)
  37            (string-append
  38             s
  39             (apply string-append
  40                    (map (lambda (str) (string-append "/" str)) rest))))
  41          (map symbol->string module)))
  42
  43 (define-public (bot:load-module module-spec)
  44   (let ((new-module (make-module 31 (list the-bot-module)))
  45         (old-module (current-module)))
  46     (module-use! new-module the-bot-module)
  47     (set-current-module new-module)
  48     (bot:load (module->string module-spec))
  49     (set-current-module old-module)
  50     new-module))
  51
  52 (define-public (bot:use-module module-spec)
  53   (module-use! (current-module)
  54                (bot:load-module module-spec)))
  55
  56 ;;; REGEX UTILS
  57
  58 ;;; match-not-channel adds a prefix regex to your regex so it doesn't
  59 ;;; match the sender or channel in a PUBLIC message
  60 (define-public (bot:match-not-channel regex)
  61   (string-append "^[[:graph:]]* [&#+!][^ ,\a]+ [[:graph:][:space:]]*"
  62                  regex))
  63
  64 ;;; match-to-me matches text that was addressed to the bot with a
  65 ;;; ':',',', or nothing after the bot name
  66
  67 (define-public (bot:match-to-me regex)
  68   (string-append (bot:match-not-channel (bot:getnickname))
  69                  "[[:space:][:graph:]]*" regex))
  70
  71 (define-public (bot:sent-to-me? message)
  72   (let ((to-me (make-regexp (bot:match-to-me ""))))
  73     (if (regexp-exec to-me message) #t #f)))
  74
  75 ;;;; string-utils
  76 (define-public str-app string-append) ; shorter
  77
  78 ;;; Message sending utils
  79
  80 ;;; Returns the CTCP quoted message
  81 ;;; Input _MUST NOT_ contain the trailing \r\n
  82 ;;; (it is added by the message sending code)
  83 (define-public (bot:ctcp-quote message)
  84   ;; TODO: Not very efficient, it may be worth reimplementing
  85   (let ((ls (string->list message)))
  86      (string-concatenate
  87       (map (lambda (chr) ; CTCP level quoting
  88              (case (char->integer chr)
  89                ((#o134) (string (integer->char #o134) (integer->char
  90                                                        #o134)))
  91                ((#o01)  (string (integer->char #o134) #\a)) ; X-DELIM
  92                (else (string chr))))
  93            (string->list
  94             (string-concatenate
  95              (map (lambda (chr) ; Low-level
  96                     (let ((m-quote (integer->char #o20)))
  97                       (case chr
  98                         ((m-quote)  (string m-quote m-quote))
  99                         ((#\nul)    (string m-quote #\0))
 100                         ((#\nl)     (string m-quote #\n))
 101                         ((#\cr)     (string m-quote #\r))
 102                         (else       (string chr)))))
 103                   ls)))))))
 104
 105 ;;; bot:channel-users user object accessors
 106 (define-public (bot:channel-user-nick cu)
 107   (first cu))
 108
 109 (define-public (bot:channel-user-user/host cu)
 110   (second cu))
 111
 112 (define-public (bot:channel-user-mode cu)
 113   (third cu))
 114
 115 (define-public (bot:channel-user-has-modes? cu . modes)
 116   (let ((mode (apply logior modes)))
 117     (= (logand (bot:channel-user-mode cu)) mode mode)))
 118
 119 (define-public (bot:channel-user-op? cu)
 120   (bot:channel-user-has-modes? cu bot:mode/op))
 121
 122 (define-public (bot:channel-user-voice? cu)
 123   (bot:channel-user-has-modes? cu bot:mode/voice))
 124
 125 (define-public (bot:channel-user-away? cu)
 126   (bot:channel-user-has-modes? cu bot:mode/away))
 127
 128 (define-public (bot:channel-user-ircop? cu)
 129   (bot:channel-user-has-modes? cu bot:mode/op))
 130
 131 ;;; DEPRECATED FUNCTION NAMES
 132 ;;; These are provided for backwards compatibility
 133 ;;; and will be removed in the 3.0 release
 134 (begin-deprecated
 135
 136  (define-macro (_deprecated-fun old-name new-name)
 137    `(define-public ,old-name
 138       (lambda args
 139         (let ((old-error
 140                (set-current-error-port (bot:logport))))
 141           (issue-deprecation-warning
 142            (string-append
 143             (symbol->string ',old-name)
 144             " is a deprecated function. Please use "
 145             (symbol->string ',new-name) " instead."))
 146           (bot:flushport)
 147           (set-current-error-port old-error))
 148           (apply ,new-name args))))
 149
 150  (_deprecated-fun bot-load bot:load)
 151  (_deprecated-fun bot-action bot:action)
 152  (_deprecated-fun bot-adduser bot:adduser)
 153  (_deprecated-fun bot-addserver bot:addserver)
 154  (_deprecated-fun bot-addshit bot:addshit)
 155  (_deprecated-fun bot-ban bot:ban)
 156  (_deprecated-fun bot-cycle bot:cycle)
 157  (_deprecated-fun bot-deban bot:deban)
 158  (_deprecated-fun bot-delserver bot:delserver)
 159  (_deprecated-fun bot-deluser bot:deluser)
 160  (_deprecated-fun bot-delshit bot:delshit)
 161  (_deprecated-fun bot-deop bot:deop)
 162  (_deprecated-fun bot-die bot:die)
 163  (_deprecated-fun bot-do bot:do)
 164  (_deprecated-fun bot-invite bot:invite)
 165  (_deprecated-fun bot-join bot:join)
 166  (_deprecated-fun bot-keep bot:keep)
 167  (_deprecated-fun bot-kick bot:kick)
 168  (_deprecated-fun bot-kickban bot:kickban)
 169  (_deprecated-fun bot-lock bot:lock)
 170  (_deprecated-fun bot-logport bot:logport)
 171  (_deprecated-fun bot-mode bot:mode)
 172  (_deprecated-fun bot-msg bot:msg)
 173  (_deprecated-fun bot-nextserver bot:nextserver)
 174  (_deprecated-fun bot-nick bot:nick)
 175  (_deprecated-fun bot-op bot:op)
 176  (_deprecated-fun bot-part bot:part)
 177  (_deprecated-fun bot-reconnect bot:reconnect)
 178  (_deprecated-fun bot-say bot:say)
 179  (_deprecated-fun bot-server bot:server)
 180  (_deprecated-fun bot-setversion bot:setversion)
 181  (_deprecated-fun bot-tban bot:tban)
 182  (_deprecated-fun bot-tkban bot:tkban)
 183  (_deprecated-fun bot-topic bot:topic)
 184  (_deprecated-fun bot-unlock bot:unlock)
 185  (_deprecated-fun bot-getnickname bot:getnickname)
 186  (_deprecated-fun bot-getserver bot:getserver)
 187  (_deprecated-fun bot-getserverlist bot:getserverlist)
 188  (_deprecated-fun bot-flush bot:flush)
 189  (_deprecated-fun bot-flushport bot:flushport)
 190  (_deprecated-fun bot-random bot:random)
 191  (_deprecated-fun bot-addcommand bot:addcommand)
 192  (_deprecated-fun bot-delcommand bot:delcommand)
 193  (_deprecated-fun bot-addhook bot:addhook)
 194  (_deprecated-fun bot-addtimer bot:addtimer)
 195  (_deprecated-fun bot-deltimer bot:deltimer)
 196
 197  (define-public hooks/leave hooks/part))