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