imap: fix parse-store-mail parsing because it breaks on gmail
gmail responses include lines with the order of UID and FLAGS reversed to indicate the previous flags for a mail. Just ignore those lines because they aren't useful and non-standard.db4
parent
d8121a9622
commit
c6d419e0fe
|
@ -1,6 +1,6 @@
|
|||
USING: accessors arrays assocs calendar calendar.format
|
||||
combinators continuations destructors formatting fry grouping.extras imap
|
||||
io.streams.duplex kernel math math.parser math.ranges
|
||||
imap.private io.streams.duplex kernel math math.parser math.ranges
|
||||
math.statistics namespaces random sequences sets sorting
|
||||
splitting strings system tools.test ;
|
||||
FROM: pcre => findall ;
|
||||
|
@ -34,6 +34,12 @@ ERROR: no-imap-test-host ;
|
|||
: imap-test ( result quot -- )
|
||||
'[ \ imap-settings get-global _ with-imap-settings ] unit-test ; inline
|
||||
|
||||
: base-folder ( -- s )
|
||||
os name>> cpu name>> "-" glue ;
|
||||
|
||||
: test-folder ( s -- s )
|
||||
[ base-folder "/" ] dip 3append ;
|
||||
|
||||
[ t ] [
|
||||
get-test-host <imap4ssl> [ duplex-stream? ] with-disposal
|
||||
] unit-test
|
||||
|
@ -63,12 +69,6 @@ ERROR: no-imap-test-host ;
|
|||
"ALL" "" search-mails
|
||||
] imap-test
|
||||
|
||||
: base-folder ( -- s )
|
||||
os name>> cpu name>> "-" glue ;
|
||||
|
||||
: test-folder ( s -- s )
|
||||
[ base-folder "/" ] dip 3append ;
|
||||
|
||||
! Create delete select again.
|
||||
[ 0 ] [
|
||||
"örjan" test-folder
|
||||
|
@ -127,11 +127,14 @@ ERROR: no-imap-test-host ;
|
|||
|
||||
! Create a folder hierarchy
|
||||
[ t ] [
|
||||
"*" test-folder list-folders length
|
||||
"foo/bar/baz/日本語" test-folder [
|
||||
create-folder
|
||||
"foo/bar/baz/日本語" test-folder
|
||||
[ '[ _ delete-folder ] ignore-errors ]
|
||||
[
|
||||
"*" test-folder list-folders length
|
||||
swap create-folder
|
||||
"*" test-folder list-folders length 4 - =
|
||||
] [ delete-folder ] bi
|
||||
]
|
||||
[ delete-folder ] tri
|
||||
] imap-test
|
||||
|
||||
! A gmail compliant way of creating a folder hierarchy.
|
||||
|
@ -177,6 +180,14 @@ ERROR: no-imap-test-host ;
|
|||
internal-date>timestamp timestamp?
|
||||
] imap-test
|
||||
|
||||
! Response parsing
|
||||
{ { 8132 { "\\Seen" } } f } [
|
||||
"(FLAGS (\\Seen) UID 8132)" parse-store-mail-line
|
||||
! Weird non-standard(?) response format gmail uses to indicate the
|
||||
! previous mail flags. Just ignore it.
|
||||
"(UID 1234 FLAGS (\\Seen))" parse-store-mail-line
|
||||
] unit-test
|
||||
|
||||
! Just an interesting verb to gmail thread mails. Wonder if you can
|
||||
! avoid the double fetch-mails?
|
||||
: threaded-mailbox ( uids -- threads )
|
||||
|
|
|
@ -96,11 +96,13 @@ CONSTANT: IMAP4_SSL_PORT 993
|
|||
first "\\* STATUS \"[^\"]+\" \\(([^\\)]+)\\)" pcre:findall first last last
|
||||
" " split 2 group [ string>number ] assoc-map ;
|
||||
|
||||
: parse-store-mail ( seq -- assoc )
|
||||
but-last [
|
||||
"\\(FLAGS \\(([^\\)]+)\\) UID (\\d+)\\)" pcre:findall
|
||||
: parse-store-mail-line ( str -- pair/f )
|
||||
"\\(FLAGS \\(([^\\)]+)\\) UID (\\d+)\\)" pcre:findall [ f ] [
|
||||
first 1 tail values first2 [ " " split ] dip string>number swap 2array
|
||||
] map ;
|
||||
] if-empty ;
|
||||
|
||||
: parse-store-mail ( seq -- assoc )
|
||||
but-last [ parse-store-mail-line ] map sift ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
@ -181,6 +183,6 @@ TUPLE: imap-settings host email password ;
|
|||
swap >>password
|
||||
swap >>email
|
||||
swap >>host ; inline
|
||||
|
||||
|
||||
: with-imap-settings ( imap-settings quot -- )
|
||||
[ [ host>> ] [ email>> ] [ password>> ] tri ] dip with-imap ; inline
|
||||
|
|
Loading…
Reference in New Issue