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

Merge branch 'irc' of git://www.tiodante.com/git/factor

db4
Slava Pestov 2009-05-13 16:59:18 -05:00
parent 9b79f9be4e 53413a049e
commit 977a6e0455
10 changed files with 67 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/irc/client/base/base.factor
View File

@ -19,7 +19,7 @@ SYMBOL: current-irc-client
UNION: to-target privmsg notice ;
UNION: to-channel join part topic kick rpl-channel-modes
rpl-notopic rpl-topic rpl-names rpl-names-end ;
topic rpl-names rpl-names-end ;
UNION: to-one-chat to-target to-channel mode ;
UNION: to-many-chats nick quit ;
UNION: to-all-chats irc-end irc-disconnected irc-connected ;

8
extra/irc/client/chats/chats.factor
View File

@ -33,7 +33,8 @@ TUPLE: irc-profile server port nickname password ;
C: <irc-profile> irc-profile
TUPLE: irc-client profile stream in-messages out-messages
chats is-running nick connect reconnect-time is-ready
chats is-running nick connect is-ready
reconnect-time reconnect-attempts
exceptions ;
: <irc-client> ( profile -- irc-client )
@ -43,8 +44,9 @@ TUPLE: irc-client profile stream in-messages out-messages
<mailbox> >>in-messages
<mailbox> >>out-messages
H{ } clone >>chats
15 seconds >>reconnect-time
30 seconds >>reconnect-time
10 >>reconnect-attempts
V{ } clone >>exceptions
[ <inet> latin1 <client> ] >>connect ;
[ <inet> latin1 <client> drop ] >>connect ;
SINGLETONS: irc-chat-end irc-end irc-disconnected irc-connected ;

2
extra/irc/client/internals/internals-tests.factor
View File

@ -76,7 +76,7 @@ M: mb-writer dispose drop ;
! Test connect
{ V{ "NICK factorbot" "USER factorbot hostname servername :irc.factor" } } [
"someserver" irc-port "factorbot" f <irc-profile> <irc-client>
[ 2drop <test-stream> t ] >>connect
[ 2drop <test-stream> ] >>connect
[
(connect-irc)
(do-login)

48
extra/irc/client/internals/internals.factor
View File

@ -3,10 +3,17 @@
USING: accessors assocs arrays concurrency.mailboxes continuations destructors
hashtables io irc.client.base irc.client.chats irc.messages kernel namespaces
strings words.symbol irc.messages.base irc.client.participants fry threads
combinators irc.messages.parser ;
combinators irc.messages.parser math ;
EXCLUDE: sequences => join ;
IN: irc.client.internals
: do-connect ( server port quot: ( host port -- stream ) attempts -- stream/f )
dup 0 > [
[ drop call( host port -- stream ) ]
[ drop 15 sleep 1- do-connect ]
recover
] [ 2drop 2drop f ] if ;
: /NICK ( nick -- ) "NICK " prepend irc-print ;
: /PONG ( text -- ) "PONG " prepend irc-print ;
@ -15,18 +22,27 @@ IN: irc.client.internals
"USER " prepend " hostname servername :irc.factor" append irc-print ;
: /CONNECT ( server port -- stream )
irc> connect>> call( host port -- stream local ) drop ;
irc> [ connect>> ] [ reconnect-attempts>> ] bi do-connect ;
: /JOIN ( channel password -- )
[ " :" swap 3append ] when* "JOIN " prepend irc-print ;
: try-connect ( -- stream/f )
irc> profile>> [ server>> ] [ port>> ] bi /CONNECT ;
: (terminate-irc) ( -- )
irc> dup is-running>> [
f >>is-running
[ stream>> dispose ] keep
[ in-messages>> ] [ out-messages>> ] bi 2array
[ irc-end swap mailbox-put ] each
] [ drop ] if ;
: (connect-irc) ( -- )
irc> {
[ profile>> [ server>> ] [ port>> ] bi /CONNECT ]
[ (>>stream) ]
[ t swap (>>is-running) ]
[ in-messages>> [ irc-connected ] dip mailbox-put ]
} cleave ;
try-connect [
[ irc> ] dip >>stream t >>is-running
in-messages>> [ irc-connected ] dip mailbox-put
] [ (terminate-irc) ] if* ;
: (do-login) ( -- ) irc> nick>> /LOGIN ;
@ -52,7 +68,7 @@ M: to-all-chats message-forwards drop chats> ;
M: to-many-chats message-forwards sender>> participant-chats ;
GENERIC: process-message ( irc-message -- )
M: object process-message drop ;
M: object process-message drop ;
M: ping process-message trailing>> /PONG ;
M: join process-message [ sender>> ] [ chat> ] bi join-participant ;
M: part process-message [ sender>> ] [ chat> ] bi part-participant ;
@ -92,9 +108,7 @@ M: irc-message handle-outgoing-irc irc-message>string irc-print t ;
: (handle-disconnect) ( -- )
irc-disconnected irc> in-messages>> mailbox-put
irc> reconnect-time>> sleep
(connect-irc)
(do-login) ;
(connect-irc) (do-login) ;
: handle-disconnect ( error -- ? )
[ irc> exceptions>> push ] when*
@ -155,12 +169,4 @@ M: irc-channel-chat remove-chat
[ part new annotate-message irc-send ]
[ name>> unregister-chat ] bi ;
: (terminate-irc) ( -- )
irc> dup is-running>> [
f >>is-running
[ stream>> dispose ] keep
[ in-messages>> ] [ out-messages>> ] bi 2array
[ irc-end swap mailbox-put ] each
] [ drop ] if ;
: (speak) ( message irc-chat -- ) swap annotate-message irc-send ;
: (speak) ( message irc-chat -- ) swap annotate-message irc-send ;

10
extra/irc/logbot/log-line/log-line.factor
View File

@ -11,6 +11,12 @@ GENERIC: >log-line ( object -- line )
M: irc-message >log-line line>> ;
M: ctcp >log-line
[ "CTCP: " % dup sender>> % " " % text>> % ] "" make ;
M: action >log-line
[ "* " % dup sender>> % " " % text>> % ] "" make ;
M: privmsg >log-line
[ "<" % dup sender>> % "> " % text>> % ] "" make ;
@ -35,3 +41,7 @@ M: participant-mode >log-line
M: nick >log-line
[ "* " % dup sender>> % " is now known as " % nickname>> % ] "" make ;
M: topic >log-line
[ "* " % dup sender>> % " has set the topic for " % dup channel>> %
": \"" % topic>> % "\"" % ] "" make ;

4
extra/irc/logbot/logbot.factor
View File

@ -16,7 +16,7 @@ SYMBOL: current-stream
"irc.freenode.org" 6667 "flogger" f <irc-profile> ;
: add-timestamp ( string timestamp -- string )
timestamp>hms "[" prepend "] " append prepend ;
timestamp>hms [ "[" % % "] " % % ] "" make ;
: timestamp-path ( timestamp -- path )
timestamp>ymd ".log" append log-directory prepend-path ;
@ -27,7 +27,7 @@ SYMBOL: current-stream
] [
current-stream get [ dispose ] when*
[ day-of-year current-day set ]
[ timestamp-path latin1 <file-writer> ] bi
[ timestamp-path latin1 <file-appender> ] bi
current-stream set
] if current-stream get ;

3
extra/irc/messages/base/base.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2009 Bruno Deferrari
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs classes.parser classes.tuple
USING: accessors arrays assocs calendar classes.parser classes.tuple
combinators fry generic.parser kernel lexer
mirrors namespaces parser sequences splitting strings words ;
IN: irc.messages.base
@ -51,6 +51,7 @@ M: irc-message post-process-irc-message drop ;
GENERIC: fill-irc-message-slots ( irc-message -- )
M: irc-message fill-irc-message-slots
gmt >>timestamp
{
[ process-irc-trailing ]
[ process-irc-prefix ]

5
extra/irc/messages/messages-tests.factor
View File

@ -71,4 +71,7 @@ IN: irc.messages.tests
{ name "nickname" }
{ trailing "Nickname is already in use" } } }
[ ":ircserver.net 433 * nickname :Nickname is already in use"
string>irc-message f >>timestamp ] unit-test
string>irc-message f >>timestamp ] unit-test
{ t } [ ":someuser!n=user@some.where PRIVMSG #factortest :ACTION jumps!"
string>irc-message action? ] unit-test

