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