1/*   maildir
    2     Author: Gimenez, Christian.
    3
    4     Copyright (C) 2016 Gimenez, Christian
    5
    6     This program is free software: you can redistribute it and/or modify
    7     it under the terms of the GNU General Public License as published by
    8     the Free Software Foundation, either version 3 of the License, or
    9     at your option) any later version.
   10
   11     This program is distributed in the hope that it will be useful,
   12     but WITHOUT ANY WARRANTY; without even the implied warranty of
   13     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   14     GNU General Public License for more details.
   15
   16     You should have received a copy of the GNU General Public License
   17     along with this program.  If not, see <http://www.gnu.org/licenses/>.
   18
   19     09 nov 2016
   20*/
   21
   22
   23:- module(maildir, [
   24	      get_flags/3, set_flags/3, add_flags/3,
   25	      list_mails/3,
   26	      in_maildir_type/2,
   27	      search_mail/4
   28	  ]).

maildir: Maildir implementation

Maildir implementation for reading e-mails under the Maildir format.

author
- Christian Gimenez
See also
- http://cr.yp.to/proto/maildir.html
license
- GPLv3 */
   39:- license(gplv3).   40
   41:- ensure_loaded(library(dcg/basics)).   42:- ensure_loaded(library(log)).
 mailfile(?Basename, ?Flags)//
Defines the Maildir's filename structure for each mail. */
   49mailfile(Basename, Flags) --> string_without(`:`, Basename), `:`, string(Flags).
 mailfile_atom(+Filepath:term, ?Basename:term, ?FlagsLst:lst)
Same as mailfile, but using atoms instead of string codes. */
   56mailfile_terms(Filepath, Basename, FlagsLst) :-
   57    atom_codes(Filepath, FilepathCodes),
   58    mailfile(BasenameCodes, FlagsLst, FilepathCodes, []),!,
   59    atom_codes(Basename, BasenameCodes).
 maildir_decode(?MaildirType:term, ?Basename:term, ?Flags:list, +Filepath:term)
 */
   64maildir_decode(MaildirType, Basename, Flags, Filepath) :-
   65    atom_codes(Filepath, FilepathCodes),
   66    mailfile(BasenameCodes, FlagsCodes, FilepathCodes, []),
   67    atom_codes(Basename, BasenameCodes), atom_codes(Flags, FlagsCodes),
   68    in_maildir_type(Filepath, MaildirType).
 flag2(?Flag:term, ?Meaning:term)
flag2(?Flag:code, ?Meaning:term)
According to maildir spec :

info starting with "1,": Experimental semantics.

info starting with "2,": Each character after the comma is an independent flag.

Flag "P" (passed): the user has resent/forwarded/bounced this message to someone else.
Flag "R" (replied): the user has replied to this message.
Flag "S" (seen): the user has viewed this message, though perhaps he didn't read all the way through it.
Flag "T" (trashed): the user has moved this message to the trash; the trash will be emptied by a later user action.
Flag "D" (draft): the user considers this message a draft; toggled at user discretion.
Flag "F" (flagged): user-defined flag; toggled at user discretion.

New flags may be defined later. Flags must be stored in ASCII order: e.g., "2,FRS".

*/

   91flag2(C, Meaning) :-
   92    number(C),
   93    atom_codes(C2, [C]),
   94    flag2(C2, Meaning)
   94.
   95flag2('P', passed).
   96flag2('R', replied).
   97flag2('S', seen).
   98flag2('T', trashed).
   99flag2('D', draft).
  100flag2('F', flagged).
 flags_meaning(+Flags:list, -FlagsChars:list)
flags_meaning(-Flags:list, +FlagsChars:list)
Map all flags texts or meanings into its chars, or viceversa. */
  108flags_meaning([], []).
  109flags_meaning([T1|R1], [T2|R2]) :-
  110    flag2(T2, T1),!,
  111    flags_meaning(R1, R2).
 get_flags(+Filename:term, ?Basename:term, ?Flags:lst)
