[clinton/bobotpp.git] / scripts / bobot-utils.scm

;;; This file is automatically loaded by Bobot++. This is required for
;;; the bot to function.

;;; This file is covered by the GPL version 2 or (at your option) any
;;; later version 

;;; the-bot-module must be available to guile-user so that scripts
;;; loaded with Interp::Load have access to the bot: procedures
(module-use! (resolve-module '(guile-user) #f)
	     the-bot-module)

(use-modules (srfi srfi-1)
	     (srfi srfi-13))

(define-public %bot:loadpath (list
			      (string-append (getenv "HOME")
					     "/.bobotpp/scripts/")
			      bot:sys-scripts-dir))

(define-public %bot:load-extensions %load-extensions)

;;; bot:log: Write as many messages as you want to the log.  If the
;;; arg is a thunk it will be executed and it's output will be
;;; written to the log
(define-public (bot:log . messages)
  (for-each
   (lambda (x)
     (if (thunk? x)
       (display (x) (bot:logport))
       (display x (bot:logport))))
   messages)
  (bot:flushport))

(define-public (bot:load file)
  (let path-loop ((load-path %bot:loadpath))
    (cond ((not (null? load-path))
	   (if (not
		(let ext-loop ((extensions %bot:load-extensions))
		  (cond ((not (null? extensions))
			 (if (catch 'system-error
				    (lambda ()
				      (load
				       (string-append (car load-path)
						      file
						      (car extensions)))
				      #t)
				    (lambda args
				      #f ))
			     #t
			     (ext-loop (cdr extensions))))
			(else #f))))
	       (path-loop (cdr load-path))))
	  (else
	   (begin (bot:log "ERROR: File " file " Not Found!\n") #f)))))

(define-public (bot:load-module module-spec)
  (let ((module->string
	 (lambda (module)
	  (apply
	   (lambda (s . rest)
	     (string-append
	      s
	      (apply string-append
		     (map (lambda (str) (string-append "/" str)) rest))))
		 (map symbol->string module))))
	(new-module
	 (make-module))
	(old-module (current-module)))
    (module-use! new-module the-bot-module)
    (set-current-module new-module)
    (bot:load (module->string module-spec))
    (set-current-module old-module)
    new-module))

(define-public (bot:use-module module-spec)
  (module-use! (current-module)
	       (bot:load-module module-spec)))
    

;;; REGEX UTILS

;;; match-not-channel adds a prefix regex to your regex so it doesn't
;;; match the sender or channel in a PUBLIC message
(define-public (bot:match-not-channel regex)
  (string-append "^[[:graph:]]*[&#+!][^ ,\a]+ [[:graph:][:space:]]*"
		 regex))

;;; match-to-me matches text that was addressed to the bot with a
;;; ':',',', or nothing after the bot name

;(define-public (bot:match-to-me r) r)
(define-public (bot:match-to-me regex)
  (string-append (bot:match-not-channel (bot:getnickname))
		 "[[:space:][:graph:]]*" regex))

(define-public (bot:sent-to-me? message)
  (let ((to-me (make-regexp (bot:match-to-me ""))))
    (if (regexp-exec to-me message) #t #f)))

;;;; string-utils
(define-public str-app string-append) ; shorter

;;; Message sending utils

;;; Returns the CTCP quoted message
;;; Input _MUST NOT_ contain the trailing \r\n
;;; (it is added by the message sending code)
(define-public (bot:ctcp-quote message)
  ;; TODO: Not very efficient, it may be worth reimplementing
  (let ((ls (string->list message)))
     (string-concatenate
      (map (lambda (chr) ; CTCP level quoting
	     (case (char->integer chr)
	       ((#o134) (string (integer->char #o134) (integer->char
						       #o134)))
	       ((#o01)  (string (integer->char #o134) #\a)) ; X-DELIM
	       (else (string chr))))
	   (string->list
	    (string-concatenate
	     (map (lambda (chr) ; Low-level
		    (let ((m-quote (integer->char #o20)))
		      (case chr
			((m-quote)  (string m-quote m-quote))
			((#\nul)    (string m-quote #\0))
			((#\nl)     (string m-quote #\n))
			((#\cr)     (string m-quote #\r))
			(else       (string chr)))))
		  ls)))))))

;;; bot:channel-users user object accessors
(define-public (bot:channel-user-nick cu)
  (first cu))

(define-public (bot:channel-user-user/host cu)
  (second cu))

(define-public (bot:channel-user-mode cu)
  (third cu))

(define-public (bot:channel-user-has-modes? cu . modes)
  (let ((mode (apply logior modes)))
    (= (logand (bot:channel-user-mode cu)) mode mode)))

(define-public (bot:channel-user-op? cu)
  (bot:channel-user-has-modes? cu bot:mode/op))

(define-public (bot:channel-user-voice? cu)
  (bot:channel-user-has-modes? cu bot:mode/voice))

(define-public (bot:channel-user-away? cu)
  (bot:channel-user-has-modes? cu bot:mode/away))
	 
(define-public (bot:channel-user-ircop? cu)
  (bot:channel-user-has-modes? cu bot:mode/op))

;;; DEPRECATED FUNCTION NAMES
;;; These are provided for backwards compatibility
;;; and will be removed in the 3.0 release
(begin-deprecated

 (define-macro (_deprecated-fun old-name new-name)
   `(define-public ,old-name
      (lambda args
	(let ((old-error
	       (set-current-error-port (bot:logport))))
	  (issue-deprecation-warning
	   (string-append
	    (symbol->string ',old-name)
	    " is a deprecated function. Please use "
	    (symbol->string ',new-name) " instead."))
	  (bot:flushport)
	  (set-current-error-port old-error))
	  (apply ,new-name args))))
     
 (_deprecated-fun bot-load bot:load)
 (_deprecated-fun bot-action bot:action)
 (_deprecated-fun bot-adduser bot:adduser)
 (_deprecated-fun bot-addserver bot:addserver)
 (_deprecated-fun bot-addshit bot:addshit)
 (_deprecated-fun bot-ban bot:ban)
 (_deprecated-fun bot-cycle bot:cycle)
 (_deprecated-fun bot-deban bot:deban)
 (_deprecated-fun bot-delserver bot:delserver)
 (_deprecated-fun bot-deluser bot:deluser)
 (_deprecated-fun bot-delshit bot:delshit)
 (_deprecated-fun bot-deop bot:deop)
 (_deprecated-fun bot-die bot:die)
 (_deprecated-fun bot-do bot:do)
 (_deprecated-fun bot-invite bot:invite)
 (_deprecated-fun bot-join bot:join)
 (_deprecated-fun bot-keep bot:keep)
 (_deprecated-fun bot-kick bot:kick)
 (_deprecated-fun bot-kickban bot:kickban)
 (_deprecated-fun bot-lock bot:lock)
 (_deprecated-fun bot-logport bot:logport)
 (_deprecated-fun bot-mode bot:mode)
 (_deprecated-fun bot-msg bot:msg)
 (_deprecated-fun bot-nextserver bot:nextserver)
 (_deprecated-fun bot-nick bot:nick)
 (_deprecated-fun bot-op bot:op)
 (_deprecated-fun bot-part bot:part)
 (_deprecated-fun bot-reconnect bot:reconnect)
 (_deprecated-fun bot-say bot:say)
 (_deprecated-fun bot-server bot:server)
 (_deprecated-fun bot-setversion bot:setversion)
 (_deprecated-fun bot-tban bot:tban)
 (_deprecated-fun bot-tkban bot:tkban)
 (_deprecated-fun bot-topic bot:topic)
 (_deprecated-fun bot-unlock bot:unlock)
 (_deprecated-fun bot-getnickname bot:getnickname)
 (_deprecated-fun bot-getserver bot:getserver)
 (_deprecated-fun bot-getserverlist bot:getserverlist)
 (_deprecated-fun bot-flush bot:flush)
 (_deprecated-fun bot-flushport bot:flushport)
 (_deprecated-fun bot-random bot:random)
 (_deprecated-fun bot-addcommand bot:addcommand)
 (_deprecated-fun bot-delcommand bot:delcommand)
 (_deprecated-fun bot-addhook bot:addhook)
 (_deprecated-fun bot-addtimer bot:addtimer)
 (_deprecated-fun bot-deltimer bot:deltimer)
 
 (define-public hooks/leave hooks/part))
Commit	Line	Data
ce02032f	1	;;; This file is automatically loaded by Bobot++. This is required for
ce02032f	2	;;; the bot to function.
6e78bd19	3
	4	;;; This file is covered by the GPL version 2 or (at your option) any
	5	;;; later version
	6
ce02032f	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)
6e78bd19	11
c1ea3a86	12	(use-modules (srfi srfi-1)
c1ea3a86	13	(srfi srfi-13))
c7d9fb19	14
ce02032f	15	(define-public %bot:loadpath (list
	16	(string-append (getenv "HOME")
	17	"/.bobotpp/scripts/")
	18	bot:sys-scripts-dir))
eb3864fb	19
ce02032f	20	(define-public %bot:load-extensions %load-extensions)
6e78bd19	21
c7d9fb19	22	;;; bot:log: Write as many messages as you want to the log. If the
ce02032f	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)
133eff7a	29	(display (x) (bot:logport))
133eff7a	30	(display x (bot:logport))))
c7d9fb19	31	messages)
ce02032f	32	(bot:flushport))
6e78bd19	33
ce02032f	34	(define-public (bot:load file)
ce02032f	35	(let path-loop ((load-path %bot:loadpath))
3d05febb	36	(cond ((not (null? load-path))
	37	(if (not
	38	(let ext-loop ((extensions %bot:load-extensions))
55f2215d	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))))
3d05febb	52	(path-loop (cdr load-path))))
	53	(else
	54	(begin (bot:log "ERROR: File " file " Not Found!\n") #f)))))
ce02032f	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
6e78bd19	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
ce02032f	84	(define-public (bot:match-not-channel regex)
db098a03	85	(string-append "^[[:graph:]][&#+!][^ ,\a]+ [[:graph:][:space:]]"
528799bd	86	regex))
6e78bd19	87
	88	;;; match-to-me matches text that was addressed to the bot with a
	89	;;; ':',',', or nothing after the bot name
db098a03	90
db098a03	91	;(define-public (bot:match-to-me r) r)
ce02032f	92	(define-public (bot:match-to-me regex)
ce02032f	93	(string-append (bot:match-not-channel (bot:getnickname))
6e78bd19	94	"[[:space:][:graph:]]*" regex))
6e78bd19	95
db098a03	96	(define-public (bot:sent-to-me? message)
4edefeb6	97	(let ((to-me (make-regexp (bot:match-to-me ""))))
db098a03	98	(if (regexp-exec to-me message) #t #f)))
4edefeb6	99
6e78bd19	100	;;;; string-utils
ce02032f	101	(define-public str-app string-append) ; shorter
6e78bd19	102
	103	;;; Message sending utils
	104
c7d9fb19	105	;;; Returns the CTCP quoted message
	106	;;; Input _MUST NOT_ contain the trailing \r\n
	107	;;; (it is added by the message sending code)
029f60d9	108	(define-public (bot:ctcp-quote message)
c7d9fb19	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)
528799bd	114	((#o134) (string (integer->char #o134) (integer->char
528799bd	115	#o134)))
c7d9fb19	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)))))))
c1ea3a86	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))
c7d9fb19	152
c1ea3a86	153	(define-public (bot:channel-user-ircop? cu)
c1ea3a86	154	(bot:channel-user-has-modes? cu bot:mode/op))
6e78bd19	155
	156	;;; DEPRECATED FUNCTION NAMES
	157	;;; These are provided for backwards compatibility
c7d9fb19	158	;;; and will be removed in the 3.0 release
ae97d6ec	159	(begin-deprecated
	160
	161	(define-macro (_deprecated-fun old-name new-name)
	162	`(define-public ,old-name
	163	(lambda args
2427f0c9	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))))
ae97d6ec	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))