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:- autoload(library(aggregate),[aggregate_all/3]).   49:- autoload(library(debug),[debug/3]).   50:- autoload(library(error),
   51	    [ instantiation_error/1,
   52	      must_be/2,
   53	      permission_error/3,
   54	      existence_error/2
   55	    ]).   56:- autoload(library(option),[option/3]).   57
   58
   59:- predicate_options(db_attach/2, 2,
   60                     [ sync(oneof([close,flush,none]))
   61                     ]).

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? */
  124:- meta_predicate
  125    db_attach(:, +),
  126    db_attached(:),
  127    db_sync(:),
  128    current_persistent_predicate(:).  129:- module_transparent
  130    db_detach/0.  131
  132
  133                 /*******************************
  134                 *              DB              *
  135                 *******************************/
  136
  137:- dynamic
  138    db_file/5,                      % Module, File, Created, Modified, EndPos
  139    db_stream/2,                    % Module, Stream
  140    db_dirty/2,                     % Module, Deleted
  141    db_option/2.                    % Module, Name(Value)
  142
  143:- volatile
  144    db_stream/2.  145
  146:- multifile
  147    (persistent)/3,                 % Module, Generic, Term
  148    prolog:generated_predicate/1.  149
  150
  151                 /*******************************
  152                 *         DECLARATIONS         *
  153                 *******************************/
 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).

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

  299db_attach(Module:File, Options) :-
  300    db_set_options(Module, Options),
  301    db_attach_file(Module, File).
  302
  303db_set_options(Module, Options) :-
  304    option(sync(Sync), Options, flush),
  305    must_be(oneof([close,flush,none]), Sync),
  306    (   db_option(Module, sync(Sync))
  307    ->  true
  308    ;   retractall(db_option(Module, _)),
  309        assert(db_option(Module, sync(Sync)))
  310    ).
  311
  312db_attach_file(Module, File) :-
  313    db_file(Module, Old, _, _, _),         % we already have a db
  314    !,
  315    (   Old == File
  316    ->  (   db_stream(Module, Stream)
  317        ->  sync(Module, Stream)
  318        ;   true
  319        )
  320    ;   permission_error(attach, db, File)
  321    ).
  322db_attach_file(Module, File) :-
  323    db_load(Module, File),
  324    !.
  325db_attach_file(Module, File) :-
  326    assert(db_file(Module, File, 0, 0, 0)).
  327
  328db_load(Module, File) :-
  329    retractall(db_file(Module, _, _, _, _)),
  330    debug(db, 'Loading database ~w', [File]),
  331    catch(setup_call_cleanup(
  332              open(File, read, In, [encoding(utf8)]),
  333              load_db_end(In, Module, Created, EndPos),
  334              close(In)),
  335          error(existence_error(source_sink, File), _), fail),
  336    debug(db, 'Loaded ~w', [File]),
  337    time_file(File, Modified),
  338    assert(db_file(Module, File, Created, Modified, EndPos)).
  339
  340db_load_incremental(Module, File) :-
  341    db_file(Module, File, Created, _, EndPos0),
  342    setup_call_cleanup(
  343        ( open(File, read, In, [encoding(utf8)]),
  344          read_action(In, created(Created0)),
  345          set_stream_position(In, EndPos0)
  346        ),
  347        ( Created0 == Created,
  348          debug(db, 'Incremental load from ~p', [EndPos0]),
  349          load_db_end(In, Module, _Created, EndPos)
  350        ),
  351        close(In)),
  352    debug(db, 'Updated ~w', [File]),
  353    time_file(File, Modified),
  354    retractall(db_file(Module, File, Created, _, _)),
  355    assert(db_file(Module, File, Created, Modified, EndPos)).
  356
  357load_db_end(In, Module, Created, End) :-
  358    read_action(In, T0),
  359    (   T0 = created(Created)
  360    ->  read_action(In, T1)
  361    ;   T1 = T0,
  362        Created = 0
  363    ),
  364    load_db(T1, In, Module),
  365    stream_property(In, position(End)).
  366
  367load_db(end_of_file, _, _) :- !.
  368load_db(assert(Term), In, Module) :-
  369    persistent(Module, Term, _Types),
  370    !,
  371    assert(Module:Term),
  372    read_action(In, T1),
  373    load_db(T1, In, Module).
  374load_db(asserta(Term), In, Module) :-
  375    persistent(Module, Term, _Types),
  376    !,
  377    asserta(Module:Term),
  378    read_action(In, T1),
  379    load_db(T1, In, Module).
  380load_db(retractall(Term, Count), In, Module) :-
  381    persistent(Module, Term, _Types),
  382    !,
  383    retractall(Module:Term),
  384    set_dirty(Module, Count),
  385    read_action(In, T1),
  386    load_db(T1, In, Module).
  387load_db(retract(Term), In, Module) :-
  388    persistent(Module, Term, _Types),
  389    !,
  390    (   retract(Module:Term)
  391    ->  set_dirty(Module, 1)
  392    ;   true
  393    ),
  394    read_action(In, T1),
  395    load_db(T1, In, Module).
  396load_db(Term, In, Module) :-
  397    print_message(error, illegal_term(Term)),
  398    read_action(In, T1),
  399    load_db(T1, In, Module).
  400
  401db_clean(Module) :-
  402    retractall(db_dirty(Module, _)),
  403    (   persistent(Module, Term, _Types),
  404        retractall(Module:Term),
  405        fail
  406    ;   true
  407    ).
 db_size(+Module, -Terms) is det
