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-2020, VU University, Amsterdam
    7                              CWI, Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(persistency,
   37          [ (persistent)/1,             % +Declarations
   38            current_persistent_predicate/1, % :PI
   39
   40            db_attach/2,                % :File, +Options
   41            db_detach/0,
   42            db_attached/1,              % :File
   43
   44            db_sync/1,                  % :What
   45            db_sync_all/1,              % +What
   46
   47            op(1150, fx, (persistent))
   48          ]).   49:- autoload(library(aggregate),[aggregate_all/3]).   50:- use_module(library(debug),[debug/3]).   51:- autoload(library(error),
   52	    [ instantiation_error/1,
   53	      must_be/2,
   54	      permission_error/3,
   55	      existence_error/2
   56	    ]).   57:- autoload(library(option),[option/3]).   58
   59
   60:- predicate_options(db_attach/2, 2,
   61                     [ sync(oneof([close,flush,none]))
   62                     ]).

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.

This module requires the same thread-synchronization as the normal Prolog database. This implies that if each individual assert or retract takes the database from one consistent state to the next, no additional locking is required. If more than one elementary database operation is required to get from one consistent state to the next, both updating and querying the database must be locked using with_mutex/2.

Below is a simple example, where adding a user does not need locking as it is a single assert, while modifying a user requires both a retract and assert and thus needs to be locked.

