diff --git a/extra/irc/client/authors.txt b/extra/irc/client/authors.txt index 5674120196..8421e8b778 100644 --- a/extra/irc/client/authors.txt +++ b/extra/irc/client/authors.txt @@ -1,2 +1,3 @@ +Bruno Deferrari Doug Coleman Slava Pestov diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor index 304ab25402..24a753d615 100644 --- a/extra/irc/client/client-tests.factor +++ b/extra/irc/client/client-tests.factor @@ -1,7 +1,8 @@ USING: kernel tools.test accessors arrays sequences qualified io.streams.string io.streams.duplex namespaces threads - calendar irc.client.private ; + calendar irc.client.private concurrency.mailboxes classes ; EXCLUDE: irc.client => join ; +RENAME: join irc.client => join_ IN: irc.client.tests ! Utilities @@ -64,13 +65,16 @@ privmsg new [ connect-irc ] keep 1 seconds sleep nick>> name>> ] unit-test -! TODO: Channel join messages -! { ":factorbot!n=factorbo@some.where JOIN :#factortest" -! ":ircserver.net MODE #factortest +ns" -! ":ircserver.net 353 factorbot @ #factortest :@factorbot " -! ":ircserver.net 366 factorbot #factortest :End of /NAMES list." -! ":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah" -! } make-client dup "factorbot" set-nick +{ join_ "#factortest" } [ + { ":factorbot!n=factorbo@some.where JOIN :#factortest" + ":ircserver.net MODE #factortest +ns" + ":ircserver.net 353 factorbot @ #factortest :@factorbot " + ":ircserver.net 366 factorbot #factortest :End of /NAMES list." + ":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah" + } make-client dup "factorbot" set-nick + [ connect-irc ] keep 1 seconds sleep + join-messages>> 5 seconds mailbox-get-timeout + [ class ] [ trailing>> ] bi ] unit-test ! TODO: user join ! ":somedude!n=user@isp.net JOIN :#factortest" ! TODO: channel message diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index e633f140fb..5b8fbf62ee 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2007 Doug Coleman, Slava Pestov. +! Copyright (C) 2008 Bruno Deferrari, Doug Coleman, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays combinators concurrency.mailboxes fry io strings +USING: combinators concurrency.mailboxes fry io strings io.encodings.8-bit io.sockets kernel namespaces sequences - sequences.lib splitting threads calendar classes.tuple + splitting threads calendar classes.tuple classes ascii assocs accessors destructors continuations ; IN: irc.client @@ -33,7 +33,6 @@ TUPLE: irc-listener in-messages out-messages ; TUPLE: irc-server-listener < irc-listener ; TUPLE: irc-channel-listener < irc-listener name password timeout ; TUPLE: irc-nick-listener < irc-listener name ; -UNION: irc-named-listener irc-nick-listener irc-channel-listener ; : ( -- irc-listener ) irc-listener boa ; @@ -78,13 +77,19 @@ TUPLE: unhandled < irc-message ; ( -- irc-client ) current-irc-client get ; : irc-stream> ( -- stream ) irc> stream>> ; : irc-write ( s -- ) irc-stream> stream-write ; : irc-print ( s -- ) irc-stream> [ stream-print ] keep stream-flush ; +: listener> ( name -- listener/f ) irc> listeners>> at ; +: unregister-listener ( name -- ) irc> listeners>> delete-at ; + +: to-listener ( message name -- ) + listener> [ f listener> ] unless* + [ in-messages>> mailbox-put ] [ drop ] if* ; ! ====================================== ! IRC client messages @@ -188,8 +193,7 @@ TUPLE: unhandled < irc-message ; GENERIC: handle-incoming-irc ( irc-message -- ) M: irc-message handle-incoming-irc ( irc-message -- ) - f irc> listeners>> at - [ in-messages>> mailbox-put ] [ drop ] if* ; + f listener> [ in-messages>> mailbox-put ] [ drop ] if* ; M: logged-in handle-incoming-irc ( logged-in -- ) name>> irc> nick>> (>>name) ; @@ -201,11 +205,15 @@ M: nick-in-use handle-incoming-irc ( nick-in-use -- ) name>> "_" append /NICK ; M: privmsg handle-incoming-irc ( privmsg -- ) - dup irc-message-origin irc> listeners>> [ at ] keep - '[ f , at ] unless* [ in-messages>> mailbox-put ] [ drop ] if* ; + dup irc-message-origin to-listener ; M: join handle-incoming-irc ( join -- ) - irc> join-messages>> mailbox-put ; + dup trailing>> listener> + [ irc> join-messages>> ] unless* mailbox-put ; + +M: kick handle-incoming-irc ( kick -- ) + [ ] [ channel>> ] [ who>> ] tri me? [ dup unregister-listener ] when + to-listener ; M: irc-broadcasted-message handle-incoming-irc ( irc-broadcasted-message -- ) broadcast-message-to-listeners ; @@ -326,6 +334,5 @@ PRIVATE> spawn-irc ] with-variable ; -GENERIC: add-listener ( irc-client irc-listener -- ) -M: irc-listener add-listener ( irc-client irc-listener -- ) - current-irc-client swap '[ , (add-listener) ] with-variable ; +: add-listener ( irc-listener irc-client -- ) + current-irc-client rot '[ , (add-listener) ] with-variable ;