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 greater than the given
  577%     percentage of the total number of terms.
  578%     * gc(always)
  579%     GC DB without checking the percentage.
  580%     * close
  581%     Database stream was closed
  582%     * detach
  583%     Remove all registered persistency for the calling module
  584%     * nop
  585%     No-operation performed
  586%
  587%   With unbound What, db_sync/1 reloads  the   database  if  it was
  588%   modified on disk, gc it if it  is   dirty  and close it if it is
  589%   opened.
  590
  591db_sync(Module:What) :-
  592    db_sync(Module, What).
  593
  594
  595db_sync(Module, reload) :-
  596    \+ db_stream(Module, _),                % not open
  597    db_file(Module, File, _Created, ModifiedWhenLoaded, _EndPos),
  598    catch(time_file(File, Modified), _, fail),
  599    Modified > ModifiedWhenLoaded,         % Externally modified
  600    !,
  601    debug(db, 'Database ~w was externally modified; reloading', [File]),
  602    !,
  603    (   catch(db_load_incremental(Module, File),
  604              E,
  605              ( print_message(warning, E), fail ))
  606    ->  true
  607    ;   db_clean(Module),
  608        db_load(Module, File)
  609    ).
  610db_sync(Module, gc) :-
  611    !,
  612    db_sync(Module, gc(50)).
  613db_sync(Module, gc(When)) :-
  614    db_dirty(Module, Dirty),
  615    (   When == always
  616    ->  true
  617    ;   db_size(Module, Total),
  618        (   Total > 0
  619        ->  Perc is (100*Dirty)/Total,
  620            Perc > When
  621        ;   Dirty > 0
  622        )
  623    ),
  624    !,
  625    db_sync(Module, close),
  626    db_file(Module, File, _, Modified, _),
  627    atom_concat(File, '.new', NewFile),
  628    debug(db, 'Database ~w is dirty; cleaning', [File]),
  629    get_time(Created),
  630    catch(setup_call_cleanup(
  631              db_open_file(NewFile, write, Out),
  632              (   persistent(Module, Term, _Types),
  633                  call(Module:Term),
  634                  write_action(Out, assert(Term)),
  635                  fail
  636              ;   stream_property(Out, position(EndPos))
  637              ),
  638              close(Out)),
  639          Error,
  640          ( catch(delete_file(NewFile),_,fail),
  641            throw(Error))),
  642    retractall(db_file(Module, File, _, Modified, _)),
  643    rename_file(NewFile, File),
  644    time_file(File, NewModified),
  645    assert(db_file(Module, File, Created, NewModified, EndPos)).
  646db_sync(Module, close) :-
  647    retract(db_stream(Module, Stream)),
  648    !,
  649    db_file(Module, File, Created, _, _),
  650    debug(db, 'Database ~w is open; closing', [File]),
  651    stream_property(Stream, position(EndPos)),
  652    close(Stream),
  653    time_file(File, Modified),
  654    retractall(db_file(Module, File, _, _, _)),
  655    assert(db_file(Module, File, Created, Modified, EndPos)).
  656db_sync(Module, Action) :-
  657    Action == detach,
  658    !,
  659    (   retract(db_stream(Module, Stream))
  660    ->  close(Stream)
  661    ;   true
  662    ),
  663    retractall(db_file(Module, _, _, _, _)),
  664    retractall(db_dirty(Module, _)),
  665    retractall(db_option(Module, _)).
  666db_sync(_, nop) :- !.
  667db_sync(_, _).
  668
  669
  670%!  db_sync_all(+What)
  671%
  672%   Sync all registered databases.
  673
  674db_sync_all(What) :-
  675    must_be(oneof([reload,gc,gc(_),close]), What),
  676    forall(db_file(Module, _, _, _, _),
  677           db_sync(Module:What)).
  678
  679
  680                 /*******************************
  681                 *             CLOSE            *
  682                 *******************************/
  683
  684close_dbs :-
  685    forall(retract(db_stream(_Module, Stream)),
  686           close(Stream)).
  687
  688:- at_halt(close_dbs).