View source with raw comments or as raw
    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                     ]).

Provide persistent dynamic predicates

This module provides simple persistent storage for one or more dynamic predicates. A database is always associated with a module. A module that wishes to maintain a database must declare the terms that can be placed in the database using the directive persistent/1.

The persistent/1 expands each declaration into four predicates:

As mentioned, a database can only be accessed from within a single module. This limitation is on purpose, forcing the user to provide a proper API for accessing the shared persistent data.

Below is a simple example:

:- module(user_db,
          [ attach_user_db/1,           % +File
            current_user_role/2,        % ?User, ?Role
            add_user/2,                 % +User, +Role
            set_user_role/2             % +User, +Role
          ]).
:- use_module(library(persistency)).

:- persistent
        user_role(name:atom, role:oneof([user,administrator])).

attach_user_db(File) :-
        db_attach(File, []).

%%      current_user_role(+Name, -Role) is semidet.

current_user_role(Name, Role) :-
        with_mutex(user_db, user_role(Name, Role)).

add_user(Name, Role) :-
        assert_user_role(Name, Role).

set_user_role(Name, Role) :-
        user_role(Name, Role), !.
set_user_role(Name, Role) :-
        with_mutex(user_db,
                   (  retractall_user_role(Name, _),
                      assert_user_role(Name, Role))).
To be done
- Provide type safety while loading
- Thread safety must now be provided at the user-level. Can we provide generic thread safety? Basically, this means that we must wrap all exported predicates. That might better be done outside this library.
- Transaction management?
-
Should assert_<name> only assert if the database does not contain a variant? */
  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                 *******************************/
 persistent(+Spec)
Declare dynamic database terms. Declarations appear in a directive and have the following format:
:- persistent
        <callable>,
        <callable>,
        ...

Each specification is a callable term, following the conventions of library(record), where each argument is of the form

name:type

Types are defined by library(error).

  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).
 current_persistent_predicate(:PI) is nondet
True if PI is a predicate that provides access to the persistent database DB.
  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                 *******************************/
 db_attach(:File, +Options)
Use File as persistent database for the calling module. The calling module must defined persistent/1 to declare the database terms. Defined options:
sync(+Sync)
One of close (close journal after write), flush (default, flush journal after write) or none (handle as fully buffered stream).

If File is already attached this operation may change the sync behaviour.

  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    ).
 db_size(+Module, -Terms) is det
Terms is the total number of terms in the DB for Module.
  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)).
 db_attached(:File) is semidet
True if the context module attached to the persistent database File.
  418db_attached(Module:File) :-
  419    db_file(Module, File, _Created, _Modified, _EndPos).
 db_assert(:Term) is det
Assert Term into the database and record it for persistency. Note that if the on-disk file has been modified it is first reloaded.
  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    ).
 db_detach is det
Detach persistency from the calling module and delete all persistent clauses from the Prolog database. Note that the file is not affected. After this operation another file may be attached, providing it satisfies the same persistency declaration.
  474db_detach :-
  475    context_module(Module),
  476    db_sync(Module:detach),
  477    db_clean(Module).
 sync(+Module, +Stream) is det
Synchronise journal after a write. Using close, the journal file is closed, making it easier to edit the file externally. Using flush flushes the stream but does not close it. This provides better performance. Using none, the stream is not even flushed. This makes the journal sensitive to crashes, but much faster.
  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          ).
 db_retractall(:Term) is det
Retract all matching facts and do the same in the database. If Term is unbound, persistent/1 from the calling module is used as generator.
  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    ).
 db_retract(:Term) is nondet
Retract terms from the database one-by-one.
  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)).
 db_sync(:What)
Synchronise database with the associated file. What is one of:
reload
Database is reloaded from file if the file was modified since loaded.
update
As reload, but use incremental loading if possible. This allows for two processes to examine the same database file, where one writes the database and the other periodycally calls db_sync(update) to follow the modified data.
gc
Database was re-written, deleting all retractall statements. This is the same as gc(50).
gc(Percentage)
GC DB if the number of deleted terms is the given percentage of the total number of terms.
close
Database stream was closed
detach
Remove all registered persistency for the calling module
nop
No-operation performed

With unbound What, db_sync/1 reloads the database if it was modified on disk, gc it if it is dirty and close it if it is opened.

  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(_, _).
 db_sync_all(+What)
Sync all registered databases.
  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).