1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2009-2017, VU University, Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(persistency,
   36          [ (persistent)/1,             % +Declarations
   37            current_persistent_predicate/1, % :PI
   38
   39            db_attach/2,                % :File, +Options
   40            db_detach/0,
   41            db_attached/1,              % :File
   42
   43            db_sync/1,                  % :What
   44            db_sync_all/1,              % +What
   45
   46            op(1150, fx, (persistent))
   47          ]).   48:- use_module(library(debug)).   49:- use_module(library(error)).   50:- use_module(library(option)).   51:- use_module(library(aggregate)).   52
   53:- predicate_options(db_attach/2, 2,
   54                     [ sync(oneof([close,flush,none]))
   55                     ]).   56
   57/** <module> Provide persistent dynamic predicates
   58
   59This module provides simple persistent storage   for one or more dynamic
   60predicates. A database is always associated with a module. A module that
   61wishes to maintain a database must declare  the terms that can be placed
   62in the database using the directive persistent/1.
   63
   64The persistent/1 expands each declaration into four predicates:
   65
   66        * name(Arg, ...)
   67        * assert_name(Arg, ...)
   68        * retract_name(Arg, ...)
   69        * retractall_name(Arg, ...)
   70
   71As mentioned, a database can  only  be   accessed  from  within a single
   72module. This limitation is on purpose,  forcing   the  user to provide a
   73proper API for accessing the shared persistent data.
   74
   75Below is a simple example:
   76
   77==
   78:- module(user_db,
   79          [ attach_user_db/1,           % +File
   80            current_user_role/2,        % ?User, ?Role
   81            add_user/2,                 % +User, +Role
   82            set_user_role/2             % +User, +Role
   83          ]).
   84:- use_module(library(persistency)).
   85
   86:- persistent
   87        user_role(name:atom, role:oneof([user,administrator])).
   88
   89attach_user_db(File) :-
   90        db_attach(File, []).
   91
   92%%      current_user_role(+Name, -Role) is semidet.
   93
   94current_user_role(Name, Role) :-
   95        with_mutex(user_db, user_role(Name, Role)).
   96
   97add_user(Name, Role) :-
   98        assert_user_role(Name, Role).
   99
  100set_user_role(Name, Role) :-
  101        user_role(Name, Role), !.
  102set_user_role(Name, Role) :-
  103        with_mutex(user_db,
  104                   (  retractall_user_role(Name, _),
  105                      assert_user_role(Name, Role))).
  106==
  107
  108@tbd    Provide type safety while loading
  109@tbd    Thread safety must now be provided at the user-level. Can we
  110        provide generic thread safety?  Basically, this means that we
  111        must wrap all exported predicates.  That might better be done
  112        outside this library.
  113@tbd    Transaction management?
  114@tbd    Should assert_<name> only assert if the database does not
  115        contain a variant?
  116*/
  117
  118:- meta_predicate
  119    db_attach(:, +),
  120    db_attached(:),
  121    db_sync(:),
  122    current_persistent_predicate(:).  123:- module_transparent
  124    db_detach/0.  125
  126
  127                 /*******************************
  128                 *              DB              *
  129                 *******************************/
  130
  131:- dynamic
  132    db_file/5,                      % Module, File, Created, Modified, EndPos
  133    db_stream/2,                    % Module, Stream
  134    db_dirty/2,                     % Module, Deleted
  135    db_option/2.                    % Module, Name(Value)
  136
  137:- volatile
  138    db_stream/2.  139
  140:- multifile
  141    (persistent)/3,                 % Module, Generic, Term
  142    prolog:generated_predicate/1.  143
  144
  145                 /*******************************
  146                 *         DECLARATIONS         *
  147                 *******************************/
  148
  149%!  persistent(+Spec)
  150%
  151%   Declare dynamic database terms. Declarations appear in a
  152%   directive and have the following format:
  153%
  154%   ==
  155%   :- persistent
  156%           <callable>,
  157%           <callable>,
  158%           ...
  159%   ==
  160%
  161%   Each specification is a callable term, following the conventions
  162%   of library(record), where each argument is of the form
  163%
  164%           name:type
  165%
  166%   Types are defined by library(error).
  167
  168persistent(Spec) :-
  169    throw(error(context_error(nodirective, persistent(Spec)), _)).
  170
  171compile_persistent(Var, _, _) -->
  172    { var(Var),
  173      !,
  174      instantiation_error(Var)
  175    }.
  176compile_persistent(M:Spec, _, LoadModule) -->
  177    !,
  178    compile_persistent(Spec, M, LoadModule).
  179compile_persistent((A,B), Module, LoadModule) -->
  180    !,
  181    compile_persistent(A, Module, LoadModule),
  182    compile_persistent(B, Module, LoadModule).
  183compile_persistent(Term, Module, LoadModule) -->
  184    { functor(Term, Name, Arity),           % Validates Term as callable
  185      functor(Generic, Name, Arity),
  186      qualify(Module, LoadModule, Name/Arity, Dynamic)
  187    },
  188    [ :- dynamic(Dynamic),
  189
  190      persistency:persistent(Module, Generic, Term)
  191    ],
  192    assert_clause(asserta, Term, Module, LoadModule),
  193    assert_clause(assert,  Term, Module, LoadModule),
  194    retract_clause(Term, Module, LoadModule),
  195    retractall_clause(Term, Module, LoadModule).
  196
  197assert_clause(Where, Term, Module, LoadModule) -->
  198    { functor(Term, Name, Arity),
  199      atomic_list_concat([Where,'_', Name], PredName),
  200      length(Args, Arity),
  201      Head =.. [PredName|Args],
  202      Assert =.. [Name|Args],
  203      type_checkers(Args, 1, Term, Check),
  204      atom_concat(db_, Where, DBActionName),
  205      DBAction =.. [DBActionName, Module:Assert],
  206      qualify(Module, LoadModule, Head, QHead),
  207      Clause = (QHead :- Check, persistency:DBAction)
  208    },
  209    [ Clause ].
  210
  211type_checkers([], _, _, true).
  212type_checkers([A0|AL], I, Spec, Check) :-
  213    arg(I, Spec, ArgSpec),
  214    (   ArgSpec = _Name:Type,
  215        nonvar(Type),
  216        Type \== any
  217    ->  Check = (must_be(Type, A0),More)
  218    ;   More = Check
  219    ),
  220    I2 is I + 1,
  221    type_checkers(AL, I2, Spec, More).
  222
  223retract_clause(Term, Module, LoadModule) -->
  224    { functor(Term, Name, Arity),
  225      atom_concat(retract_, Name, PredName),
  226      length(Args, Arity),
  227      Head =.. [PredName|Args],
  228      Retract =.. [Name|Args],
  229      qualify(Module, LoadModule, Head, QHead),
  230      Clause = (QHead :- persistency:db_retract(Module:Retract))
  231    },
  232    [ Clause ].
  233
  234retractall_clause(Term, Module, LoadModule) -->
  235    { functor(Term, Name, Arity),
  236      atom_concat(retractall_, Name, PredName),
  237      length(Args, Arity),
  238      Head =.. [PredName|Args],
  239      Retract =.. [Name|Args],
  240      qualify(Module, LoadModule, Head, QHead),
  241      Clause = (QHead :- persistency:db_retractall(Module:Retract))
  242    },
  243    [ Clause ].
  244
  245qualify(Module, Module, Head, Head) :- !.
  246qualify(Module, _LoadModule, Head, Module:Head).
  247
  248
  249:- multifile
  250    system:term_expansion/2.  251
  252system:term_expansion((:- persistent(Spec)), Clauses) :-
  253    prolog_load_context(module, Module),
  254    phrase(compile_persistent(Spec, Module, Module), Clauses).
  255
  256
  257%!  current_persistent_predicate(:PI) is nondet.
  258%
  259%   True if PI is a predicate that provides access to the persistent
  260%   database DB.
  261
  262current_persistent_predicate(M:PName/Arity) :-
  263    persistency:persistent(M, Generic, _),
  264    functor(Generic, Name, Arity),
  265    (   Name = PName
  266    ;   atom_concat(assert_, Name, PName)
  267    ;   atom_concat(retract_, Name, PName)
  268    ;   atom_concat(retractall_, Name, PName)
  269    ).
  270
  271prolog:generated_predicate(PI) :-
  272    current_persistent_predicate(PI).
  273
  274
  275                 /*******************************
  276                 *            ATTACH            *
  277                 *******************************/
  278
  279%!  db_attach(:File, +Options)
  280%
  281%   Use File as persistent database for  the calling module. The calling
  282%   module must defined persistent/1  to   declare  the  database terms.
  283%   Defined options:
  284%
  285%     - sync(+Sync)
  286%       One of =close= (close journal after write), =flush=
  287%       (default, flush journal after write) or =none=
  288%       (handle as fully buffered stream).
  289%
  290%   If File is already attached  this   operation  may change the `sync`
  291%   behaviour.
  292
  293db_attach(Module:File, Options) :-
  294    db_set_options(Module, Options),
  295    db_attach_file(Module, File).
  296
  297db_set_options(Module, Options) :-
  298    option(sync(Sync), Options, flush),
  299    must_be(oneof([close,flush,none]), Sync),
  300    (   db_option(Module, sync(Sync))
  301    ->  true
  302    ;   retractall(db_option(Module, _)),
  303        assert(db_option(Module, sync(Sync)))
  304    ).
  305
  306db_attach_file(Module, File) :-
  307    db_file(Module, Old, _, _, _),         % we already have a db
  308    !,
  309    (   Old == File
  310    ->  (   db_stream(Module, Stream)
  311        ->  sync(Module, Stream)
  312        ;   true
  313        )
  314    ;   permission_error(attach, db, File)
  315    ).
  316db_attach_file(Module, File) :-
  317    db_load(Module, File),
  318    !.
  319db_attach_file(Module, File) :-
  320    assert(db_file(Module, File, 0, 0, 0)).
  321
  322db_load(Module, File) :-
  323    retractall(db_file(Module, _, _, _, _)),
  324    debug(db, 'Loading database ~w', [File]),
  325    catch(setup_call_cleanup(
  326              open(File, read, In, [encoding(utf8)]),
  327              load_db_end(In, Module, Created, EndPos),
  328              close(In)),
  329          error(existence_error(source_sink, File), _), fail),
  330    debug(db, 'Loaded ~w', [File]),
  331    time_file(File, Modified),
  332    assert(db_file(Module, File, Created, Modified, EndPos)).
  333
  334db_load_incremental(Module, File) :-
  335    db_file(Module, File, Created, _, EndPos0),
  336    setup_call_cleanup(
  337        ( open(File, read, In, [encoding(utf8)]),
  338          read_action(In, created(Created0)),
  339          set_stream_position(In, EndPos0)
  340        ),
  341        ( Created0 == Created,
  342          debug(db, 'Incremental load from ~p', [EndPos0]),
  343          load_db_end(In, Module, _Created, EndPos)
  344        ),
  345        close(In)),
  346    debug(db, 'Updated ~w', [File]),
  347    time_file(File, Modified),
  348    retractall(db_file(Module, File, Created, _, _)),
  349    assert(db_file(Module, File, Created, Modified, EndPos)).
  350
  351load_db_end(In, Module, Created, End) :-
  352    read_action(In, T0),
  353    (   T0 = created(Created)
  354    ->  read_action(In, T1)
  355    ;   T1 = T0,
  356        Created = 0
  357    ),
  358    load_db(T1, In, Module),
  359    stream_property(In, position(End)).
  360
  361load_db(end_of_file, _, _) :- !.
  362load_db(assert(Term), In, Module) :-
  363    persistent(Module, Term, _Types),
  364    !,
  365    assert(Module:Term),
  366    read_action(In, T1),
  367    load_db(T1, In, Module).
  368load_db(asserta(Term), In, Module) :-
  369    persistent(Module, Term, _Types),
  370    !,
  371    asserta(Module:Term),
  372    read_action(In, T1),
  373    load_db(T1, In, Module).
  374load_db(retractall(Term, Count), In, Module) :-
  375    persistent(Module, Term, _Types),
  376    !,
  377    retractall(Module:Term),
  378    set_dirty(Module, Count),
  379    read_action(In, T1),
  380    load_db(T1, In, Module).
  381load_db(retract(Term), In, Module) :-
  382    persistent(Module, Term, _Types),
  383    !,
  384    (   retract(Module:Term)
  385    ->  set_dirty(Module, 1)
  386    ;   true
  387    ),
  388    read_action(In, T1),
  389    load_db(T1, In, Module).
  390load_db(Term, In, Module) :-
  391    print_message(error, illegal_term(Term)),
  392    read_action(In, T1),
  393    load_db(T1, In, Module).
  394
  395db_clean(Module) :-
  396    retractall(db_dirty(Module, _)),
  397    (   persistent(Module, Term, _Types),
  398        retractall(Module:Term),
  399        fail
  400    ;   true
  401    ).
  402
  403%!  db_size(+Module, -Terms) is det.
  404%
  405%   Terms is the total number of terms in the DB for Module.
  406
  407db_size(Module, Total) :-
  408    aggregate_all(sum(Count), persistent_size(Module, Count), Total).
  409
  410persistent_size(Module, Count) :-
  411    persistent(Module, Term, _Types),
  412    predicate_property(Module:Term, number_of_clauses(Count)).
  413
  414%!  db_attached(:File) is semidet.
  415%
  416%   True if the context module attached to the persistent database File.
  417
  418db_attached(Module:File) :-
  419    db_file(Module, File, _Created, _Modified, _EndPos).
  420
  421%!  db_assert(:Term) is det.
  422%
  423%   Assert Term into the database  and   record  it for persistency.
  424%   Note that if the on-disk file  has   been  modified  it is first
  425%   reloaded.
  426
  427:- public
  428    db_assert/1,
  429    db_asserta/1,
  430    db_retractall/1,
  431    db_retract/1.  432
  433db_assert(Module:Term) :-
  434    assert(Module:Term),
  435    persistent(Module, assert(Term)).
  436
  437db_asserta(Module:Term) :-
  438    asserta(Module:Term),
  439    persistent(Module, asserta(Term)).
  440
  441persistent(Module, Action) :-
  442    (   db_stream(Module, Stream)
  443    ->  true
  444    ;   db_file(Module, File, _Created, _Modified, _EndPos)
  445    ->  db_sync(Module, update),            % Is this correct?
  446        db_open_file(File, append, Stream),
  447        assert(db_stream(Module, Stream))
  448    ;   existence_error(db_file, Module)
  449    ),
  450    write_action(Stream, Action),
  451    sync(Module, Stream).
  452
  453db_open_file(File, Mode, Stream) :-
  454    open(File, Mode, Stream,
  455         [ close_on_abort(false),
  456           encoding(utf8),
  457           lock(write)
  458         ]),
  459    (   size_file(File, 0)
  460    ->  get_time(Now),
  461        write_action(Stream, created(Now))
  462    ;   true
  463    ).
  464
  465
  466%!  db_detach is det.
  467%
  468%   Detach persistency from  the  calling   module  and  delete  all
  469%   persistent clauses from the Prolog database.  Note that the file
  470%   is not affected. After  this  operation   another  file  may  be
  471%   attached,  providing  it   satisfies    the   same   persistency
  472%   declaration.
  473
  474db_detach :-
  475    context_module(Module),
  476    db_sync(Module:detach),
  477    db_clean(Module).
  478
  479
  480%!  sync(+Module, +Stream) is det.
  481%
  482%   Synchronise journal after a write.   Using  =close=, the journal
  483%   file is closed, making it easier   to  edit the file externally.
  484%   Using =flush= flushes the stream  but   does  not close it. This
  485%   provides better performance. Using  =none=,   the  stream is not
  486%   even flushed. This makes the journal   sensitive to crashes, but
  487%   much faster.
  488
  489sync(Module, Stream) :-
  490    db_option(Module, sync(Sync)),
  491    (   Sync == close
  492    ->  db_sync(Module, close)
  493    ;   Sync == flush
  494    ->  flush_output(Stream)
  495    ;   true
  496    ).
  497
  498read_action(Stream, Action) :-
  499    read_term(Stream, Action, [module(db)]).
  500
  501write_action(Stream, Action) :-
  502    \+ \+ ( numbervars(Action, 0, _, [singletons(true)]),
  503            format(Stream, '~W.~n',
  504                   [ Action,
  505                     [ quoted(true),
  506                       numbervars(true),
  507                       module(db)
  508                     ]
  509                   ])
  510          ).
  511
  512%!  db_retractall(:Term) is det.
  513%
  514%   Retract all matching facts and do the   same in the database. If
  515%   Term is unbound, persistent/1 from the   calling  module is used as
  516%   generator.
  517
  518db_retractall(Module:Term) :-
  519    (   var(Term)
  520    ->  forall(persistent(Module, Term, _Types),
  521               db_retractall(Module:Term))
  522    ;   State = count(0),
  523        (   retract(Module:Term),
  524            arg(1, State, C0),
  525            C1 is C0+1,
  526            nb_setarg(1, State, C1),
  527            fail
  528        ;   arg(1, State, Count)
  529        ),
  530        (   Count > 0
  531        ->  set_dirty(Module, Count),
  532            persistent(Module, retractall(Term, Count))
  533        ;   true
  534        )
  535    ).
  536
  537
  538%!  db_retract(:Term) is nondet.
  539%
  540%   Retract terms from the database one-by-one.
  541
  542db_retract(Module:Term) :-
  543    (   var(Term)
  544    ->  instantiation_error(Term)
  545    ;   retract(Module:Term),
  546        set_dirty(Module, 1),
  547        persistent(Module, retract(Term))
  548    ).
  549
  550
  551set_dirty(_, 0) :- !.
  552set_dirty(Module, Count) :-
  553    (   retract(db_dirty(Module, C0))
  554    ->  true
  555    ;   C0 = 0
  556    ),
  557    C1 is C0 + Count,
  558    assert(db_dirty(Module, C1)).
  559
  560%!  db_sync(:What)
  561%
  562%   Synchronise database with the associated file.  What is one of:
  563%
  564%     * reload
  565%     Database is reloaded from file if the file was modified
  566%     since loaded.
  567%     * update
  568%     As `reload`, but use incremental loading if possible.
  569%     This allows for two processes to examine the same database
  570%     file, where one writes the database and the other periodycally
  571%     calls db_sync(update) to follow the modified data.
  572%     * gc
  573%     Database was re-written, deleting all retractall
  574%     statements.  This is the same as gc(50).
  575%     * gc(Percentage)
  576%     GC DB if the number of deleted terms is the given
  577%     percentage of the total number of terms.
  578%     * close
  579%     Database stream was closed
  580%     * detach
  581%     Remove all registered persistency for the calling module
  582%     * nop
  583%     No-operation performed
  584%
  585%   With unbound What, db_sync/1 reloads  the   database  if  it was
  586%   modified on disk, gc it if it  is   dirty  and close it if it is
  587%   opened.
  588
  589db_sync(Module:What) :-
  590    db_sync(Module, What).
  591
  592
  593db_sync(Module, reload) :-
  594    \+ db_stream(Module, _),                % not open
  595    db_file(Module, File, _Created, ModifiedWhenLoaded, _EndPos),
  596    catch(time_file(File, Modified), _, fail),
  597    Modified > ModifiedWhenLoaded,         % Externally modified
  598    !,
  599    debug(db, 'Database ~w was externally modified; reloading', [File]),
  600    !,
  601    (   catch(db_load_incremental(Module, File),
  602              E,
  603              ( print_message(warning, E), fail ))
  604    ->  true
  605    ;   db_clean(Module),
  606        db_load(Module, File)
  607    ).
  608db_sync(Module, gc) :-
  609    !,
  610    db_sync(Module, gc(50)).
  611db_sync(Module, gc(When)) :-
  612    db_dirty(Module, Dirty),
  613    (   When == always
  614    ->  true
  615    ;   db_size(Module, Total),
  616        (   Total > 0
  617        ->  Perc is (100*Dirty)/Total,
  618            Perc > When
  619        ;   Dirty > 0
  620        )
  621    ),
  622    !,
  623    db_sync(Module, close),
  624    db_file(Module, File, _, Modified, _),
  625    atom_concat(File, '.new', NewFile),
  626    debug(db, 'Database ~w is dirty; cleaning', [File]),
  627    get_time(Created),
  628    catch(setup_call_cleanup(
  629              db_open_file(NewFile, write, Out),
  630              (   persistent(Module, Term, _Types),
  631                  call(Module:Term),
  632                  write_action(Out, assert(Term)),
  633                  fail
  634              ;   stream_property(Out, position(EndPos))
  635              ),
  636              close(Out)),
  637          Error,
  638          ( catch(delete_file(NewFile),_,fail),
  639            throw(Error))),
  640    retractall(db_file(Module, File, _, Modified, _)),
  641    rename_file(NewFile, File),
  642    time_file(File, NewModified),
  643    assert(db_file(Module, File, Created, NewModified, EndPos)).
  644db_sync(Module, close) :-
  645    retract(db_stream(Module, Stream)),
  646    !,
  647    db_file(Module, File, Created, _, _),
  648    debug(db, 'Database ~w is open; closing', [File]),
  649    stream_property(Stream, position(EndPos)),
  650    close(Stream),
  651    time_file(File, Modified),
  652    retractall(db_file(Module, File, _, _, _)),
  653    assert(db_file(Module, File, Created, Modified, EndPos)).
  654db_sync(Module, Action) :-
  655    Action == detach,
  656    !,
  657    (   retract(db_stream(Module, Stream))
  658    ->  close(Stream)
  659    ;   true
  660    ),
  661    retractall(db_file(Module, _, _, _, _)),
  662    retractall(db_dirty(Module, _)),
  663    retractall(db_option(Module, _)).
  664db_sync(_, nop) :- !.
  665db_sync(_, _).
  666
  667
  668%!  db_sync_all(+What)
  669%
  670%   Sync all registered databases.
  671
  672db_sync_all(What) :-
  673    must_be(oneof([reload,gc,gc(_),close]), What),
  674    forall(db_file(Module, _, _, _, _),
  675           db_sync(Module:What)).
  676
  677
  678                 /*******************************
  679                 *             CLOSE            *
  680                 *******************************/
  681
  682close_dbs :-
  683    forall(retract(db_stream(_Module, Stream)),
  684           close(Stream)).
  685
  686:- at_halt(close_dbs).