1/*   conditions
    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(conditions, [
   24	      is_seen/1, is_unseen/1,
   25	      to_substr/2, from_substr/2, subject_substr/2,
   26	      older_than/2
   27	  ]).

conditions: Conditions for search_mails/4.

Use this library for some useful conditions to use on search_mails/4.

author
- Gimenez, Christian
license
- GPLv3 */
   36:- license(gplv3).   37
   38:- use_module('../maildir').   39:- use_module('../imf').
 is_seen(+Filepath:term)
True iff this mail is seen. */
   47is_seen(Filepath) :-
   48    in_maildir_type(Filepath, cur),
   49    file_base_name(Filepath, Filename),
   50    get_flags(Filename, _Basename, Flags),
   51    member(seen, Flags).
 is_unseen(+Mailfile:term)
True iff the Mailfile is not marked as seen or is in the new directory. */
   59is_unseen(Mailfile) :-
   60    \+ is_seen(Mailfile).
 to_substr(+Substr:codes, +Mailfile:term)
True iff the message/2 compound term has the header "To" in which its value has Substr as substring.
Arguments:
Mailfile- Mail file path. Relative and absolute path are supported. */
   69to_substr(Substr, Mailfile) :-
   70    read_file_to_codes(Mailfile, Codes, []),
   71    message(message(header(LstH), body(_B)), Codes, []),
   72    member(field(`To`,Str), LstH),!,
   73    append([_Before, Substr, _After], Str),!. % no more appends tests, just once is enough.
 from_substr(+Substr:codes, +Mailfile:term)
True iff the message/2 compound term has the header "To" in which its value has Substr as substring.
Arguments:
Mailfile- Mail file path. Relative and absolute path are supported. */
   82from_substr(Substr, Mailfile) :-
   83    read_file_to_codes(Mailfile, Codes, []),
   84    message(message(header(LstH), body(_B)), Codes, []),
   85    member(field(`From`,Str), LstH),!,
   86    append([_Before, Substr, _After], Str), !. % no more appends tests, just once is enough.
 subject_substr(+Substr:codes, +Mailfile:term)
True iff the message/2 compound term has the header "Subject" in which its value has Substr as substring.
Arguments:
Mailfile- Mail file path. Relative and absolute path are supported. */
   95subject_substr(Substr, Mailfile) :-
   96    read_file_to_codes(Mailfile, Codes, []),
   97    message(message(header(LstH), body(_B)), Codes, []),
   98    member(field(`Subject`,Str), LstH),!,
   99    append([_Before, Substr, _After], Str), !. % no more appends tests, just once is enough.
 older_than(+Date:pred, +Mailfile:term) is det
True iff the mail has the "Date" header with value older than the date specified.

Remember to set the timezone accordingly.

Consider the following example, which it checks if the mails is older than 9 of december of 2015 at 17:27:50 hours in -0300 UTC (10800 = -3 hours * 60 mins * 60 seconds).

older_than(date(2015, 12, 9, 17, 27, 50, 10800, -, -), './mailfile').
Arguments:
Date- a date/9 predicate as explained in the date package (see date_time_stamp/2).
Mailfile- Mail file path. Relative and absolute path are supported. */
  120older_than(DateLimit, Mailfile) :-
  121    read_file_to_codes(Mailfile, Codes, []),
  122    message(message(header(LstH), body(_)), Codes, []),
  123    member(field(`Date`, Str), LstH),
  124    imf:date_time(Datetime, Str, []),
  125    
  126    date_time_stamp(Datetime, MailTimestamp),
  127    date_time_stamp(DateLimit, LimitTimestamp),
  128    MailTimestamp < LimitTimestamp