:- 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?
- Since we have prolog_listen/2, we could use direct assert/1 and retract/1 and use the system hooks to deal with the updates. */
  136:- meta_predicate
  137    db_attach(:, +),
  138    db_attached(:),
  139    db_sync(:),
  140    current_persistent_predicate(:).  141:- module_transparent
  142    db_detach/0.  143
  144
  145                 /*******************************
  146                 *              DB              *
  147                 *******************************/
  148
  149:- dynamic
  150    db_file/5,                      % Module, File, Created, Modified, EndPos
  151    db_stream/2,                    % Module, Stream
  152    db_dirty/2,                     % Module, Deleted
  153    db_option/2.                    % Module, Name(Value)
  154
  155:- volatile
  156    db_stream/2.  157
  158:- multifile
  159    (persistent)/3,                 % Module, Generic, Term
  160    prolog:generated_predicate/1.  161
  162
  163                 /*******************************
  164                 *         DECLARATIONS         *
  165                 *******************************/
 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).

  186persistent(Spec) :-
  187    throw(error(context_error(nodirective, persistent(Spec)), _)).
  188
  189compile_persistent(Var, _, _) -->
  190    { var(Var),
  191      !,
  192      instantiation_error(Var)
  193    }.
  194compile_persistent(M:Spec, _, LoadModule) -->
  195    !,
  196    compile_persistent(Spec, M, LoadModule).
  197compile_persistent((A,B), Module, LoadModule) -->
  198    !,
  199    compile_persistent(A, Module, LoadModule),
  200    compile_persistent(B, Module, LoadModule).
  201compile_persistent(Term, Module, LoadModule) -->
  202    { functor(Term, Name, Arity),           % Validates Term as callable
  203      functor(Generic, Name, Arity),
  204      qualify(Module, LoadModule, Name/Arity, Dynamic)
  205    },
  206    [ :- dynamic(Dynamic),
  207
  208      persistency:persistent(Module, Generic, Term)
  209    ],
  210    assert_clause(asserta, Term, Module, LoadModule),
  211    assert_clause(assert,  Term, Module, LoadModule),
  212    retract_clause(Term, Module, LoadModule),
  213    retractall_clause(Term, Module, LoadModule).
  214
  215assert_clause(Where, Term, Module, LoadModule) -->
  216    { functor(Term, Name, Arity),
  217      atomic_list_concat([Where,'_', Name], PredName),
  218      length(Args, Arity),
  219      Head =.. [PredName|Args],
  220      Assert =.. [Name|Args],
  221      type_checkers(Args, 1, Term, Check),
  222      atom_concat(db_, Where, DBActionName),
  223      DBAction =.. [DBActionName, Module:Assert],
  224      qualify(Module, LoadModule, Head, QHead),
  225      Clause = (QHead :- Check, persistency:DBAction)
  226    },
  227    [ Clause ].
  228
  229type_checkers([], _, _, true).
  230type_checkers([A0|AL], I, Spec, Check) :-
  231    arg(I, Spec, ArgSpec),
  232    (   ArgSpec = _Name:Type,
  233        nonvar(Type),
  234        Type \== any
  235    ->  Check = (must_be(Type, A0),More)
  236    ;   More = Check
  237    ),
  238    I2 is I + 1,
  239    type_checkers(AL, I2, Spec, More).
  240
  241retract_clause(Term, Module, LoadModule) -->
  242    { functor(Term, Name, Arity),
  243      atom_concat(retract_, Name, PredName),
  244      length(Args, Arity),
  245      Head =.. [PredName|Args],
  246      Retract =.. [Name|Args],
  247      qualify(Module, LoadModule, Head, QHead),
  248      Clause = (QHead :- persistency:db_retract(Module:Retract))
  249    },
  250    [ Clause ].
  251
  252retractall_clause(Term, Module, LoadModule) -->
  253    { functor(Term, Name, Arity),
  254      atom_concat(retractall_, Name, PredName),
  255      length(Args, Arity),
  256      Head =.. [PredName|Args],
  257      Retract =.. [Name|Args],
  258      qualify(Module, LoadModule, Head, QHead),
  259      Clause = (QHead :- persistency:db_retractall(Module:Retract))
  260    },
  261    [ Clause ].
  262
  263qualify(Module, Module, Head, Head) :- !.
  264qualify(Module, _LoadModule, Head, Module:Head).
  265
  266
  267:- multifile
  268    system:term_expansion/2.  269
  270system:term_expansion((:- persistent(Spec)), Clauses) :-
  271    prolog_load_context(module, Module),
  272    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.
  280current_persistent_predicate(M:PName/Arity) :-
  281    persistency:persistent(M, Generic, _),
  282    functor(Generic, Name, Arity),
  283    (   Name = PName
  284    ;   atom_concat(assert_, Name, PName)
  285    ;   atom_concat(retract_, Name, PName)
  286    ;   atom_concat(retractall_, Name, PName)
  287    ).
  288
  289prolog:generated_predicate(PI) :-
  290    current_persistent_predicate(PI).
  291
  292
  293                 /*******************************
  294                 *            ATTACH            *
  295                 *******************************/
 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.

  311db_attach(Module:File, Options) :-
  312    db_set_options(Module, Options),
  313    db_attach_file(Module, File).
  314
  315db_set_options(Module, Options) :-
  316    option(sync(Sync), Options, flush),
  317    must_be(oneof([close,flush,none]), Sync),
  318    (   db_option(Module, sync(Sync))
  319    ->  true
  320    ;   retractall(db_option(Module, _)),
  321        assert(db_option(Module, sync(Sync)))
  322    ).
  323
  324db_attach_file(Module, File) :-
  325    db_file(Module, Old, _, _, _),         % we already have a db
  326    !,
  327    (   Old == File
  328    ->  (   db_stream(Module, Stream)
  329        ->  sync(Module, Stream)
  330        ;   true
  331        )
  332    ;   permission_error(attach, db, File)
  333    ).
  334db_attach_file(Module, File) :-
  335    db_load(Module, File),
  336    !.
  337db_attach_file(Module, File) :-
  338    assert(db_file(Module, File, 0, 0, 0)).
  339
  340db_load(Module, File) :-
  341    retractall(db_file(Module, _, _, _, _)),
  342    debug(db, 'Loading database ~w', [File]),
  343    catch(setup_call_cleanup(
  344              open(File, read, In, [encoding(utf8)]),
  345              load_db_end(In, Module, Created, EndPos),
  346              close(In)),
  347          error(existence_error(source_sink, File), _), fail),
  348    debug(db, 'Loaded ~w', [File]),
  349    time_file(File, Modified),
  350    assert(db_file(Module, File, Created, Modified, EndPos)).
  351
  352db_load_incremental(Module, File) :-
  353    db_file(Module, File, Created, _, EndPos0),
  354    setup_call_cleanup(
  355        ( open(File, read, In, [encoding(utf8)]),
  356          read_action(In, created(Created0)),
  357          set_stream_position(In, EndPos0)
  358        ),
  359        ( Created0 == Created,
  360          debug(db, 'Incremental load from ~p', [EndPos0]),
  361          load_db_end(In, Module, _Created, EndPos)
  362        ),
  363        close(In)),
  364    debug(db, 'Updated ~w', [File]),
  365    time_file(File, Modified),
  366    retractall(db_file(Module, File, Created, _, _)),
  367    assert(db_file(Module, File, Created, Modified, EndPos)).
  368
  369load_db_end(In, Module, Created, End) :-
  370    read_action(In, T0),
  371    (   T0 = created(Created)
  372    ->  read_action(In, T1)
  373    ;   T1 = T0,
  374        Created = 0
  375    ),
  376    load_db(T1, In, Module),
  377    stream_property(In, position(End)).
  378
  379load_db(end_of_file, _, _) :- !.
  380load_db(assert(Term), In, Module) :-
  381    persistent(Module, Term, _Types),
  382    !,
  383    assert(Module:Term),
  384    read_action(In, T1),
  385    load_db(T1, In, Module).
  386load_db(asserta(Term), In, Module) :-
  387    persistent(Module, Term, _Types),
  388    !,
  389    asserta(Module:Term),
  390    read_action(In, T1),
  391    load_db(T1, In, Module).
  392load_db(retractall(Term, Count), In, Module) :-
  393    persistent(Module, Term, _Types),
  394    !,
  395    retractall(Module:Term),
  396    set_dirty(Module, Count),
  397    read_action(In, T1),
  398    load_db(T1, In, Module).
  399load_db(retract(Term), In, Module) :-
  400    persistent(Module, Term, _Types),
  401    !,
  402    (   retract(Module:Term)
  403    ->  set_dirty(Module, 1)
  404    ;   true
  405    ),
  406    read_action(In, T1),
  407    load_db(T1, In, Module).
  408load_db(Term, In, Module) :-
  409    print_message(error, illegal_term(Term)),
  410    read_action(In, T1),
  411    load_db(T1, In, Module).
  412
  413db_clean(Module) :-
  414    retractall(db_dirty(Module, _)),
  415    (   persistent(Module, Term, _Types),
  416        retractall(Module:Term),
  417        fail
  418    ;   true
  419    ).
 db_size(+Module, -Terms) is det
