1/*   actions
    2     Author: Giménez, Christian.
    3
    4     Copyright (C) 2016 Giménez, 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     03 dic 2016
   20*/
   21
   22
   23:- module(actions, [
   24	      mark_seen/2, mark_flags/3,
   25	      move_mails_to_maildir/4
   26	  ]).

actions: Maildir actions.

Actions that can be applied to a Maildir file (i.e. one mail).

author
- Gimenez, Christian
license
- GPLv3 */
   35:- license(gplv3).   36
   37:- use_module('../maildir', [
   38		  in_maildir_type/2, add_flags/3
   39	      ]).   40:- use_module(conditions, [is_seen/1]).
 mark_seen(+Filepath:term, -Filepath_new:term)
Mark the Mail file as seen. Filepath should be a relative or absolute file and must contain the cur/new maildir subdirectory.

Filepath_new is the resulting mail filename. */

   50mark_seen(Filepath, Filepath) :-
   51    is_seen(Filepath),!. 
   52mark_seen(Filepath, Filepath_new) :-
   53    mark_flags(Filepath, [seen], Filepath_new).
 mark_flags(+Filepath:term, +Flags:list, -Filepath_new)
Add the Flags to the Filepath mail and rename it properly in the filesystem. Filepath_new is the resulting mail path. */
   61mark_flags(Filepath, Flags, Filepath_new) :-
   63    in_maildir_type(Filepath, cur),!, % red cut
   65    add_flags(Filepath, Flags, Filepath_new),
   67    
   68    rename_file(Filepath, Filepath_new)
   68.
   69
   70mark_flags(Filepath, Flags, Filepath_new) :-
   72    in_maildir_type(Filepath, new),
   74    add_flags(Filepath, Flags, Filepath_new),
   76    
   77    rename_file(Filepath, Filepath_new)
   77.
   78    
   79
   80
   81
 move_mails_to_maildir(+LstMails:list, +Maildir:term, +Type:term, -LstNewMails:list)
Move all mails in LstMails into the given Maildir. And return the new mails at LstNewMails.
Arguments:
LstMails- A list of mails paths terms. */
   89move_mails_to_maildir(LstMails, Maildir, Type, LstNewMails) :-
   90    atomic_list_concat([Maildir, '/', Type, '/'], MaildirPath),
   91    (exists_directory(MaildirPath),! ; throw(maildir_doesnot_exists(MaildirPath)), fail),
   92    move_mails(LstMails, MaildirPath, LstNewMails).
 move_mails(+LstMailspaths:list, +TargetPath:term, -LstNewMails:list)
Just move all the mails fails to the given path. Return the moved mails at LstNewMails.
Arguments:
TargetPath- A term that has the path of the directory where to move the mail, it has the leading '/'. Example: '~/Maildir/'. */
  101move_mails([], _, []) :- !.
  102move_mails([Mail|Rest], TargetPath, [NewPath|Rest2]) :-
  103    exists_file(Mail),!, % red cut
  104    file_base_name(Mail, Mailname),
  105    atom_concat(TargetPath, Mailname, NewPath),
  106    rename_file(Mail, NewPath),
  107    move_mails(Rest, TargetPath, Rest2).
  108move_mails([_Mail|Rest], TargetPath, Rest2) :-
  110    move_mails(Rest, TargetPath, Rest2)