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