Terms is the total number of terms in the DB for Module.
  425db_size(Module, Total) :-
  426    aggregate_all(sum(Count), persistent_size(Module, Count), Total).
  427
  428persistent_size(Module, Count) :-
  429    persistent(Module, Term, _Types),
  430    predicate_property(Module:Term, number_of_clauses(Count)).
 db_attached(:File) is semidet
True if the context module attached to the persistent database File.
  436db_attached(Module:File) :-
  437    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.
  445:- public
  446    db_assert/1,
  447    db_asserta/1,
  448    db_retractall/1,
  449    db_retract/1.  450
  451db_assert(Term)     :- with_mutex('$persistency', db_assert_sync(Term)).
  452db_asserta(Term)    :- with_mutex('$persistency', db_asserta_sync(Term)).
  453db_retract(Term)    :- with_mutex('$persistency', db_retract_sync(Term)).
  454db_retractall(Term) :- with_mutex('$persistency', db_retractall_sync(Term)).
  455
  456db_assert_sync(Module:Term) :-
  457    assert(Module:Term),
  458    persistent(Module, assert(Term)).
  459
  460db_asserta_sync(Module:Term) :-
  461    asserta(Module:Term),
  462    persistent(Module, asserta(Term)).
  463
  464persistent(Module, Action) :-
  465    (   db_stream(Module, Stream)
  466    ->  true
  467    ;   db_file(Module, File, _Created, _Modified, _EndPos)
  468    ->  db_sync(Module, update),            % Is this correct?
  469        db_open_file(File, append, Stream),
  470        assert(db_stream(Module, Stream))
  471    ;   existence_error(db_file, Module)
  472    ),
  473    write_action(Stream, Action),
  474    sync(Module, Stream).
  475
  476db_open_file(File, Mode, Stream) :-
  477    open(File, Mode, Stream,
  478         [ close_on_abort(false),
  479           encoding(utf8),
  480           lock(write)
  481         ]),
  482    (   size_file(File, 0)
  483    ->  get_time(Now),
  484        write_action(Stream, created(Now))
  485    ;   true
  486    ).
 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.
  497db_detach :-
  498    context_module(Module),
  499    db_sync(Module:detach),
  500    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.
  512sync(Module, Stream) :-
  513    db_option(Module, sync(Sync)),
  514    (   Sync == close
  515    ->  db_sync(Module, close)
  516    ;   Sync == flush
  517    ->  flush_output(Stream)
  518    ;   true
  519    ).
  520
  521read_action(Stream, Action) :-
  522    read_term(Stream, Action, [module(db)]).
  523
  524write_action(Stream, Action) :-
  525    \+ \+ ( numbervars(Action, 0, _, [singletons(true)]),
  526            format(Stream, '~W.~n',
  527                   [ Action,
  528                     [ quoted(true),
  529                       numbervars(true),
  530                       module(db)
  531                     ]
  532                   ])
  533          ).
 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.
  541db_retractall_sync(Module:Term) :-
  542    (   var(Term)
  543    ->  forall(persistent(Module, Term, _Types),
  544               db_retractall(Module:Term))
  545    ;   State = count(0),
  546        (   retract(Module:Term),
  547            arg(1, State, C0),
  548            C1 is C0+1,
  549            nb_setarg(1, State, C1),
  550            fail
  551        ;   arg(1, State, Count)
  552        ),
  553        (   Count > 0
  554        ->  set_dirty(Module, Count),
  555            persistent(Module, retractall(Term, Count))
  556        ;   true
  557        )
  558    ).
 db_retract(:Term) is nondet
