From a1ac7a5c019f2dfa8df2baf795681faed2480bbb Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Sat, 12 Jul 2008 00:46:05 -0300 Subject: [PATCH 01/10] irc.client: Add participant mode symbols --- extra/irc/client/client.factor | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 2dbbe8b8f5..65dc2fa017 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -31,6 +31,15 @@ TUPLE: irc-channel-listener < irc-listener name password timeout participants ; TUPLE: irc-nick-listener < irc-listener name ; SYMBOL: +server-listener+ +! participant modes +SYMBOL: +operator+ +SYMBOL: +voice+ +SYMBOL: +normal+ + +: participant-mode ( n -- assoc ) + H{ { 64 +operator+ } { 43 +voice+ } { 0 +normal+ } } at ; + +! listener objects : ( -- irc-listener ) irc-listener boa ; : ( -- irc-server-listener ) @@ -182,7 +191,7 @@ M: quit handle-incoming-irc ( quit -- ) call-next-method ; : >nick/mode ( string -- nick mode ) - dup first "+@" member? [ unclip ] [ f ] if ; + dup first "+@" member? [ unclip ] [ 0 ] if participant-mode ; : names-reply>participants ( names-reply -- participants ) trailing>> [ blank? ] trim " " split From 7a09b4aed3e8f428fe31040de143f0b07bfdaaa5 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Mon, 14 Jul 2008 21:39:52 -0300 Subject: [PATCH 02/10] irc.client: Add make-client-messages, move things around, etc --- extra/irc/client/client-tests.factor | 24 +-------------- extra/irc/messages/messages-tests.factor | 37 ++++++++++++++++++++++++ extra/irc/messages/messages.factor | 7 ++++- 3 files changed, 44 insertions(+), 24 deletions(-) create mode 100644 extra/irc/messages/messages-tests.factor diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor index 2883e47b81..2a1db8c22f 100644 --- a/extra/irc/client/client-tests.factor +++ b/extra/irc/client/client-tests.factor @@ -20,28 +20,6 @@ IN: irc.client.tests : with-dummy-client ( quot -- ) rot with-variable ; inline -! Parsing tests -irc-message new - ":someuser!n=user@some.where PRIVMSG #factortest :hi" >>line - "someuser!n=user@some.where" >>prefix - "PRIVMSG" >>command - { "#factortest" } >>parameters - "hi" >>trailing -1array -[ ":someuser!n=user@some.where PRIVMSG #factortest :hi" - string>irc-message f >>timestamp ] unit-test - -privmsg new - ":someuser!n=user@some.where PRIVMSG #factortest :hi" >>line - "someuser!n=user@some.where" >>prefix - "PRIVMSG" >>command - { "#factortest" } >>parameters - "hi" >>trailing - "#factortest" >>name -1array -[ ":someuser!n=user@some.where PRIVMSG #factortest :hi" - parse-irc-line f >>timestamp ] unit-test - { "" } make-client dup "factorbot" set-nick current-irc-client [ { t } [ irc> profile>> nickname>> me? ] unit-test @@ -67,7 +45,7 @@ privmsg new profile>> nickname>> ] unit-test { join_ "#factortest" } [ - { ":factorbot!n=factorbo@some.where 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." diff --git a/extra/irc/messages/messages-tests.factor b/extra/irc/messages/messages-tests.factor new file mode 100644 index 0000000000..1bd6088f82 --- /dev/null +++ b/extra/irc/messages/messages-tests.factor @@ -0,0 +1,37 @@ +USING: kernel tools.test accessors arrays qualified + irc.messages irc.messages.private ; +EXCLUDE: sequences => join ; +IN: irc.messages.tests + +! Parsing tests +irc-message new + ":someuser!n=user@some.where PRIVMSG #factortest :hi" >>line + "someuser!n=user@some.where" >>prefix + "PRIVMSG" >>command + { "#factortest" } >>parameters + "hi" >>trailing +1array +[ ":someuser!n=user@some.where PRIVMSG #factortest :hi" + string>irc-message f >>timestamp ] unit-test + +privmsg new + ":someuser!n=user@some.where PRIVMSG #factortest :hi" >>line + "someuser!n=user@some.where" >>prefix + "PRIVMSG" >>command + { "#factortest" } >>parameters + "hi" >>trailing + "#factortest" >>name +1array +[ ":someuser!n=user@some.where PRIVMSG #factortest :hi" + parse-irc-line f >>timestamp ] unit-test + +join new + ":someuser!n=user@some.where JOIN :#factortest" >>line + "someuser!n=user@some.where" >>prefix + "JOIN" >>command + { } >>parameters + "#factortest" >>trailing +1array +[ ":someuser!n=user@some.where JOIN :#factortest" + parse-irc-line f >>timestamp ] unit-test + diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index 205630d790..24e09467b7 100644 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -21,6 +21,10 @@ TUPLE: mode < irc-message name channel mode ; TUPLE: names-reply < irc-message who = channel ; TUPLE: unhandled < irc-message ; +: make-client-message ( command parameters trailing -- irc-message ) + irc-message new now >>timestamp + [ [ (>>trailing) ] [ (>>parameters) ] [ (>>command) ] tri ] keep ; + GENERIC: irc-message>client-line ( irc-message -- string ) M: irc-message irc-message>client-line ( irc-message -- string ) @@ -58,6 +62,8 @@ M: irc-message irc-message>server-line ( irc-message -- string ) : split-trailing ( string -- string string/f ) ":" split1 ; +PRIVATE> + : string>irc-message ( string -- object ) dup split-prefix split-trailing [ [ blank? ] trim " " split unclip swap ] dip @@ -82,4 +88,3 @@ M: irc-message irc-message>server-line ( irc-message -- string ) [ [ tuple-slots ] [ parameters>> ] bi append ] dip [ all-slots over [ length ] bi@ min head ] keep slots>tuple ; -PRIVATE> From 22b67ed3783242f2f89bf051f650e00c97a86f39 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Mon, 14 Jul 2008 21:43:42 -0300 Subject: [PATCH 03/10] irc.client: Rename client message construcor, handle outgoing plain irc-messages. --- extra/irc/client/client.factor | 4 ++-- extra/irc/messages/messages.factor | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 65dc2fa017..c1cf2e844c 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -209,8 +209,8 @@ M: irc-broadcasted-message handle-incoming-irc ( irc-broadcasted-message -- ) GENERIC: handle-outgoing-irc ( obj -- ) -! M: irc-message handle-outgoing-irc ( irc-message -- ) -! irc-message>string irc-print ; +M: irc-message handle-outgoing-irc ( irc-message -- ) + irc-message>client-line irc-print ; M: privmsg handle-outgoing-irc ( privmsg -- ) [ name>> ] [ trailing>> ] bi /PRIVMSG ; diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index 24e09467b7..1d4fb5b239 100644 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -21,7 +21,7 @@ TUPLE: mode < irc-message name channel mode ; TUPLE: names-reply < irc-message who = channel ; TUPLE: unhandled < irc-message ; -: make-client-message ( command parameters trailing -- irc-message ) +: ( command parameters trailing -- irc-message ) irc-message new now >>timestamp [ [ (>>trailing) ] [ (>>parameters) ] [ (>>command) ] tri ] keep ; From 38e31b85c9a00a2ddc73626ce9bdc185af447c25 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Fri, 11 Jul 2008 01:16:15 -0300 Subject: [PATCH 04/10] irc.client: Handling of lists of participants in channels, fixes. --- extra/irc/client/client.factor | 45 +++++++++++++++++++++++------- extra/irc/messages/messages.factor | 4 ++- 2 files changed, 38 insertions(+), 11 deletions(-) diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 472805f5ae..7ab0ea1ab1 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -2,8 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: concurrency.mailboxes kernel io.sockets io.encodings.8-bit calendar accessors destructors namespaces io assocs arrays qualified fry - continuations threads strings classes combinators - irc.messages irc.messages.private ; + continuations threads strings classes combinators splitting hashtables + ascii irc.messages irc.messages.private ; RENAME: join sequences => sjoin EXCLUDE: sequences => join ; IN: irc.client @@ -27,7 +27,7 @@ TUPLE: irc-client profile stream in-messages out-messages join-messages TUPLE: irc-listener in-messages out-messages ; TUPLE: irc-server-listener < irc-listener ; -TUPLE: irc-channel-listener < irc-listener name password timeout ; +TUPLE: irc-channel-listener < irc-listener name password timeout participants ; TUPLE: irc-nick-listener < irc-listener name ; SYMBOL: +server-listener+ @@ -37,7 +37,7 @@ SYMBOL: +server-listener+ irc-server-listener boa ; : ( name -- irc-channel-listener ) - rot f 60 seconds irc-channel-listener boa ; + rot f 60 seconds H{ } clone irc-channel-listener boa ; : ( name -- irc-nick-listener ) rot irc-nick-listener boa ; @@ -74,6 +74,18 @@ UNION: irc-broadcasted-message irc-end irc-disconnected irc-connected ; listener> [ +server-listener+ listener> ] unless* [ in-messages>> mailbox-put ] [ drop ] if* ; +: remove-participant ( nick channel -- ) + listener> [ participants>> delete-at ] [ drop ] if* ; + +: add-participant ( nick mode channel -- ) + listener> [ participants>> set-at ] [ 2drop ] if* ; + +DEFER: me? + +: maybe-forward-join ( join -- ) + [ prefix>> parse-name me? ] keep and + [ irc> join-messages>> mailbox-put ] when* ; + ! ====================================== ! IRC client messages ! ====================================== @@ -153,17 +165,30 @@ M: privmsg handle-incoming-irc ( privmsg -- ) dup irc-message-origin to-listener ; M: join handle-incoming-irc ( join -- ) - [ [ prefix>> parse-name me? ] keep and - [ irc> join-messages>> mailbox-put ] when* ] + [ maybe-forward-join ] [ dup trailing>> to-listener ] - bi ; + [ [ drop f ] [ prefix>> parse-name ] [ trailing>> ] tri add-participant ] + tri ; M: part handle-incoming-irc ( part -- ) - dup channel>> to-listener ; + [ dup channel>> to-listener ] keep + [ prefix>> parse-name ] [ channel>> ] bi remove-participant ; M: kick handle-incoming-irc ( kick -- ) - [ ] [ channel>> ] [ who>> ] tri me? [ dup unregister-listener ] when - to-listener ; + [ [ ] [ channel>> ] bi to-listener ] + [ [ who>> ] [ channel>> ] bi remove-participant ] + [ [ ] [ who>> ] bi me? [ unregister-listener ] [ drop ] if ] + tri ; + +: >nick/mode ( string -- nick mode ) + dup first "+@" member? [ unclip ] [ f ] if ; + +: names-reply>participants ( names-reply -- participants ) + trailing>> [ blank? ] trim " " split + [ >nick/mode 2array ] map >hashtable ; + +M: names-reply handle-incoming-irc ( names-reply -- ) + [ names-reply>participants ] [ channel>> listener> ] bi (>>participants) ; M: irc-broadcasted-message handle-incoming-irc ( irc-broadcasted-message -- ) broadcast-message-to-listeners ; diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index f1beba9b26..fb41997b84 100644 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -7,7 +7,7 @@ IN: irc.messages TUPLE: irc-message line prefix command parameters trailing timestamp ; TUPLE: logged-in < irc-message name ; TUPLE: ping < irc-message ; -TUPLE: join < irc-message channel ; +TUPLE: join < irc-message ; TUPLE: part < irc-message channel ; TUPLE: quit < irc-message ; TUPLE: privmsg < irc-message name ; @@ -16,6 +16,7 @@ TUPLE: roomlist < irc-message channel names ; TUPLE: nick-in-use < irc-message asterisk name ; TUPLE: notice < irc-message type ; TUPLE: mode < irc-message name channel mode ; +TUPLE: names-reply < irc-message who = channel ; TUPLE: unhandled < irc-message ; Date: Fri, 11 Jul 2008 20:23:31 -0300 Subject: [PATCH 05/10] irc.client: Some little changes, and handling of quit messages (removes participant from channels, still needs to forward it) --- extra/irc/client/client.factor | 46 ++++++++++++++++-------------- extra/irc/messages/messages.factor | 18 ++++++++++-- 2 files changed, 40 insertions(+), 24 deletions(-) diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 7ab0ea1ab1..fb010dbc86 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -37,10 +37,10 @@ SYMBOL: +server-listener+ irc-server-listener boa ; : ( name -- irc-channel-listener ) - rot f 60 seconds H{ } clone irc-channel-listener boa ; + [ ] dip f 60 seconds H{ } clone irc-channel-listener boa ; : ( name -- irc-nick-listener ) - rot irc-nick-listener boa ; + [ ] dip irc-nick-listener boa ; ! ====================================== ! Message objects @@ -52,8 +52,8 @@ SINGLETON: irc-connected ! sent when connection is established UNION: irc-broadcasted-message irc-end irc-disconnected irc-connected ; : terminate-irc ( irc-client -- ) - [ in-messages>> irc-end swap mailbox-put ] - [ f >>is-running drop ] + [ [ irc-end ] dip in-messages>> mailbox-put ] + [ [ f ] dip (>>is-running) ] [ stream>> dispose ] tri ; @@ -77,6 +77,11 @@ UNION: irc-broadcasted-message irc-end irc-disconnected irc-connected ; : remove-participant ( nick channel -- ) listener> [ participants>> delete-at ] [ drop ] if* ; +: remove-participant-from-all ( nick -- ) + irc> listeners>> + [ irc-channel-listener? [ swap remove-participant ] [ 2drop ] if ] with + assoc-each ; + : add-participant ( nick mode channel -- ) listener> [ participants>> set-at ] [ 2drop ] if* ; @@ -90,14 +95,6 @@ DEFER: me? ! IRC client messages ! ====================================== -GENERIC: irc-message>string ( irc-message -- string ) - -M: irc-message irc-message>string ( irc-message -- string ) - [ command>> ] - [ parameters>> " " sjoin ] - [ trailing>> dup [ CHAR: : prefix ] when ] - tri 3array " " sjoin ; - : /NICK ( nick -- ) "NICK " irc-write irc-print ; @@ -111,7 +108,7 @@ M: irc-message irc-message>string ( irc-message -- string ) : /JOIN ( channel password -- ) "JOIN " irc-write - [ " :" swap 3append ] when* irc-print ; + [ [ " :" ] dip 3append ] when* irc-print ; : /PART ( channel text -- ) [ "PART " irc-write irc-write ] dip @@ -175,11 +172,15 @@ M: part handle-incoming-irc ( part -- ) [ prefix>> parse-name ] [ channel>> ] bi remove-participant ; M: kick handle-incoming-irc ( kick -- ) - [ [ ] [ channel>> ] bi to-listener ] + [ dup channel>> to-listener ] [ [ who>> ] [ channel>> ] bi remove-participant ] - [ [ ] [ who>> ] bi me? [ unregister-listener ] [ drop ] if ] + [ dup who>> me? [ unregister-listener ] [ drop ] if ] tri ; +M: quit handle-incoming-irc ( quit -- ) + [ prefix>> parse-name remove-participant-from-all ] keep + call-next-method ; + : >nick/mode ( string -- nick mode ) dup first "+@" member? [ unclip ] [ f ] if ; @@ -213,8 +214,8 @@ M: part handle-outgoing-irc ( privmsg -- ) ! ====================================== : irc-mailbox-get ( mailbox quot -- ) - swap 5 seconds - '[ , , , mailbox-get-timeout swap call ] + [ 5 seconds ] dip + '[ , , , [ mailbox-get-timeout ] dip call ] [ drop ] recover ; inline : handle-reader-message ( irc-message -- ) @@ -224,11 +225,12 @@ DEFER: (connect-irc) : (handle-disconnect) ( -- ) irc> - [ in-messages>> irc-disconnected swap mailbox-put ] + [ [ irc-disconnected ] dip in-messages>> mailbox-put ] [ dup reconnect-time>> sleep (connect-irc) ] [ profile>> nickname>> /LOGIN ] tri ; +! FIXME: do something with the exception, store somewhere to help debugging : handle-disconnect ( error -- ) drop irc> is-running>> [ (handle-disconnect) ] when ; @@ -300,7 +302,7 @@ M: irc-nick-listener (add-listener) ( irc-nick-listener -- ) [ name>> ] keep set+run-listener ; M: irc-server-listener (add-listener) ( irc-server-listener -- ) - +server-listener+ swap set+run-listener ; + [ +server-listener+ ] dip set+run-listener ; GENERIC: (remove-listener) ( irc-listener -- ) @@ -309,7 +311,7 @@ M: irc-nick-listener (remove-listener) ( irc-nick-listener -- ) M: irc-channel-listener (remove-listener) ( irc-channel-listener -- ) [ [ out-messages>> ] [ name>> ] bi - \ part new swap >>channel mailbox-put ] keep + [ \ part new ] dip >>channel mailbox-put ] keep name>> unregister-listener ; M: irc-server-listener (remove-listener) ( irc-server-listener -- ) @@ -319,10 +321,10 @@ M: irc-server-listener (remove-listener) ( irc-server-listener -- ) [ profile>> [ server>> ] [ port>> ] bi /CONNECT ] keep swap >>stream t >>is-running - in-messages>> irc-connected swap mailbox-put ; + in-messages>> [ irc-connected ] dip mailbox-put ; : with-irc-client ( irc-client quot -- ) - >r current-irc-client r> with-variable ; inline + [ current-irc-client ] dip with-variable ; inline PRIVATE> diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index fb41997b84..205630d790 100644 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -1,7 +1,9 @@ ! Copyright (C) 2008 Bruno Deferrari ! See http://factorcode.org/license.txt for BSD license. -USING: kernel fry sequences splitting ascii calendar accessors combinators - classes.tuple math.order ; +USING: kernel fry splitting ascii calendar accessors combinators qualified + arrays classes.tuple math.order ; +RENAME: join sequences => sjoin +EXCLUDE: sequences => join ; IN: irc.messages TUPLE: irc-message line prefix command parameters trailing timestamp ; @@ -19,6 +21,18 @@ TUPLE: mode < irc-message name channel mode ; TUPLE: names-reply < irc-message who = channel ; TUPLE: unhandled < irc-message ; +GENERIC: irc-message>client-line ( irc-message -- string ) + +M: irc-message irc-message>client-line ( irc-message -- string ) + [ command>> ] + [ parameters>> " " sjoin ] + [ trailing>> dup [ CHAR: : prefix ] when ] + tri 3array " " sjoin ; + +GENERIC: irc-message>server-line ( irc-message -- string ) +M: irc-message irc-message>server-line ( irc-message -- string ) + drop "not implemented yet" ; + Date: Sat, 12 Jul 2008 00:04:39 -0300 Subject: [PATCH 06/10] irc.client: Fix, remove-listener now parts from channels correctly --- extra/irc/client/client.factor | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index fb010dbc86..2dbbe8b8f5 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -206,7 +206,7 @@ GENERIC: handle-outgoing-irc ( obj -- ) M: privmsg handle-outgoing-irc ( privmsg -- ) [ name>> ] [ trailing>> ] bi /PRIVMSG ; -M: part handle-outgoing-irc ( privmsg -- ) +M: part handle-outgoing-irc ( part -- ) [ channel>> ] [ trailing>> "" or ] bi /PART ; ! ====================================== @@ -263,6 +263,7 @@ DEFER: (connect-irc) { { [ dup string? ] [ strings>privmsg ] } { [ dup privmsg instance? ] [ swap >>name ] } + [ nip ] } cond ; : listener-loop ( name listener -- ) @@ -310,8 +311,8 @@ M: irc-nick-listener (remove-listener) ( irc-nick-listener -- ) name>> unregister-listener ; M: irc-channel-listener (remove-listener) ( irc-channel-listener -- ) - [ [ out-messages>> ] [ name>> ] bi - [ \ part new ] dip >>channel mailbox-put ] keep + [ [ name>> ] [ out-messages>> ] bi + [ [ part new ] dip >>channel ] dip mailbox-put ] keep name>> unregister-listener ; M: irc-server-listener (remove-listener) ( irc-server-listener -- ) From b7af781e580ca5694782dae7a161a8a0708c7464 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Sat, 12 Jul 2008 00:46:05 -0300 Subject: [PATCH 07/10] irc.client: Add participant mode symbols --- extra/irc/client/client.factor | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 2dbbe8b8f5..65dc2fa017 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -31,6 +31,15 @@ TUPLE: irc-channel-listener < irc-listener name password timeout participants ; TUPLE: irc-nick-listener < irc-listener name ; SYMBOL: +server-listener+ +! participant modes +SYMBOL: +operator+ +SYMBOL: +voice+ +SYMBOL: +normal+ + +: participant-mode ( n -- assoc ) + H{ { 64 +operator+ } { 43 +voice+ } { 0 +normal+ } } at ; + +! listener objects : ( -- irc-listener ) irc-listener boa ; : ( -- irc-server-listener ) @@ -182,7 +191,7 @@ M: quit handle-incoming-irc ( quit -- ) call-next-method ; : >nick/mode ( string -- nick mode ) - dup first "+@" member? [ unclip ] [ f ] if ; + dup first "+@" member? [ unclip ] [ 0 ] if participant-mode ; : names-reply>participants ( names-reply -- participants ) trailing>> [ blank? ] trim " " split From 66be27c186c30b3d062079411075237df8d59df9 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Mon, 14 Jul 2008 21:39:52 -0300 Subject: [PATCH 08/10] irc.client: Add make-client-messages, move things around, etc --- extra/irc/client/client-tests.factor | 24 +-------------- extra/irc/messages/messages-tests.factor | 37 ++++++++++++++++++++++++ extra/irc/messages/messages.factor | 7 ++++- 3 files changed, 44 insertions(+), 24 deletions(-) create mode 100644 extra/irc/messages/messages-tests.factor diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor index 2883e47b81..2a1db8c22f 100644 --- a/extra/irc/client/client-tests.factor +++ b/extra/irc/client/client-tests.factor @@ -20,28 +20,6 @@ IN: irc.client.tests : with-dummy-client ( quot -- ) rot with-variable ; inline -! Parsing tests -irc-message new - ":someuser!n=user@some.where PRIVMSG #factortest :hi" >>line - "someuser!n=user@some.where" >>prefix - "PRIVMSG" >>command - { "#factortest" } >>parameters - "hi" >>trailing -1array -[ ":someuser!n=user@some.where PRIVMSG #factortest :hi" - string>irc-message f >>timestamp ] unit-test - -privmsg new - ":someuser!n=user@some.where PRIVMSG #factortest :hi" >>line - "someuser!n=user@some.where" >>prefix - "PRIVMSG" >>command - { "#factortest" } >>parameters - "hi" >>trailing - "#factortest" >>name -1array -[ ":someuser!n=user@some.where PRIVMSG #factortest :hi" - parse-irc-line f >>timestamp ] unit-test - { "" } make-client dup "factorbot" set-nick current-irc-client [ { t } [ irc> profile>> nickname>> me? ] unit-test @@ -67,7 +45,7 @@ privmsg new profile>> nickname>> ] unit-test { join_ "#factortest" } [ - { ":factorbot!n=factorbo@some.where 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." diff --git a/extra/irc/messages/messages-tests.factor b/extra/irc/messages/messages-tests.factor new file mode 100644 index 0000000000..1bd6088f82 --- /dev/null +++ b/extra/irc/messages/messages-tests.factor @@ -0,0 +1,37 @@ +USING: kernel tools.test accessors arrays qualified + irc.messages irc.messages.private ; +EXCLUDE: sequences => join ; +IN: irc.messages.tests + +! Parsing tests +irc-message new + ":someuser!n=user@some.where PRIVMSG #factortest :hi" >>line + "someuser!n=user@some.where" >>prefix + "PRIVMSG" >>command + { "#factortest" } >>parameters + "hi" >>trailing +1array +[ ":someuser!n=user@some.where PRIVMSG #factortest :hi" + string>irc-message f >>timestamp ] unit-test + +privmsg new + ":someuser!n=user@some.where PRIVMSG #factortest :hi" >>line + "someuser!n=user@some.where" >>prefix + "PRIVMSG" >>command + { "#factortest" } >>parameters + "hi" >>trailing + "#factortest" >>name +1array +[ ":someuser!n=user@some.where PRIVMSG #factortest :hi" + parse-irc-line f >>timestamp ] unit-test + +join new + ":someuser!n=user@some.where JOIN :#factortest" >>line + "someuser!n=user@some.where" >>prefix + "JOIN" >>command + { } >>parameters + "#factortest" >>trailing +1array +[ ":someuser!n=user@some.where JOIN :#factortest" + parse-irc-line f >>timestamp ] unit-test + diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index 205630d790..24e09467b7 100644 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -21,6 +21,10 @@ TUPLE: mode < irc-message name channel mode ; TUPLE: names-reply < irc-message who = channel ; TUPLE: unhandled < irc-message ; +: make-client-message ( command parameters trailing -- irc-message ) + irc-message new now >>timestamp + [ [ (>>trailing) ] [ (>>parameters) ] [ (>>command) ] tri ] keep ; + GENERIC: irc-message>client-line ( irc-message -- string ) M: irc-message irc-message>client-line ( irc-message -- string ) @@ -58,6 +62,8 @@ M: irc-message irc-message>server-line ( irc-message -- string ) : split-trailing ( string -- string string/f ) ":" split1 ; +PRIVATE> + : string>irc-message ( string -- object ) dup split-prefix split-trailing [ [ blank? ] trim " " split unclip swap ] dip @@ -82,4 +88,3 @@ M: irc-message irc-message>server-line ( irc-message -- string ) [ [ tuple-slots ] [ parameters>> ] bi append ] dip [ all-slots over [ length ] bi@ min head ] keep slots>tuple ; -PRIVATE> From 0038136950a6bf3b9e14282d31a759f69b0bc387 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Mon, 14 Jul 2008 21:43:42 -0300 Subject: [PATCH 09/10] irc.client: Rename client message construcor, handle outgoing plain irc-messages. --- extra/irc/client/client.factor | 4 ++-- extra/irc/messages/messages.factor | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 65dc2fa017..c1cf2e844c 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -209,8 +209,8 @@ M: irc-broadcasted-message handle-incoming-irc ( irc-broadcasted-message -- ) GENERIC: handle-outgoing-irc ( obj -- ) -! M: irc-message handle-outgoing-irc ( irc-message -- ) -! irc-message>string irc-print ; +M: irc-message handle-outgoing-irc ( irc-message -- ) + irc-message>client-line irc-print ; M: privmsg handle-outgoing-irc ( privmsg -- ) [ name>> ] [ trailing>> ] bi /PRIVMSG ; diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index 24e09467b7..1d4fb5b239 100644 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -21,7 +21,7 @@ TUPLE: mode < irc-message name channel mode ; TUPLE: names-reply < irc-message who = channel ; TUPLE: unhandled < irc-message ; -: make-client-message ( command parameters trailing -- irc-message ) +: ( command parameters trailing -- irc-message ) irc-message new now >>timestamp [ [ (>>trailing) ] [ (>>parameters) ] [ (>>command) ] tri ] keep ; From c4db578f04dd7e75489108725121da1de1d12a91 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Wed, 16 Jul 2008 00:31:06 -0300 Subject: [PATCH 10/10] irc.client: Manage participant list changes, forward quit messages to all channels with participant, mode tests. --- extra/irc/client/client-tests.factor | 20 ++++-- extra/irc/client/client.factor | 91 ++++++++++++++++++++-------- extra/irc/messages/messages.factor | 1 + 3 files changed, 82 insertions(+), 30 deletions(-) diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor index 2a1db8c22f..100724ea58 100644 --- a/extra/irc/client/client-tests.factor +++ b/extra/irc/client/client-tests.factor @@ -1,7 +1,7 @@ USING: kernel tools.test accessors arrays sequences qualified io.streams.string io.streams.duplex namespaces threads calendar irc.client.private irc.client irc.messages.private - concurrency.mailboxes classes ; + concurrency.mailboxes classes assocs ; EXCLUDE: irc.messages => join ; RENAME: join irc.messages => join_ IN: irc.client.tests @@ -42,7 +42,7 @@ IN: irc.client.tests ":some.where 001 factorbot :Welcome factorbot" } make-client [ connect-irc ] keep 1 seconds sleep - profile>> nickname>> ] unit-test + profile>> nickname>> ] unit-test { join_ "#factortest" } [ { ":factorbot!n=factorbo@some.where JOIN :#factortest" @@ -52,11 +52,19 @@ IN: irc.client.tests ":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 + join-messages>> 1 seconds mailbox-get-timeout [ class ] [ trailing>> ] bi ] unit-test -! TODO: user join -! ":somedude!n=user@isp.net JOIN :#factortest" + +{ +join+ "somebody" } [ + { ":somebody!n=somebody@some.where JOIN :#factortest" + } make-client dup "factorbot" set-nick + [ listeners>> [ "#factortest" [ ] keep ] dip set-at ] + [ connect-irc ] + [ listeners>> [ "#factortest" ] dip at + [ read-message drop ] [ read-message drop ] [ read-message ] tri ] tri + [ action>> ] [ nick>> ] bi + ] unit-test ! TODO: channel message -! ":somedude!n=user@isp.net PRIVMSG #factortest :hello" +! ":somebody!n=somebody@some.where PRIVMSG #factortest :hello" ! TODO: direct private message ! ":somedude!n=user@isp.net PRIVMSG factorbot2 :hello" \ No newline at end of file diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index c1cf2e844c..b51e92107e 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -36,9 +36,14 @@ SYMBOL: +operator+ SYMBOL: +voice+ SYMBOL: +normal+ -: participant-mode ( n -- assoc ) +: participant-mode ( n -- mode ) H{ { 64 +operator+ } { 43 +voice+ } { 0 +normal+ } } at ; +! participant changed actions +SYMBOL: +join+ +SYMBOL: +part+ +SYMBOL: +mode+ + ! listener objects : ( -- irc-listener ) irc-listener boa ; @@ -55,6 +60,9 @@ SYMBOL: +normal+ ! Message objects ! ====================================== +TUPLE: participant-changed nick action ; +C: participant-changed + SINGLETON: irc-end ! sent when the client isn't running anymore SINGLETON: irc-disconnected ! sent when connection is lost SINGLETON: irc-connected ! sent when connection is established @@ -79,19 +87,27 @@ UNION: irc-broadcasted-message irc-end irc-disconnected irc-connected ; : listener> ( name -- listener/f ) irc> listeners>> at ; : unregister-listener ( name -- ) irc> listeners>> delete-at ; -: to-listener ( message name -- ) +GENERIC: to-listener ( message obj -- ) + +M: string to-listener ( message string -- ) listener> [ +server-listener+ listener> ] unless* - [ in-messages>> mailbox-put ] [ drop ] if* ; + [ to-listener ] [ drop ] if* ; + +M: irc-listener to-listener ( message irc-listener -- ) + in-messages>> mailbox-put ; : remove-participant ( nick channel -- ) listener> [ participants>> delete-at ] [ drop ] if* ; -: remove-participant-from-all ( nick -- ) - irc> listeners>> - [ irc-channel-listener? [ swap remove-participant ] [ 2drop ] if ] with - assoc-each ; +: listeners-with-participant ( nick -- seq ) + irc> listeners>> values + [ dup irc-channel-listener? [ participants>> key? ] [ 2drop f ] if ] + with filter ; -: add-participant ( nick mode channel -- ) +: remove-participant-from-all ( nick -- ) + dup listeners-with-participant [ delete-at ] with each ; + +: add-participant ( mode nick channel -- ) listener> [ participants>> set-at ] [ 2drop ] if* ; DEFER: me? @@ -151,12 +167,31 @@ DEFER: me? dup name>> me? [ prefix>> parse-name ] [ name>> ] if ; : broadcast-message-to-listeners ( message -- ) - irc> listeners>> values [ in-messages>> mailbox-put ] with each ; + irc> listeners>> values [ to-listener ] with each ; + +GENERIC: handle-participant-change ( irc-message -- ) + +M: join handle-participant-change ( join -- ) + [ prefix>> parse-name +join+ ] + [ trailing>> ] bi to-listener ; + +M: part handle-participant-change ( part -- ) + [ prefix>> parse-name +part+ ] + [ channel>> ] bi to-listener ; + +M: kick handle-participant-change ( kick -- ) + [ who>> +part+ ] + [ channel>> ] bi to-listener ; + +M: quit handle-participant-change ( quit -- ) + prefix>> parse-name + [ +part+ ] [ listeners-with-participant ] bi + [ to-listener ] with each ; GENERIC: handle-incoming-irc ( irc-message -- ) M: irc-message handle-incoming-irc ( irc-message -- ) - +server-listener+ listener> [ in-messages>> mailbox-put ] [ drop ] if* ; + +server-listener+ listener> [ to-listener ] [ drop ] if* ; M: logged-in handle-incoming-irc ( logged-in -- ) name>> irc> profile>> (>>nickname) ; @@ -171,24 +206,32 @@ M: privmsg handle-incoming-irc ( privmsg -- ) dup irc-message-origin to-listener ; M: join handle-incoming-irc ( join -- ) - [ maybe-forward-join ] - [ dup trailing>> to-listener ] - [ [ drop f ] [ prefix>> parse-name ] [ trailing>> ] tri add-participant ] - tri ; + { [ maybe-forward-join ] ! keep + [ dup trailing>> to-listener ] + [ [ drop f ] [ prefix>> parse-name ] [ trailing>> ] tri add-participant ] + [ handle-participant-change ] + } cleave ; M: part handle-incoming-irc ( part -- ) - [ dup channel>> to-listener ] keep - [ prefix>> parse-name ] [ channel>> ] bi remove-participant ; - -M: kick handle-incoming-irc ( kick -- ) - [ dup channel>> to-listener ] - [ [ who>> ] [ channel>> ] bi remove-participant ] - [ dup who>> me? [ unregister-listener ] [ drop ] if ] + [ dup channel>> to-listener ] + [ [ prefix>> parse-name ] [ channel>> ] bi remove-participant ] + [ handle-participant-change ] tri ; +M: kick handle-incoming-irc ( kick -- ) + { [ dup channel>> to-listener ] + [ [ who>> ] [ channel>> ] bi remove-participant ] + [ handle-participant-change ] + [ dup who>> me? [ unregister-listener ] [ drop ] if ] + } cleave ; + M: quit handle-incoming-irc ( quit -- ) - [ prefix>> parse-name remove-participant-from-all ] keep - call-next-method ; + { [ dup prefix>> parse-name listeners-with-participant + [ to-listener ] with each ] + [ handle-participant-change ] + [ prefix>> parse-name remove-participant-from-all ] + [ ] + } cleave call-next-method ; : >nick/mode ( string -- nick mode ) dup first "+@" member? [ unclip ] [ 0 ] if participant-mode ; @@ -234,7 +277,7 @@ DEFER: (connect-irc) : (handle-disconnect) ( -- ) irc> - [ [ irc-disconnected ] dip in-messages>> mailbox-put ] + [ [ irc-disconnected ] dip to-listener ] [ dup reconnect-time>> sleep (connect-irc) ] [ profile>> nickname>> /LOGIN ] tri ; diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index 1d4fb5b239..5813c72723 100644 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -34,6 +34,7 @@ M: irc-message irc-message>client-line ( irc-message -- string ) tri 3array " " sjoin ; GENERIC: irc-message>server-line ( irc-message -- string ) + M: irc-message irc-message>server-line ( irc-message -- string ) drop "not implemented yet" ;