True if Filename correspond to the Basename and the Flags appened according to the Maildir specs.
Arguments:
Flags- A list of "meaning" terms, see flags2/2. It is ordered as Maildir specs suggest. */
  121get_flags(Filename, Basename, Flags) :-
  122    mailfile_terms(Filename, Basename, FlagsChars),
  123    append(`2,`, FlagsChars2, FlagsChars),
  124    sort(FlagsChars2, SortedFlagsC),
  125    flags_meaning(Flags, SortedFlagsC).
 set_flags(+Basename:term, +Flags:list, ?Filename:term)
True iff Filename is the result of adding the given Flags to the Basename file. */
  132set_flags(Basename, Flags, Filename) :-
  133    flags_meaning(Flags, FlagsC),
  134    sort(FlagsC, SortedFlagsC),
  135    atomic_list_concat(SortedFlagsC, SortedFlags),
  136    atomic_list_concat([Basename, ':2,', SortedFlags], Filename).
 add_flags(+Filename:term, +NewFlags:list, -NewFilename:term)
True iff NewFilename is the same Filename with the NewFlags added if it doesn't have those.

If Filename has no Flags (i.e. is in new directory ) it will add the ':2,' format. */

  146add_flags(Filename, NewFlags, NewFilename) :-
  147    get_flags(Filename, Basename, Flags),!, % red cut
  148    add_flags_int(Flags, NewFlags, AddedFlags),
  149    set_flags(Basename, AddedFlags, NewFilename).
  150add_flags(Filename, NewFlags, NewFilename) :-
  152    set_flags(Filename, NewFlags, NewFilename)
  152.
  153
 add_flags_int(Flags, NewFlags, AddedFlags)
AddedFlags is NewFlags with Flags without repeating it and sorting them. */
  159add_flags_int([], NewFlags, AddedFlags) :-
  160    sort(NewFlags, AddedFlags), !.
  161add_flags_int(Flags, [], AddedFlags) :-
  162    sort(Flags, AddedFlags), !.
  163add_flags_int(Flags, [F|Rest], Rest2) :-
  164    member(F, Flags),!, % red cut 
  165    add_flags_int(Flags, Rest, Rest2).
  166add_flags_int(Flags, [F|Rest], [F|Rest2]) :-
  167    % \+  member(F, Flags),!, % True always! 
  168    add_flags_int(Flags, Rest, Rest2).
 maildir_type(-Type:term)
What kinds of Maildirs subdirectory types are. */
  176maildir_type(cur).
  177maildir_type(new).
  178maildir_type(tmp).
 list_mails(+Dir:term, +Type:term, -LstMails:lst)
True if all LstMails are a list of mails in the directory Dir for the maildir_type Type (see maildir_type/1). */
  186list_mails(Dir, Type, LstMails) :-
  187    maildir_type(Type),
  188    atomic_list_concat([Dir, '/', Type, '/*'], Wildcard),
  189    expand_file_name(Wildcard, LstMails).
 in_maildir_type(+Filepath:term, ?Maildir_Type:term)
True if the mail file given byy Filepath is in the Maildir_Type. */
  198in_maildir_type(Filepath, Maildir_Type) :-
  199    maildir_type(Maildir_Type),
  200    file_directory_name(Filepath, Dirs),
  201    file_base_name(Dirs, Maildir_Type).
 search_mail(+Mailbox:term, +MailboxType:term, +Condition:pred, -LstMails:list)
Search for all mails inside the given Mailbox where Condition is true.

Condition must be a predicate with 1 arguments: Mailpath.

  219search_mail(Mailbox, Type, Condition, LstMails) :-
  220    list_mails(Mailbox, Type, LstMails1),
  221    
  222    length(LstMails1, Amount),
  223    format(atom(A), '(~w/~w) Searching on ~w mails for ~w...',
  224	   [Mailbox, Type, Amount, Condition]),
  225    log_message(maildir:search_mail, A),
  226    
  227    has_condition(Condition, LstMails1, LstMails).
 has_condition(+Condition:pred, +LstMails:list, -LstMathched:list)
*/
  233has_condition(_Condition, [], []).
  234has_condition(Condition, [Mail|Rest], [Mail|Rest2]) :-
  235    call(Condition, Mail),!, %red cut
  236    has_condition(Condition, Rest, Rest2).
  237has_condition(Condition, [_Mail|Rest], Rest2) :-
  239    has_condition(Condition, Rest, Rest2)