From 4141399bebdd10ccf67b23ff8d2652de7c627a68 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Wed, 9 Jul 2008 22:48:17 -0300 Subject: [PATCH] irc.client: Move message tuples and parser to irc.messages, fix join handling --- extra/irc/client/client-docs.factor | 2 +- extra/irc/client/client.factor | 101 ++++++++-------------------- extra/irc/messages/authors.txt | 1 + extra/irc/messages/messages.factor | 69 +++++++++++++++++++ 4 files changed, 99 insertions(+), 74 deletions(-) create mode 100644 extra/irc/messages/authors.txt create mode 100644 extra/irc/messages/messages.factor diff --git a/extra/irc/client/client-docs.factor b/extra/irc/client/client-docs.factor index a675e663c3..6bb6a6328e 100644 --- a/extra/irc/client/client-docs.factor +++ b/extra/irc/client/client-docs.factor @@ -1,4 +1,4 @@ -USING: help.markup help.syntax quotations kernel ; +USING: help.markup help.syntax quotations kernel irc.messages ; IN: irc.client HELP: irc-client "IRC Client object" diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 5d80b0648f..ffe78437a7 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -1,9 +1,11 @@ ! Copyright (C) 2008 Bruno Deferrari, Doug Coleman, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: combinators concurrency.mailboxes fry io strings - io.encodings.8-bit io.sockets kernel namespaces sequences - splitting threads calendar classes.tuple - classes ascii assocs accessors destructors continuations ; +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 ; +RENAME: join sequences => sjoin +EXCLUDE: sequences => join ; IN: irc.client ! ====================================== @@ -27,6 +29,7 @@ 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 ; +SYMBOL: +server-listener+ : ( -- irc-listener ) irc-listener boa ; @@ -48,20 +51,6 @@ SINGLETON: irc-disconnected ! sent when connection is lost SINGLETON: irc-connected ! sent when connection is established UNION: irc-broadcasted-message irc-end irc-disconnected irc-connected ; -TUPLE: irc-message line prefix command parameters trailing timestamp ; -TUPLE: logged-in < irc-message name ; -TUPLE: ping < irc-message ; -TUPLE: join < irc-message ; -TUPLE: part < irc-message channel ; -TUPLE: quit < irc-message ; -TUPLE: privmsg < irc-message name ; -TUPLE: kick < irc-message channel who ; -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: unhandled < irc-message ; - : terminate-irc ( irc-client -- ) [ in-messages>> irc-end swap mailbox-put ] [ f >>is-running drop ] @@ -82,13 +71,21 @@ TUPLE: unhandled < irc-message ; : unregister-listener ( name -- ) irc> listeners>> delete-at ; : to-listener ( message name -- ) - listener> [ f listener> ] unless* + listener> [ +server-listener+ listener> ] unless* [ in-messages>> mailbox-put ] [ drop ] if* ; ! ====================================== ! 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 ; @@ -125,53 +122,6 @@ TUPLE: unhandled < irc-message ; : /PONG ( text -- ) "PONG " irc-write irc-print ; -! ====================================== -! Message parsing -! ====================================== - -: split-at-first ( seq separators -- before after ) - dupd '[ , member? ] find - [ cut 1 tail ] - [ swap ] - if ; - -: remove-heading-: ( seq -- seq ) dup ":" head? [ 1 tail ] when ; - -: parse-name ( string -- string ) - remove-heading-: "!" split-at-first drop ; - -: split-prefix ( string -- string/f string ) - dup ":" head? - [ remove-heading-: " " split1 ] - [ f swap ] - if ; - -: split-trailing ( string -- string string/f ) - ":" split1 ; - -: string>irc-message ( string -- object ) - dup split-prefix split-trailing - [ [ blank? ] trim " " split unclip swap ] dip - now irc-message boa ; - -: parse-irc-line ( string -- message ) - string>irc-message - dup command>> { - { "PING" [ \ ping ] } - { "NOTICE" [ \ notice ] } - { "001" [ \ logged-in ] } - { "433" [ \ nick-in-use ] } - { "JOIN" [ \ join ] } - { "PART" [ \ part ] } - { "PRIVMSG" [ \ privmsg ] } - { "QUIT" [ \ quit ] } - { "MODE" [ \ mode ] } - { "KICK" [ \ kick ] } - [ drop \ unhandled ] - } case - [ [ tuple-slots ] [ parameters>> ] bi append ] dip - [ all-slots length head ] keep slots>tuple ; - ! ====================================== ! Server message handling ! ====================================== @@ -188,7 +138,7 @@ TUPLE: unhandled < irc-message ; GENERIC: handle-incoming-irc ( irc-message -- ) M: irc-message handle-incoming-irc ( irc-message -- ) - f listener> [ in-messages>> mailbox-put ] [ drop ] if* ; + +server-listener+ listener> [ in-messages>> mailbox-put ] [ drop ] if* ; M: logged-in handle-incoming-irc ( logged-in -- ) name>> irc> profile>> (>>nickname) ; @@ -203,8 +153,10 @@ M: privmsg handle-incoming-irc ( privmsg -- ) dup irc-message-origin to-listener ; M: join handle-incoming-irc ( join -- ) - dup trailing>> listener> - [ irc> join-messages>> ] unless* mailbox-put ; + [ [ prefix>> parse-name me? ] keep and + [ irc> join-messages>> mailbox-put ] when* ] + [ dup channel>> to-listener ] + bi ; M: part handle-incoming-irc ( part -- ) dup channel>> to-listener ; @@ -222,11 +174,14 @@ 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: privmsg handle-outgoing-irc ( privmsg -- ) - [ name>> ] [ trailing>> ] bi /PRIVMSG ; + [ name>> ] [ trailing>> ] bi /PRIVMSG ; M: part handle-outgoing-irc ( privmsg -- ) - [ channel>> ] [ trailing>> "" or ] bi /PART ; + [ channel>> ] [ trailing>> "" or ] bi /PART ; ! ====================================== ! Reader/Writer @@ -320,7 +275,7 @@ M: irc-nick-listener (add-listener) ( irc-nick-listener -- ) [ name>> ] keep set+run-listener ; M: irc-server-listener (add-listener) ( irc-server-listener -- ) - f swap set+run-listener ; + +server-listener+ swap set+run-listener ; GENERIC: (remove-listener) ( irc-listener -- ) @@ -333,7 +288,7 @@ M: irc-channel-listener (remove-listener) ( irc-channel-listener -- ) name>> unregister-listener ; M: irc-server-listener (remove-listener) ( irc-server-listener -- ) - drop f unregister-listener ; + drop +server-listener+ unregister-listener ; : (connect-irc) ( irc-client -- ) [ profile>> [ server>> ] [ port>> ] bi /CONNECT ] keep diff --git a/extra/irc/messages/authors.txt b/extra/irc/messages/authors.txt new file mode 100644 index 0000000000..f4a8cb1dc2 --- /dev/null +++ b/extra/irc/messages/authors.txt @@ -0,0 +1 @@ +Bruno Deferrari diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor new file mode 100644 index 0000000000..f1beba9b26 --- /dev/null +++ b/extra/irc/messages/messages.factor @@ -0,0 +1,69 @@ +! 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 ; +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: part < irc-message channel ; +TUPLE: quit < irc-message ; +TUPLE: privmsg < irc-message name ; +TUPLE: kick < irc-message channel who ; +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: unhandled < irc-message ; + +irc-message ( string -- object ) + dup split-prefix split-trailing + [ [ blank? ] trim " " split unclip swap ] dip + now irc-message boa ; + +: parse-irc-line ( string -- message ) + string>irc-message + dup command>> { + { "PING" [ \ ping ] } + { "NOTICE" [ \ notice ] } + { "001" [ \ logged-in ] } + { "433" [ \ nick-in-use ] } + { "JOIN" [ \ join ] } + { "PART" [ \ part ] } + { "PRIVMSG" [ \ privmsg ] } + { "QUIT" [ \ quit ] } + { "MODE" [ \ mode ] } + { "KICK" [ \ kick ] } + [ drop \ unhandled ] + } case + [ [ tuple-slots ] [ parameters>> ] bi append ] dip + [ all-slots over [ length ] bi@ min head ] keep slots>tuple ; + +PRIVATE>