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                   (if (not (null? extensions))
  39                       (if (catch 'system-error
  40                                  (lambda ()
  41                                    (load
  42                                     (string-append (car load-path)
  43                                                    file
  44                                                    (car extensions))))
  45                                  (lambda args
  46                                    #f ))
  47                           #t
  48                           (ext-loop (cdr extensions))))))
  49                (path-loop (cdr load-path))))
  50           (else
  51            (begin (bot:log "ERROR: File " file " Not Found!\n") #f)))))
  52
  53 (define-public (bot:load-module module-spec)
  54   (let ((module->string
  55          (lambda (module)
  56           (apply
  57            (lambda (s . rest)
  58              (string-append
  59               s
  60               (apply string-append
  61                      (map (lambda (str) (string-append "/" str)) rest))))
  62                  (map symbol->string module))))
  63         (new-module
  64          (make-module))
  65         (old-module (current-module)))
  66     (module-use! new-module the-bot-module)
  67     (set-current-module new-module)
  68     (bot:load (module->string module-spec))
  69     (set-current-module old-module)
  70     new-module))
  71
  72 (define-public (bot:use-module module-spec)
  73   (module-use! (current-module)
  74                (bot:load-module module-spec)))
  75
  76
  77 ;;; REGEX UTILS
  78
  79 ;;; match-not-channel adds a prefix regex to your regex so it doesn't
  80 ;;; match the sender or channel in a PUBLIC message
  81 (define-public (bot:match-not-channel regex)
  82   (string-append "^[[:graph:]]* [&#+!][^ ,\a]+ [[:graph:][:space:]]*" regex))
  83
  84 ;;; match-to-me matches text that was addressed to the bot with a
  85 ;;; ':',',', or nothing after the bot name
  86 (define-public (bot:match-to-me regex)
  87   (string-append (bot:match-not-channel (bot:getnickname))
  88                  "[[:space:][:graph:]]*" regex))
  89
  90 (define-public (bot:sent-to-me? message)
  91   (let ((to-me (make-regexp (bot:match-to-me ""))))
  92     (if (regexp-exec to-me message) #t #f)))
  93
  94 ;;;; string-utils
  95 (define-public str-app string-append) ; shorter
  96
  97 ;;; Message sending utils
  98
  99 ;;; Returns the CTCP quoted message
 100 ;;; Input _MUST NOT_ contain the trailing \r\n
 101 ;;; (it is added by the message sending code)
 102 (define-public (bot:ctcp-quote message)
 103   ;; TODO: Not very efficient, it may be worth reimplementing
 104   (let ((ls (string->list message)))
 105      (string-concatenate
 106       (map (lambda (chr) ; CTCP level quoting
 107              (case (char->integer chr)
 108                ((#o134) (string (integer->char #o134) (integer->char #o134)))
 109                ((#o01)  (string (integer->char #o134) #\a)) ; X-DELIM
 110                (else (string chr))))
 111            (string->list
 112             (string-concatenate
 113              (map (lambda (chr) ; Low-level
 114                     (let ((m-quote (integer->char #o20)))
 115                       (case chr
 116                         ((m-quote)  (string m-quote m-quote))
 117                         ((#\nul)    (string m-quote #\0))
 118                         ((#\nl)     (string m-quote #\n))
 119                         ((#\cr)     (string m-quote #\r))
 120                         (else       (string chr)))))
 121                   ls)))))))
 122
 123
 124
 125 ;;; DEPRECATED FUNCTION NAMES
 126 ;;; These are provided for backwards compatibility
 127 ;;; and will be removed in the 3.0 release
 128 (begin-deprecated
 129
 130  (define-macro (_deprecated-fun old-name new-name)
 131    `(define-public ,old-name
 132       (lambda args
 133         (issue-deprecation-warning
 134          (string-append
 135           (symbol->string ',old-name)
 136           " is a deprecated function. Please use "
 137           (symbol->string ',new-name) " instead."))
 138         (apply ,new-name args))))
 139
 140  (_deprecated-fun bot-load bot:load)
 141  (_deprecated-fun bot-action bot:action)
 142  (_deprecated-fun bot-adduser bot:adduser)
 143  (_deprecated-fun bot-addserver bot:addserver)
 144  (_deprecated-fun bot-addshit bot:addshit)
 145  (_deprecated-fun bot-ban bot:ban)
 146  (_deprecated-fun bot-cycle bot:cycle)
 147  (_deprecated-fun bot-deban bot:deban)
 148  (_deprecated-fun bot-delserver bot:delserver)
 149  (_deprecated-fun bot-deluser bot:deluser)
 150  (_deprecated-fun bot-delshit bot:delshit)
 151  (_deprecated-fun bot-deop bot:deop)
 152  (_deprecated-fun bot-die bot:die)
 153  (_deprecated-fun bot-do bot:do)
 154  (_deprecated-fun bot-invite bot:invite)
 155  (_deprecated-fun bot-join bot:join)
 156  (_deprecated-fun bot-keep bot:keep)
 157  (_deprecated-fun bot-kick bot:kick)
 158  (_deprecated-fun bot-kickban bot:kickban)
 159  (_deprecated-fun bot-lock bot:lock)
 160  (_deprecated-fun bot-logport bot:logport)
 161  (_deprecated-fun bot-mode bot:mode)
 162  (_deprecated-fun bot-msg bot:msg)
 163  (_deprecated-fun bot-nextserver bot:nextserver)
 164  (_deprecated-fun bot-nick bot:nick)
 165  (_deprecated-fun bot-op bot:op)
 166  (_deprecated-fun bot-part bot:part)
 167  (_deprecated-fun bot-reconnect bot:reconnect)
 168  (_deprecated-fun bot-say bot:say)
 169  (_deprecated-fun bot-server bot:server)
 170  (_deprecated-fun bot-setversion bot:setversion)
 171  (_deprecated-fun bot-tban bot:tban)
 172  (_deprecated-fun bot-tkban bot:tkban)
 173  (_deprecated-fun bot-topic bot:topic)
 174  (_deprecated-fun bot-unlock bot:unlock)
 175  (_deprecated-fun bot-getnickname bot:getnickname)
 176  (_deprecated-fun bot-getserver bot:getserver)
 177  (_deprecated-fun bot-getserverlist bot:getserverlist)
 178  (_deprecated-fun bot-flush bot:flush)
 179  (_deprecated-fun bot-flushport bot:flushport)
 180  (_deprecated-fun bot-random bot:random)
 181  (_deprecated-fun bot-addcommand bot:addcommand)
 182  (_deprecated-fun bot-delcommand bot:delcommand)
 183  (_deprecated-fun bot-addhook bot:addhook)
 184  (_deprecated-fun bot-addtimer bot:addtimer)
 185  (_deprecated-fun bot-deltimer bot:deltimer)
 186
 187  (define-public hooks/leave hooks/part))