Retract terms from the database one-by-one.
  565db_retract_sync(Module:Term) :-
  566    (   var(Term)
  567    ->  instantiation_error(Term)
  568    ;   retract(Module:Term),
  569        set_dirty(Module, 1),
  570        persistent(Module, retract(Term))
  571    ).
  572
  573
  574set_dirty(_, 0) :- !.
  575set_dirty(Module, Count) :-
  576    (   retract(db_dirty(Module, C0))
  577    ->  true
  578    ;   C0 = 0
  579    ),
  580    C1 is C0 + Count,
  581    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 greater than the given percentage of the total number of terms.
gc(always)
GC DB without checking the percentage.
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.

  614db_sync(Module:What) :-
  615    db_sync(Module, What).
  616
  617
  618db_sync(Module, reload) :-
  619    \+ db_stream(Module, _),                % not open
  620    db_file(Module, File, _Created, ModifiedWhenLoaded, _EndPos),
  621    catch(time_file(File, Modified), _, fail),
  622    Modified > ModifiedWhenLoaded,         % Externally modified
  623    !,
  624    debug(db, 'Database ~w was externally modified; reloading', [File]),
  625    !,
  626    (   catch(db_load_incremental(Module, File),
  627              E,
  628              ( print_message(warning, E), fail ))
  629    ->  true
  630    ;   db_clean(Module),
  631        db_load(Module, File)
  632    ).
  633db_sync(Module, gc) :-
  634    !,
  635    db_sync(Module, gc(50)).
  636db_sync(Module, gc(When)) :-
  637    (   When == always
  638    ->  true
  639    ;   db_dirty(Module, Dirty),
  640        db_size(Module, Total),
  641        (   Total > 0
  642        ->  Perc is (100*Dirty)/Total,
  643            Perc > When
  644        ;   Dirty > 0
  645        )
  646    ),
  647    !,
  648    db_sync(Module, close),
  649    db_file(Module, File, _, Modified, _),
  650    atom_concat(File, '.new', NewFile),
  651    debug(db, 'Database ~w is dirty; cleaning', [File]),
  652    get_time(Created),
  653    catch(setup_call_cleanup(
  654              db_open_file(NewFile, write, Out),
  655              (   persistent(Module, Term, _Types),
  656                  call(Module:Term),
  657                  write_action(Out, assert(Term)),
  658                  fail
  659              ;   stream_property(Out, position(EndPos))
  660              ),
  661              close(Out)),
  662          Error,
  663          ( catch(delete_file(NewFile),_,fail),
  664            throw(Error))),
  665    retractall(db_file(Module, File, _, Modified, _)),
  666    rename_file(NewFile, File),
  667    time_file(File, NewModified),
  668    assert(db_file(Module, File, Created, NewModified, EndPos)).
  669db_sync(Module, close) :-
  670    retract(db_stream(Module, Stream)),
  671    !,
  672    db_file(Module, File, Created, _, _),
  673    debug(db, 'Database ~w is open; closing', [File]),
  674    stream_property(Stream, position(EndPos)),
  675    close(Stream),
  676    time_file(File, Modified),
  677    retractall(db_file(Module, File, _, _, _)),
  678    assert(db_file(Module, File, Created, Modified, EndPos)).
  679db_sync(Module, Action) :-
  680    Action == detach,
  681    !,
  682    (   retract(db_stream(Module, Stream))
  683    ->  close(Stream)
  684    ;   true
  685    ),
  686    retractall(db_file(Module, _, _, _, _)),
  687    retractall(db_dirty(Module, _)),
  688    retractall(db_option(Module, _)).
  689db_sync(_, nop) :- !.
  690db_sync(_, _).
 db_sync_all(+What)
Sync all registered databases.
  697db_sync_all(What) :-
  698    must_be(oneof([reload,gc,gc(_),close]), What),
  699    forall(db_file(Module, _, _, _, _),
  700           db_sync(Module:What)).
  701
  702
  703                 /*******************************
  704                 *             CLOSE            *
  705                 *******************************/
  706
  707close_dbs :-
  708    forall(retract(db_stream(_Module, Stream)),
  709           close(Stream)).
  710
  711:- at_halt(close_dbs).