From c4db578f04dd7e75489108725121da1de1d12a91 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Wed, 16 Jul 2008 00:31:06 -0300 Subject: [PATCH] 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" ;