;;; Testbot - A simple IRC bot.
;;; Author: Martin Bishop
;;; Requires: cl-irc, cl-ppcre, and trivial-sockets.
;;; Usage: (start-testbot "nick" "server" "channel")

(defpackage :testbot (:use :common-lisp :irc :cl-ppcre :trivial-sockets) (:export :start-testbot 
											 :die-testbot
											 :bot-say))
(in-package :testbot)

(defvar *connection*)
(defvar *nickname*)
(defparameter *tld-list* nil)
(defparameter *tld-file* "/home/martin/stuff/tld.txt")
(defparameter *quote-db* nil)
(defparameter *quote-file* "/home/martin/stuff/quotes.txt")
(defparameter *help-desc* '(("date" . "Display the date.")
                            ("time" . "Display the time in UTC.")
                            ("help" . "Get help about the command entered, or display all possible commands.")
                            ("eightball" . "Ask it a yes or no question, and recieve an answer.")
                            ("ping" . "Pong!")
                            ("chant" . "Repeat a given word 3 times in capital letters.")
                            ("google" . "Google the word or phrase and return the first URL.")
                            ("quote" . "Without an argument, return a random quote, or display the quote for the number.")
                            ("tld" . "Given a TLD in the form `.xx`, return the associated domain.")
                            ("rtld" . "Given a domain like `Japan`, return the associated TLD.")))
(defparameter *last-use* 0 "Used to keep track of the time of the last command the bot was issued.")
(defparameter *8-ball* '("Yes" "No" "Nope" "Sure" "How should I know?" "Doubtful" "Definitely"))

(defun lookup-list (item list)
  "Look for the name, return the tld."
  (second (assoc item list :test #'string-equal)))

(defun reverse-lookup-list (item list)
  "Look for tld, return name."
  (first (rassoc item list :test #'string-equal :key #'car)))

(defun bot-say (channel message)
  "For making the bot say whatever you like."
  (privmsg *connection* channel message))

(defun google (query)
  "Request 'query' from Google, return the URL recieved, if any.  Thanks to BillC for most of this code."
  (setf query (substitute #\+ #\Space query))
  (with-open-stream (stream (open-stream "www.google.com" 80))
    (format stream "GET /search?q=~A&btnI=lucky HTTP/1.0 Host: www.google.com~%~%" query)
    (force-output stream)
    (loop
       (let ((read (read-line stream nil nil)))
	 (unless read (return (format nil "No results or Google did not respond.")))
	 (when (> (mismatch read "Location: ") 9)
	   (return (subseq read 10 (position (code-char 13) read :from-end t))))))))

(defun print-the-time ()
  "Print the time in the format 'Hours:Minutes'.  Uses 24 hour time."
  (multiple-value-bind (sec minute hour day month year dow dst-p tz) (get-decoded-time)
    (declare (ignore sec day month year dow))
    (if dst-p
	(format nil "The time now is ~2,'0d:~2,'0d UTC" (+ hour (- tz 1)) minute)
	(format nil "The time now is ~2,'0d:~2,'0d UTC" (+ hour tz) minute))))

(defun print-the-date ()
  "Print the date in the format 'Month/Day/Year'."
  (multiple-value-bind (sec minute hour day month year) (get-decoded-time)
    (declare (ignore sec minute hour))
    (format nil "The date today is ~2,'0D/~2,'0D/~4,'0D." month day year)))

(defun random-elt (list)
  (elt list (random (length list))))

(defun eightball ()
  "Return a random answer to a question"
  (random-elt *8-ball*))

(defun quote-db ()
  "Read in the file *quote-file* and store it in *quote-db*"
  (with-open-file (quote *quote-file* :direction :input)
      (setf *quote-db* (read quote))))

(defun tld-list ()
  "Read in the file *tld-file* and store it in *tld-list*"
  (with-open-file (tld *tld-file* :direction :input)
    (setf *tld-list* (read tld))))

(defun lookup-quote (num-str)
  "Look up a quote by number."
  (let ((num (parse-integer num-str :junk-allowed t)))
    (or (cdr (assoc num *quote-db*))
        "No quote for that number.")))

(defun random-quote ()
  "Return a random quote."
  (let ((item (random-elt *quote-db*)))
    (format nil "#~A: ~A" (car item) (cdr item))))

(defun chant (word)
  "Repeat word in capital letters 3 times."
  (format nil "~A ~A ~A" (string-upcase word) (string-upcase word) (string-upcase word)))

(defun show-help ()
  "Display all the supported commands."
  (format nil "All commands are prefixed with a `,`  The possible commands are ~{\"~A\"~^, ~}." (mapcar #'car *help-desc*)))

(defun lookup-help (help)
  "Look up the help text for the command `help`."
  (or (cdr (assoc help *help-desc* :test #'string-equal))
      "No such command, or no help available."))

(defun msg-hook (message)
  (let ((dest (if (string-equal (first (arguments message)) *nickname*)
		  (source message)
		  (first (arguments message))))
	(reply (or (if (scan "^,date(\\s|$)*" (trailing-argument message)) (print-the-date))
		   (if (scan "^,time(\\s|$)*" (trailing-argument message)) (print-the-time))
		   (if (scan "^,eightball\\s(\\w+)" (trailing-argument message)) (eightball))
		   (if (scan "^,ping(\\s|$)*" (trailing-argument message)) "Pong")
                   (if (scan "^,chant\\s(\\w+)" (trailing-argument message)) (chant (subseq (trailing-argument message) 7)))
		   (if (scan "^,google\\s(\\w+)" (trailing-argument message)) (google (subseq (trailing-argument message) 8)))
                   (if (scan "^,quote$" (trailing-argument message)) (random-quote))
                   (if (scan "^,quote\\s(\\d+$)" (trailing-argument message)) (lookup-quote (subseq (trailing-argument message) 7)))
                   (if (scan "^,help$" (trailing-argument message)) (show-help))
                   (if (scan "^,help\\s(\\w+$)" (trailing-argument message)) (lookup-help (subseq (trailing-argument message) 6)))
		   (if (scan "^,tld\\s" (trailing-argument message))
		       (let ((result (lookup-list (subseq (trailing-argument message) 5) *tld-list*)))
			 (if result
			     result
			     (format nil "No match."))))
		   (if (scan "^,rtld\\s" (trailing-argument message))
		       (let ((result (reverse-lookup-list (subseq (trailing-argument message) 6) *tld-list*)))
			 (if result
			     result
			     (format nil "No match."))))
		   )))

    (when reply
      (if (> (- (get-universal-time) 2) *last-use*)
	  (progn
	    (setf *last-use* (get-universal-time))
	    (privmsg *connection* dest (format nil "~A" reply)))))))

(defun die-testbot (&optional (message "Lisp!"))
  "Function to kill the bot, with optional quit message."
  (quit *connection* message))

(defun start-testbot (nick server channel)
  "Function to start the bot."
  (setf *nickname* nick)
  (quote-db)
  (tld-list)
  (setf *connection* (connect :nickname *nickname* :server server))
  (join *connection* channel)
  (add-hook *connection* 'irc::irc-privmsg-message 'msg-hook)
  (start-background-message-handler *connection*))