! Copyright (C) 2009 Elie Chaftari. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs combinators fry hashtables io io.crlf io.encodings.utf8 io.sockets io.streams.duplex kernel locals math math.parser math.ranges namespaces prettyprint sequences splitting strings ; IN: pop3 SYMBOL: capa-list SYMBOL: emails-total SYMBOL: emails-list SYMBOL: uidl-list SYMBOL: email-top SYMBOL: email-content TUPLE: email # uidl from to subject size ; TUPLE: pop3-account { # fixnum } { host string } { port fixnum initial: 110 } { user string } { password string } { emails array } ; : ( -- email ) email new ; inline : ( -- pop3-account ) pop3-account new ; inline hashtable ; : get-uidl ( -- assoc ) uidl uidl-list get-global associate-split [ swap string>number swap ] assoc-map ; : top ( email# #lines -- ) [ number>string "TOP " prepend " " append ] dip number>string append command get-ok email-top collect-until ; : retr ( email# -- ) number>string "RETR " prepend command get-ok email-content collect-until ; : dele ( email# -- ) number>string "DELE " prepend command get-ok ; : quit ( -- ) "QUIT" command get-ok ; : get-list ( -- assoc ) emails-list get-global associate-split [ swap string>number swap ] assoc-map ; : get-headers ( -- assoc ) V{ } clone "email-headers" set email-top get-global { [ [ dup "From:" head? [ "email-headers" [ swap suffix ] change ] [ drop ] if ] each ] [ [ dup "To:" head? [ "email-headers" [ swap suffix ] change ] [ drop ] if ] each ] [ [ dup "Subject:" head? [ "email-headers" [ swap suffix ] change ] [ drop ] if ] each ] } cleave "email-headers" get associate-split ; : get-total ( -- n ) emails-total get-global string>number ; : consolidate ( -- seq ) V{ } clone "emails" set 1 get-total [a,b] >array [ { [ 0 top ] [ swap >># ] [ get-uidl at >>uidl ] [ get-list at >>size ] } cleave "From:" get-headers at >>from "To:" get-headers at >>to "Subject:" get-headers at >>subject "emails" [ swap suffix ] change ] each "emails" get ; PRIVATE> : collect ( pop3-account -- seq ) dup "account" set initialize-connection [ host>> ] [ port>> ] bi utf8 [ get-ok "account" get [ user>> user ] [ password>> pass ] bi stat list get-total zero? [ "No mail for account." ] [ consolidate ] if quit ] with-client ;