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:

name(Arg, ...)
assert_name(Arg, ...)
retract_name(Arg, ...)
retractall_name(Arg, ...)

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 *******************************/

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).

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 *******************************/

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 ).

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)).

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 ).

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 ).

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 ).

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)).

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(_, _).

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).