16
extra/irc/messages/messages.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2009 Bruno Deferrari
! See http://factorcode.org/license.txt for BSD license.
USING: kernel fry splitting ascii calendar accessors combinators
arrays classes.tuple math.order words assocs strings irc.messages.base ;
arrays classes.tuple math.order words assocs strings irc.messages.base
combinators.short-circuit math ;
EXCLUDE: sequences => join ;
IN: irc.messages
@ -61,8 +62,17 @@ IRC: rpl-names-end "366" nickname channel : comment ;
IRC: rpl-nickname-in-use "433" _ name ;
IRC: rpl-nick-collision "436" nickname : comment ;
PREDICATE: channel-mode < mode name>> first "#&" member? ;
PREDICATE: participant-mode < channel-mode parameter>> ;
PREDICATE: ctcp < privmsg
trailing>> { [ length 1 > ] [ first 1 = ] [ peek 1 = ] } 1&& ;
PREDICATE: action < ctcp trailing>> rest "ACTION" head? ;
M: rpl-names post-process-irc-message ( rpl-names -- )
[ [ blank? ] trim " " split ] change-nicks drop ;
PREDICATE: channel-mode < mode name>> first "#&" member? ;
PREDICATE: participant-mode < channel-mode parameter>> ;
M: ctcp post-process-irc-message ( ctcp -- )
[ rest but-last ] change-text drop ;
M: action post-process-irc-message ( action -- )
[ 7 tail ] change-text call-next-method ;

4
extra/irc/messages/parser/parser.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2009 Bruno Deferrari
! See http://factorcode.org/license.txt for BSD license.
USING: kernel fry splitting ascii calendar accessors combinators
USING: kernel fry splitting ascii accessors combinators
arrays classes.tuple math.order words assocs
irc.messages.base sequences ;
IN: irc.messages.parser
@ -32,4 +32,4 @@ PRIVATE>
[ >>trailing ]
tri*
[ (>>prefix) ] [ fill-irc-message-slots ] [ swap >>line ] tri
now >>timestamp dup sender >>sender ;
dup sender >>sender ;