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-13))
  13
  14 (define-public %bot:loadpath (list
  15                               (string-append (getenv "HOME")
  16                                              "/.bobotpp/scripts/")
  17                               bot:sys-scripts-dir))
  18
  19 (define-public %bot:load-extensions %load-extensions)
  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 file)
  34   (let path-loop ((load-path %bot:loadpath))
  35     (cond ((not (null? load-path))
  36            (if (not
  37                 (let ext-loop ((extensions %bot:load-extensions))
  38                   (cond ((not (null? extensions))
  39                          (if (catch 'system-error
  40                                     (lambda ()
  41                                       (load
  42                                        (string-append (car load-path)
  43                                                       file
  44                                                       (car extensions)))
  45                                       #t)
  46                                     (lambda args
  47                                       #f ))
  48                              #t
  49                              (ext-loop (cdr extensions))))
  50                         (else #f))))
  51                (path-loop (cdr load-path))))
  52           (else
  53            (begin (bot:log "ERROR: File " file " Not Found!\n") #f)))))
  54
  55 (define-public (bot:load-module module-spec)
  56   (let ((module->string
  57          (lambda (module)
  58           (apply
  59            (lambda (s . rest)
  60              (string-append
  61               s
  62               (apply string-append
  63                      (map (lambda (str) (string-append "/" str)) rest))))
  64                  (map symbol->string module))))
  65         (new-module
  66          (make-module))
  67         (old-module (current-module)))
  68     (module-use! new-module the-bot-module)
  69     (set-current-module new-module)
  70     (bot:load (module->string module-spec))
  71     (set-current-module old-module)
  72     new-module))
  73
  74 (define-public (bot:use-module module-spec)
  75   (module-use! (current-module)
  76                (bot:load-module module-spec)))
  77
  78
  79 ;;; REGEX UTILS
  80
  81 ;;; match-not-channel adds a prefix regex to your regex so it doesn't
  82 ;;; match the sender or channel in a PUBLIC message
  83 (define-public (bot:match-not-channel regex)
  84   (string-append "^[[:graph:]]*[&#+!][^ ,\a]+ [[:graph:][:space:]]*"
  85                  regex))
  86
  87 ;;; match-to-me matches text that was addressed to the bot with a
  88 ;;; ':',',', or nothing after the bot name
  89
  90 ;(define-public (bot:match-to-me r) r)
  91 (define-public (bot:match-to-me regex)
  92   (string-append (bot:match-not-channel (bot:getnickname))
  93                  "[[:space:][:graph:]]*" regex))
  94
  95 (define-public (bot:sent-to-me? message)
  96   (let ((to-me (make-regexp (bot:match-to-me ""))))
  97     (if (regexp-exec to-me message) #t #f)))
  98
  99 ;;;; string-utils
 100 (define-public str-app string-append) ; shorter
 101
 102 ;;; Message sending utils
 103
 104 ;;; Returns the CTCP quoted message
 105 ;;; Input _MUST NOT_ contain the trailing \r\n
 106 ;;; (it is added by the message sending code)
 107 (define-public (bot:ctcp-quote message)
 108   ;; TODO: Not very efficient, it may be worth reimplementing
 109   (let ((ls (string->list message)))
 110      (string-concatenate
 111       (map (lambda (chr) ; CTCP level quoting
 112              (case (char->integer chr)
 113                ((#o134) (string (integer->char #o134) (integer->char
 114                                                        #o134)))
 115                ((#o01)  (string (integer->char #o134) #\a)) ; X-DELIM
 116                (else (string chr))))
 117            (string->list
 118             (string-concatenate
 119              (map (lambda (chr) ; Low-level
 120                     (let ((m-quote (integer->char #o20)))
 121                       (case chr
 122                         ((m-quote)  (string m-quote m-quote))
 123                         ((#\nul)    (string m-quote #\0))
 124                         ((#\nl)     (string m-quote #\n))
 125                         ((#\cr)     (string m-quote #\r))
 126                         (else       (string chr)))))
 127                   ls)))))))
 128
 129
 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))