Merge branch 'irc' of git://tiodante.com/git/factor

extra/irc/client/internals/internals.factor

@@ -45,11 +45,11 @@ M: sequence chat-put [ chat-put ] with each ;
 
 ! Server message handling
 
-GENERIC: forward-message ( irc-message -- )
+GENERIC: message-forwards ( irc-message -- seq )
-M: irc-message   forward-message +server-chat+ chat-put ;
+M: irc-message   message-forwards drop +server-chat+ ;
-M: to-one-chat   forward-message dup chat> chat-put ;
+M: to-one-chat   message-forwards chat> ;
-M: to-all-chats  forward-message chats> chat-put ;
+M: to-all-chats  message-forwards drop chats> ;
-M: to-many-chats forward-message dup sender>> participant-chats chat-put ;
+M: to-many-chats message-forwards sender>> participant-chats ;
 
 GENERIC: process-message ( irc-message -- )
 M: object process-message drop ; 
@@ -91,7 +91,7 @@ M: irc-message handle-outgoing-irc irc-message>string irc-print t ;
 : handle-reader-message ( irc-message -- ) irc> in-messages>> mailbox-put ;
 
 : (handle-disconnect) ( -- )
-    irc> in-messages>> irc-disconnected swap mailbox-put
+    irc-disconnected irc> in-messages>> mailbox-put
     irc> reconnect-time>> sleep
     (connect-irc)
     (do-login) ;
@@ -113,8 +113,12 @@ M: f      handle-input handle-disconnect ;
 ! Processing loops
 
 : in-multiplexer-loop ( -- ? )
-    irc> in-messages>> mailbox-get
+    irc> in-messages>> mailbox-get {
-    [ process-message ] [ forward-message ] [ irc-end? not ] tri ;
+        [ message-forwards ]
+        [ process-message ]
+        [ swap chat-put ]
+        [ irc-end? not ]
+    } cleave ;
 
 : strings>privmsg ( name string -- privmsg )
     " :" prepend append "PRIVMSG " prepend string>irc-message ;

extra/irc/logbot/authors.txt

@@ -0,0 +1 @@
+Bruno Deferrari

extra/irc/logbot/log-line/authors.txt

@@ -0,0 +1 @@
+Bruno Deferrari

extra/irc/logbot/log-line/log-line.factor

@@ -0,0 +1,37 @@
+! Copyright (C) 2009 Bruno Deferrari.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors irc.messages irc.messages.base kernel make ;
+EXCLUDE: sequences => join ;
+IN: irc.logbot.log-line
+
+: dot-or-parens ( string -- string )
+    [ "." ] [ " (" prepend ")." append ] if-empty ;
+
+GENERIC: >log-line ( object -- line )
+
+M: irc-message >log-line line>> ;
+
+M: privmsg >log-line
+    [ "<" % dup sender>> % "> " % text>> % ] "" make ;
+
+M: join >log-line
+    [ "* " % sender>> % " has joined the channel." % ] "" make ;
+
+M: part >log-line
+    [ "* " % dup sender>> % " has left the channel" %
+      comment>> dot-or-parens % ] "" make ;
+
+M: quit >log-line
+    [ "* " % dup sender>> % " has quit" %
+      comment>> dot-or-parens % ] "" make ;
+
+M: kick >log-line
+    [ "* " % dup sender>> % " has kicked " % dup user>> %
+      " from the channel" % comment>> dot-or-parens % ] "" make ;
+
+M: participant-mode >log-line
+    [ "* " % dup sender>> % " has set mode " % dup mode>> %
+      " to " % parameter>> % ] "" make ;
+
+M: nick >log-line
+    [ "* " % dup sender>> % " is now known as " % nickname>> % ] "" make ;

extra/irc/logbot/log-line/summary.txt

@@ -0,0 +1 @@
+IRC message formatting for logs

extra/irc/logbot/logbot.factor

@@ -0,0 +1,56 @@
+! Copyright (C) 2009 Bruno Deferrari.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors calendar calendar.format destructors fry io io.encodings.8-bit
+io.files io.pathnames irc.client irc.client.chats irc.messages
+irc.messages.base kernel make namespaces sequences threads
+irc.logbot.log-line ;
+IN: irc.logbot
+
+CONSTANT: bot-channel "#concatenative"
+CONSTANT: log-directory "/tmp/logs"
+
+SYMBOL: current-day
+SYMBOL: current-stream
+
+: bot-profile ( -- obj )
+    "irc.freenode.org" 6667 "flogger" f <irc-profile> ;
+
+: add-timestamp ( string timestamp -- string )
+    timestamp>hms "[" prepend "] " append prepend ;
+
+: timestamp-path ( timestamp -- path )
+    timestamp>ymd ".log" append log-directory prepend-path ;
+
+: timestamp>stream ( timestamp  -- stream )
+    dup day-of-year current-day get = [
+        drop
+    ] [
+        current-stream get [ dispose ] when*
+        [ day-of-year current-day set ]
+        [ timestamp-path latin1 <file-writer> ] bi
+        current-stream set
+    ] if current-stream get ;
+
+: log-message ( string timestamp -- )
+    [ add-timestamp ] [ timestamp>stream ] bi
+    [ stream-print ] [ stream-flush ] bi ;
+
+GENERIC: handle-message ( msg -- )
+
+M: object      handle-message drop ;
+M: irc-message handle-message [ >log-line ] [ timestamp>> ] bi log-message ;
+
+: bot-loop ( chat -- ) dup hear handle-message bot-loop ;
+
+: start-bot ( -- )
+    bot-profile <irc-client>
+    [ connect-irc ]
+    [
+        [ bot-channel <irc-channel-chat> ] dip
+        '[ _ [ _ attach-chat ] [ bot-loop ] bi ]
+        "LogBot" spawn drop
+    ] bi ;
+
+: logbot ( -- ) start-bot ;
+
+MAIN: logbot

extra/irc/logbot/summary.txt

@@ -0,0 +1 @@
+An IRC logging bot

extra/irc/messages/messages.factor

@@ -7,7 +7,7 @@ IN: irc.messages
 
 ! connection
 IRC: pass        "PASS"    password ;
-IRC: nick        "NICK"    nickname ;
+IRC: nick        "NICK"    : nickname ;
 IRC: user        "USER"    user mode _ : realname ;
 IRC: oper        "OPER"    name password ;
 IRC: mode        "MODE"    name mode parameter ;