steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

irc.client: Clean code a bit, add some unit-tests

db4
Bruno Deferrari 2008-06-01 20:58:53 -03:00
parent cf07763259
commit 352c9b8997
2 changed files with 86 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
extra/irc/client/client-tests.factor Normal file
View File

@ -0,0 +1,36 @@
USING: kernel ;
IN:
irc.client.private
: me? ( string -- ? )
"factorbot" = ;
USING: irc.client irc.client.private kernel tools.test accessors arrays ;
IN: irc.client.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
{ "someuser" } [ "someuser!n=user@some.where"
parse-name ] unit-test
{ "#factortest" } [ ":someuser!n=user@some.where PRIVMSG #factortest :hi"
parse-irc-line irc-message-origin ] unit-test
{ "someuser" } [ ":someuser!n=user@some.where PRIVMSG factorbot :hi"
parse-irc-line irc-message-origin ] unit-test

107
extra/irc/client/client.factor
View File

@ -3,7 +3,7 @@
USING: arrays combinators concurrency.mailboxes concurrency.futures io
io.encodings.8-bit io.sockets kernel namespaces sequences
sequences.lib splitting threads calendar classes.tuple
ascii assocs accessors destructors ;
classes ascii assocs accessors destructors ;
IN: irc.client
! ======================================
@ -106,43 +106,6 @@ TUPLE: unhandled < irc-message ;
: /PONG ( text -- )
"PONG " irc-write irc-print ;
! ======================================
! Server message handling
! ======================================
: irc-message-origin ( irc-message -- name )
dup name>> irc-client> nick>> name>> = [ sender>> ] [ name>> ] if ;
GENERIC: handle-incoming-irc ( irc-message -- )
M: irc-message handle-incoming-irc ( irc-message -- )
drop ;
M: logged-in handle-incoming-irc ( logged-in -- )
name>> irc-client> nick>> (>>name) ;
M: ping handle-incoming-irc ( ping -- )
trailing>> /PONG ;
M: nick-in-use handle-incoming-irc ( nick-in-use -- )
name>> "_" append /NICK ;
M: privmsg handle-incoming-irc ( privmsg -- )
dup irc-message-origin irc-client> listeners>> at
[ in-messages>> mailbox-put ] [ drop ] if* ;
M: join handle-incoming-irc ( join -- )
irc-client> join-messages>> mailbox-put ;
! ======================================
! Client message handling
! ======================================
GENERIC: handle-outgoing-irc ( obj -- )
M: privmsg handle-outgoing-irc ( privmsg -- )
[ name>> ] [ trailing>> ] bi /PRIVMSG ;
! ======================================
! Message parsing
! ======================================
@ -189,6 +152,46 @@ M: privmsg handle-outgoing-irc ( privmsg -- )
} case
[ [ tuple-slots ] [ parameters>> ] bi append ] dip prefix >tuple ;
! ======================================
! Server message handling
! ======================================
: me? ( string -- ? )
irc-client> nick>> name>> = ;
: irc-message-origin ( irc-message -- name )
dup name>> me? [ prefix>> parse-name ] [ name>> ] if ;
GENERIC: handle-incoming-irc ( irc-message -- )
M: irc-message handle-incoming-irc ( irc-message -- )
drop ;
M: logged-in handle-incoming-irc ( logged-in -- )
name>> irc-client> nick>> (>>name) ;
M: ping handle-incoming-irc ( ping -- )
trailing>> /PONG ;
M: nick-in-use handle-incoming-irc ( nick-in-use -- )
name>> "_" append /NICK ;
M: privmsg handle-incoming-irc ( privmsg -- )
dup irc-message-origin irc-client> listeners>> at
[ in-messages>> mailbox-put ] [ drop ] if* ;
M: join handle-incoming-irc ( join -- )
irc-client> join-messages>> mailbox-put ;
! ======================================
! Client message handling
! ======================================
GENERIC: handle-outgoing-irc ( obj -- )
M: privmsg handle-outgoing-irc ( privmsg -- )
[ name>> ] [ trailing>> ] bi /PRIVMSG ;
! ======================================
! Reader/Writer
! ======================================
@ -219,19 +222,12 @@ M: privmsg handle-outgoing-irc ( privmsg -- )
: in-multiplexer-loop ( -- )
irc-client> in-messages>> mailbox-get handle-incoming-irc ;
! FIXME: Hack, this should be handled better
GENERIC: annotate-message-with-name ( name obj -- obj )
M: object annotate-message-with-name nip ;
M: privmsg annotate-message-with-name swap >>name ;
: maybe-annotate-with-name ( name obj -- obj )
dup privmsg instance? [ swap >>name ] [ nip ] if ;
: listener-loop ( name -- ) ! FIXME: take different values from the stack?
dup irc-client> listeners>> at [
out-messages>> mailbox-get annotate-message-with-name
irc-client> out-messages>>
mailbox-put
] [
drop
] if* ;
: listener-loop ( name listener -- )
out-messages>> mailbox-get maybe-annotate-with-name
irc-client> out-messages>> mailbox-put ;
: spawn-irc-loop ( quot name -- )
[ [ irc-client> is-running>> ] compose ] dip
@ -247,9 +243,10 @@ M: privmsg annotate-message-with-name swap >>name ;
! ======================================
: make-registered-listener ( name -- listener )
<irc-listener> swap dup
[ listener-loop ] curry "listener" spawn-irc-loop
[ irc-client> listeners>> set-at ] curry keep ;
<irc-listener>
[ [ listener-loop ] 2curry "listener" spawn-irc-loop ]
[ swap [ irc-client> listeners>> set-at ] curry keep ]
2bi ;
: make-join-future ( name -- future )
[ [ swap trailing>> = ] curry ! compare name with channel name
@ -283,7 +280,3 @@ PRIVATE>
swap current-irc-client [
dup f maybe-join make-listener-future
] with-variable ;
! shorcut for privmsgs, etc
: sender>> ( obj -- string )
prefix>> parse-name ;