Permalink
Browse files

wip

  • Loading branch information...
1 parent 5690be7 commit b49dd28da832890500fb15e37bd8d189825c0687 @hiredman committed Nov 2, 2013
Showing with 168 additions and 125 deletions.
  1. +9 −11 clojurebot-irc/project.clj
  2. +1 −0 clojurebot-irc/resources/config.clj
  3. +158 −114 clojurebot-irc/src/clojurebot/irc.clj
View
@@ -3,14 +3,12 @@
:url "http://example.com/FIXME"
:license {:name "Eclipse Public License"
:url "http://www.eclipse.org/legal/epl-v10.html"}
- :repositories {"jboss4" "http://repository.jboss.org/nexus/content/groups/public-jboss/"
- "hornetq" "http://hornetq.s3.amazonaws.com/"}
- :exclusions [commons-logging]
- :dependencies [[org.clojure/clojure "1.4.0"]
- [pircbot/pircbot "1.4.2"]
- [vespa-crabro "0.2.0"]
- [org.clojure/tools.logging "0.2.6"]
- [ch.qos.logback/logback-classic "1.0.9"]
- [ch.qos.logback/logback-core "1.0.9"]]
- :main clojurebot.irc
- :aot #{clojurebot.irc})
+ :dependencies [[org.clojure/clojure "1.5.1"]
+ [clj-http "0.7.2"]
+ [sonian/carica "1.0.2"]
+ [net.intensivesystems/conduit "0.7.0-SNAPSHOT"]
+ [org.clojure/tools.logging "0.2.6"]]
+ :profiles {:dev {:exclusions [commons-logging]
+ :dependencies [[ch.qos.logback/logback-classic "1.0.9"]
+ [ch.qos.logback/logback-core "1.0.9"]
+ [org.slf4j/jcl-over-slf4j "1.7.2"]]}})
@@ -0,0 +1 @@
+{}
@@ -1,119 +1,163 @@
+;; a slight rewrite of conduit-irc
(ns clojurebot.irc
- (:require [vespa.crabro :as vc]
- [vespa.protocols :as p]
+ (:require [clj-http.client :as http]
+ [conduit.core :refer :all]
+ [clojure.edn :as edn]
[clojure.tools.logging :as log])
- (:import (org.jibble.pircbot PircBot))
- (:gen-class))
-
-(defn wall-hack-method [class-name name- params obj & args]
- (-> class-name (.getDeclaredMethod (name name-) (into-array Class params))
- (doto (.setAccessible true))
- (.invoke obj (into-array Object args))))
-
-(defn pircbot [server nick fun]
- (let [connector (if (coll? server)
- (fn [conn]
- (let [[server port pass] server]
- (.connect conn server port pass)))
- #(.connect % server))
+ (:import (java.util.concurrent LinkedBlockingQueue)
+ (java.io Closeable)
+ (clojure.lang IDeref
+ Named)))
+
+(defn url [bits]
+ (apply str (interpose \/ bits)))
+
+(def ^{:dynamic true} *pircbot* nil)
+
+(defn- reply-fn [f]
+ (partial (fn irc-reply-fn [f value]
+ (let [[[new-value] new-f] (f value)]
+ [[] (partial irc-reply-fn new-f)]))
+ f))
+
+(defprotocol IRCBot
+ (get-channels [b])
+ (join-channel [b channel])
+ (-send-message [b recipient line])
+ (-send-action [b recipient line])
+ (-send-notice [b recipient line]))
+
+(defn declare-joined [channel]
+ (when-not (contains? (set (get-channels *pircbot*)) channel)
+ (join-channel *pircbot* channel)))
+
+(defn target-type [msg recipient]
+ (if (.startsWith recipient "#")
+ :channel
+ :privmsg))
+
+(defmacro defirc [fn-name method-name]
+ `(do
+ (defmulti ~fn-name target-type)
+ (defmethod ~fn-name :channel [msg# recipient#]
+ (declare-joined recipient#)
+ (doseq [line# (.split msg# "\n")]
+ (~method-name *pircbot* recipient# line#)))
+ (defmethod ~fn-name :privmsg [msg# recipient#]
+ (doseq [line# (.split msg# "\n")]
+ (~method-name *pircbot* recipient# line#)))))
+
+(defirc send-message -send-message)
+
+(defirc send-action -send-action)
+
+(defirc send-notice -send-notice)
+
+(defn pircbot [server nick]
+ (let [mq (LinkedBlockingQueue.)
+ bid (if (coll? server)
+ (let [[server port pass] server
+ [bid] (for [bot (edn/read-string
+ (:body (http/get (url))))
+ :when (= server (:server bot))
+ :when (= port (:port bot))
+ :when (= nick (:nick bot))]
+ (:com.thelastcitadel.irc/bid bot))]
+ (or
+ bid
+ (:body (http/post (url) {:form-params {:server server
+ :nick nick
+ :port port
+ :password pass}}))))
+ (let [[bid] (for [bot (edn/read-string
+ (:body (http/get (url))))
+ :when (= server (:server bot))
+ :when (= nick (:nick bot))]
+ (:com.thelastcitadel.irc/bid bot))]
+ (or bid
+ (http/post (url) {:form-params {:server server
+ :nick nick}}))))
+ fut (future
+ (while true
+ (Thread/sleep 1000)
+ (try
+ (doseq [[eid event] (edn/read-string (:body (http/get (url bid "events"))))]
+ (.put mq [nick [(:type event) event]])
+ (http/delete (url bid "events" bid)))
+ (catch Exception e
+ (log/error e "error")))))
server (if (coll? server) (first server) server)
- conn (proxy [PircBot] []
- (onConnect []
- (fun {:op :connect
- :server server
- :nick nick}))
- (onDisconnect []
- (fun {:op :disconnect
- :server server
- :nick nick}))
- (onMessage [channel sender login hostname message]
- (fun {:op :message
- :channel channel
- :sender sender
- :login login
- :hostname hostname
- :message message
- :server server}))
- (onAction [sender login hostname target action]
- (fun {:op :action
- :target target
- :sender sender
- :login login
- :hostname hostname
- :action action
- :message action
- :server server}))
- (onInvite [target-nick source-nick source-login source-hostname
- channel]
- (fun {:op :invite
- :target-nick target-nick
- :source-nick source-nick
- :source-login source-login
- :source-hostname source-hostname
- :channel channel
- :server server}))
- (onPrivateMessage [sender login hostname message]
- (fun {:op :private-message
- :sender sender
- :login login
- :hostname hostname
- :message message
- :server server}))
- (onJoin [channel sender login hostname]
- (fun {:op :join
- :sender sender
- :login login
- :hostname hostname
- :channel channel
- :server server}))
- (onPart [channel sender login hostname]
- (fun {:op :part
- :sender sender
- :login login
- :hostname hostname
- :channel channel
- :server server}))
- (onQuit [nick login hostname reason]
- (fun {:op :quit
- :nick nick
- :login login
- :hostname hostname
- :reason reason
- :server server}))
- (onVersion [nick login hostname target]
- (fun {:op :version
- :nick nick
- :login login
- :hostname hostname
- :target target
- :server server}))
- (close []
- (.disconnect this)))]
- (wall-hack-method
- org.jibble.pircbot.PircBot :setName [String] conn nick)
- (connector conn)
+ conn (reify
+ IRCBot
+ (get-channels [b]
+ (edn/read-string (:body (http/get (url bid "channels")))))
+ (join-channel [b channel]
+ ;; TODO: url encode channel
+ (http/post (url bid "channel" channel)))
+ Named
+ (getName [_]
+ nick)
+ IDeref
+ (deref [_]
+ mq)
+ Closeable
+ (close [_]
+ (try
+ (future-cancel fut)
+ (finally
+ (http/delete (url bid))))))]
conn))
-(defn -main [server nick queue-prefix]
- (let [mb (vc/message-bus)
- bot (pircbot server nick
- (fn [m]
- (log/debug m)
- (vc/send-to mb (str queue-prefix ".in") m)))]
- (while true
- (try
- (let [m (p/receive-from mb (str queue-prefix ".out") identity)]
- (case (:op m)
- :everyone-I-see
- (vc/send-to mb
- (:queue m)
- (into {} (for [channel (.getChannels bot)]
- [channel (map (comp :nick bean) (.getUsers bot channel))])))
- :action
- (.sendAction bot (:target m) (:action m))
- :invite
- (.sendInvite bot (:nick m) (:channel m))
- :message
- (.sendMessage bot (:target m) (:message m))
- :notice
- (.sendNotice bot (:target m) (:notice m))))))))
+(defn a-irc [nick proc]
+ (let [id nick]
+ (assoc proc
+ :type :irc
+ :parts (assoc (:parts proc)
+ id {:type :irc
+ id (reply-fn (:reply proc))}))))
+
+(defn join [channels]
+ (doseq [channel channels]
+ (println channel)
+ (join-channel *pircbot* channel)))
+
+(defn irc-run
+ "start a single thread executing a proc"
+ [proc & [channel-or-exception-handler & channels]]
+ (let [funs (get-in proc [:parts (name *pircbot*)])]
+ (join
+ (if (fn? channel-or-exception-handler)
+ channels
+ (conj channels channel-or-exception-handler)))
+ (letfn [(next-msg [Q]
+ (fn next-msg-inner [_]
+ [[(.take Q)] next-msg-inner]))
+ (handle-msg [fun msg]
+ (try
+ (let [[_ new-fn] (fun msg)]
+ [[] (partial handle-msg new-fn)])
+ (catch Exception e
+ (if (fn? channel-or-exception-handler)
+ (channel-or-exception-handler e)
+ (.printStackTrace e))
+ [[] fun])))
+ (run []
+ (->> [(next-msg @*pircbot*)
+ (partial handle-msg (partial select-fn funs))]
+ (reduce comp-fn)
+ (a-run)
+ (dorun)))]
+ (run))))
+
+(comment
+
+ (with-open [p (pircbot "irc.freenode.net" "conduitbot11")]
+ (binding [*pircbot* p]
+ (irc-run
+ (a-irc "conduitbot11"
+ (a-arr
+ (fn [[t m]]
+ (println t (dissoc m :bot)))))
+ "#clojurebot")))
+
+ )

0 comments on commit b49dd28

Please sign in to comment.