Terms is the total number of terms in the DB for Module.
  413db_size(Module, Total) :-
  414    aggregate_all(sum(Count), persistent_size(Module, Count), Total).
  415
  416persistent_size(Module, Count) :-
  417    persistent(Module, Term, _Types),
  418    predicate_property(Module:Term, number_of_clauses(Count)).
 db_attached(:File) is semidet
True if the context module attached to the persistent database File.
  424db_attached(Module:File) :-
  425    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.
  433:- public
  434    db_assert/1,
  435    db_asserta/1,
  436    db_retractall/1,
  437    db_retract/1.  438
  439db_assert(Module:Term) :-
  440    assert(Module:Term),
  441    persistent(Module, assert(Term)).
  442
  443db_asserta(Module:Term) :-
  444    asserta(Module:Term),
  445    persistent(Module, asserta(Term)).
  446
  447persistent(Module, Action) :-
  448    (   db_stream(Module, Stream)
  449    ->  true
  450    ;   db_file(Module, File, _Created, _Modified, _EndPos)
  451    ->  db_sync(Module, update),            % Is this correct?
  452        db_open_file(File, append, Stream),
  453        assert(db_stream(Module, Stream))
  454    ;   existence_error(db_file, Module)
  455    ),
  456    write_action(Stream, Action),
  457    sync(Module, Stream).
  458
  459db_open_file(File, Mode, Stream) :-
  460    open(File, Mode, Stream,
  461         [ close_on_abort(false),
  462           encoding(utf8),
  463           lock(write)
  464         ]),
  465    (   size_file(File, 0)
  466    ->  get_time(Now),
  467        write_action(Stream, created(Now))
  468    ;   true
  469    ).
 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.
  480db_detach :-
  481    context_module(Module),
  482    db_sync(Module:detach),
  483    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.
  495sync(Module, Stream) :-
  496    db_option(Module, sync(Sync)),
  497    (   Sync == close
  498    ->  db_sync(Module, close)
  499    ;   Sync == flush
  500    ->  flush_output(Stream)
  501    ;   true
  502    ).
  503
  504read_action(Stream, Action) :-
  505    read_term(Stream, Action, [module(db)]).
  506
  507write_action(Stream, Action) :-
  508    \+ \+ ( numbervars(Action, 0, _, [singletons(true)]),
  509            format(Stream, '~W.~n',
  510                   [ Action,
  511                     [ quoted(true),
  512                       numbervars(true),
  513                       module(db)
  514                     ]
  515                   ])
  516          ).
 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.
  524db_retractall(Module:Term) :-
  525    (   var(Term)
  526    ->  forall(persistent(Module, Term, _Types),
  527               db_retractall(Module:Term))
  528    ;   State = count(0),
  529        (   retract(Module:Term),
  530            arg(1, State, C0),
  531            C1 is C0+1,
  532            nb_setarg(1, State, C1),
  533            fail
  534        ;   arg(1, State, Count)
  535        ),
  536        (   Count > 0
  537        ->  set_dirty(Module, Count),
  538            persistent(Module, retractall(Term, Count))
  539        ;   true
  540        )
  541    ).
 db_retract(:Term) is nondet
Retract terms from the database one-by-one.
  548db_retract(Module:Term) :-
  549    (   var(Term)
  550    ->  instantiation_error(Term)
  551    ;   retract(Module:Term),
  552        set_dirty(Module, 1),
  553        persistent(Module, retract(Term))
  554    ).
  555
  556
  557set_dirty(_, 0) :- !.
  558set_dirty(Module, Count) :-
  559    (   retract(db_dirty(Module, C0))
  560    ->  true
  561    ;   C0 = 0
  562    ),
  563    C1 is C0 + Count,
  564    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.

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