1:- module( prosqlite,
    2          [ sqlite_connect/2,           % +FileName, -Conn
    3            sqlite_connect/3,           % +FileName, -Conn, +Opts
    4            sqlite_disconnect/1,        % +Conn
    5            sqlite_current_connection/1,% -Conn
    6            sqlite_query/2,             % +SQL, -Row
    7            sqlite_query/3,             % +Conn, +SQL, -Row
    8            sqlite_format_query/3,      % +Conn, +SQL, -Row
    9            sqlite_current_table/2,     % +Conn, -Table
   10            sqlite_current_table/3,     % +Conn, ?Table, -Facet
   11            sqlite_table_column/3,      % +Conn, ?Table, ?Column
   12            sqlite_table_column/4,      % +Conn, ?Table, ?Column, -Facet
   13            sqlite_table_count/3,       % +Conn, +Table, -Count
   14            sqlite_default_connection/1,% -Conn
   15            sqlite_date_sql_atom/2,     % ?Date, ?SqlAtom
   16            sqlite_pragma/3,            % ?Date, ?SqlAtom
   17            sqlite_version/2,           % -Version, -Date
   18            sqlite_binary_version/2,    % -Version, -Date
   19            sqlite_citation/2           % -Atom, Bibterm
   20          ] ).   21
   22:- use_module(library(lists)).  % append/3, member/2, memberchk/2.
   23:- use_module(library(apply)).  % maplist/2,3.
   24:- use_module( library(debug) ).   25
   26:- at_halt( sqlite_disconnect ).   27
   28:- use_module(library(shlib)).   29:- load_foreign_library(foreign(prosqlite)).   30
   31:- dynamic(sqlite_connection/3).   32:- dynamic(sqlite_db:sqlite_asserted/4).

proSQLite: a Prolog interface to the SQLite database system.

This library follows the design and borrows code from the ODBC library of SWI-Prolog http://www.swi-prolog.org/pldoc/packasqlite_connectge/odbc.html .

The SQLite system is a powerful zero-configuration management systme that interacts with single-file databases that are cross-platform compatible binaries.

ProSQLite provides three layers of interaction with SQLite databases. At the lower level is the querying via SQL statements. A second layer allows the interogation of the database dictionary, and the final level facilitates the viewing of database tables as predicates. See the publication pointed to by sqlite_citation/2, for further details. If you use prosqlite in your research, please consider citing this publication.

The library has been developed and tested on SWI 6.3.2 but it should also work on YAP Prolog.

The easiest way to install on SWI is via the package manager. Simply do:

     ?- pack_install( prosqlite ).

And you are good to go.

There are good/full examples in the sources, directory examples/. For instance test by :

     ?- [predicated].
     ?- predicated.

There is a sister package, db_facts (also installable via the manager). Db_facts, allow interaction with the underlying database via Prolog terms, That library can also be used as a common compatibility layer for the ODBC and proSQLite libraries of SWI-Prolog, as it works on both type of connections.

ProSQLite is debug/1 aware: call debug(sqlite) to see what is sent to the sqlite engine.

There are MS wins DLLs included in the sources and recent version of the SWI package manager will install these properly.

Thanks to Samer Abdallah for 2 fixes. One on mapping blobs to strings and second for handling UTF text correctly.

Thanks to Christian Gimenez for suggesting replacing sqlite3_close() with sqlite3_close_(). The former returns the unhandled SQLITE_BUSY if there unfinalzed statements. _v2 is designed for garbage collected languages, see http://sqlite.org/c3ref/close.html.

Thanks to Wolfram Diestel for spotting a bug in opening 2 dbs with distinct aliases.

Thanks to Steve Moyle for contributing safe_column_names/2 (Nov 2016).

author
- Nicos Angelopoulos
- Sander Canisius
version
- 1.0, 2014/12/24
- 1.1, 2016/10/9 changed to sqlite3_close() and fixed alias bug
- 1.2, 2016/11/22 added safe_column_names/2
- 1.4, 2018/3/18 fixed blobs support (see examples/two.pl), and logic for already opened file
- 1.6, 2020/5/29 recompiled for SWI 8.2
- 1.7, 2022/4/30 print message if new db file cannot be created
- 1.8, 2022/5/29 fixed major bug of deleting existing files introduced in 1.7 + minor doc + aarch64-linux binary
See also
- Sander Canisius, Nicos Angelopoulos and Lodewyk Wessels. proSQLite: Prolog file based databases via an SQLite interface. In the proceedings of Practical Aspects of Declarative languages (PADL 2013), (2013, Rome, Italy).
- Sander Canisius, Nicos Angelopoulos and Lodewyk Wessels. Exploring file based databases via an Sqlite interface. In the ICLP Workshop on Logic-based methods in Programming Environments, p. 2-9, (2012, Budapest, Hungary).
- http://stoics.org.uk/~nicos/pbs/padl2013-prosqlite.pdf
- http://stoics.org.uk/~nicos/sware/prosqlite
- http://stoics.org.uk/~nicos/sware/db_facts
- http://www.sqlite.org/
- files in examples/ directory
- also available as a SWI pack http://www.swi-prolog.org/pack/list
license
- MIT
To be done
- set pragmas

*/

  111/* defaults and start ups */
  112arity_flag_values( [arity,unary,both,palette] ).
  113
  114%-Section interface predicates
  115%
 sqlite_version(-Version, -Date)
The current version and its publication date.

Version is a Mj:Mn:Fx term and date is a date(Y,M,D) term.

 ? sqlite_version(V, D).
 V = 1:8:0,
 D = date(2022, 5, 29).
author
- nicos angelopoulos
  131sqlite_version( 1:8:0, date(2022,5,29) ).  
 sqlite_binary_version(-Version, -Date)
The current version of the binaries. If the installed binaries are not compiled from the sources, then this might be different (=older) that the sqlite Porlog source version returned by sqlite_version/2. Version is a Mj:Mn:Fx term, and date is a date(Y,M,D) term.
  138sqlite_binary_version( Ver, Date ) :-
  139     c_sqlite_version( Ver, Date ).
 sqlite_citation(-Atom, -Bibterm)
Succeeds once for each publication related to this library. Atom is the atom representation suitable for printing while Bibterm is a bibtex(Type,Key,Pairs) term of the same publication. Produces all related publications on backtracking.
  145sqlite_citation( Atom, bibtex(Type,Key,Pairs) ) :-
  146     Atom = 'Sander Canisius, Nicos Angelopoulos and Lodewyk Wessels. proSQLite: Prolog file based databases via an SQLite interface.  In the proceedings of Practical Aspects of Declarative languages (PADL 2013), (2013, Rome, Italy).',
  147     Type = inproceedings,
  148     Key  = 'CanisiusS+2013',
  149     Pairs = [
  150          author = 'Sander Canisius and Nicos Angelopoulos and Lodewyk Wessels',
  151          title  = 'Exploring file based databases via an Sqlite interface',
  152          booktitle = 'In ICLP Workshop on Logic-based methods in Programming Environments (WLPE\'12)',
  153          year = 2012,
  154          pages= '2-9',
  155          month = 'September',
  156          address = 'Budapest, Hungary',
  157          url     = 'http://stoics.org.uk/~nicos/pbs/padl2013-prosqlite.pdf'
  158     ].
  159     
  160sqlite_citation( Atom, bibtex(Type,Key,Pairs) ) :-
  161     Atom = 'Exploring file based databases via an Sqlite interface. \n Canisius Sander, Nicos Angelopoulos and Lodewyk Wessels \n In the ICLP Workshop on Logic-based methods in Programming Environments (WLPE\'12),\n p.2-9, 2012. Budapest, Hungary.',
  162     Type = inproceedings,
  163     Key  = 'CanisiusS+2012',
  164     Pairs = [
  165          author = 'Sander Canisius and Nicos Angelopoulos and Lodewyk Wessels',
  166          title  = 'Exploring file based databases via an Sqlite interface',
  167          booktitle = 'In ICLP Workshop on Logic-based methods in Programming Environments (WLPE\'12)',
  168          year = 2012,
  169          pages= '2-9',
  170          month = 'September',
  171          address = 'Budapest, Hungary',
  172          url     = 'http://stoics.org.uk/~nicos/pbs/wlpe2012_sqlite.pdf'
  173     ].
 sqlite_connect(+File, ?Alias)
Open a connection to an sqlite File. If Alias is a variable, an opaque atom is generated and unified to it. The opened db connection to file can be accessed via Alias.
  sqlite_connect('uniprot.sqlite', uniprot).
  185sqlite_connect(File, Conn) :-
  186     sqlite_connect(File, Conn, []).
 sqlite_connect(+File, ?Connection, +Options)
Open a connection to an sqlite File. If Connection is unbound then if (a) alias(Alias) option is given, Connection is bound to Alias, else (b) an opaque atom is generated. If Connection is ground, the opened can be accessed with Connection as a handle. Options is a sinlge term or a list of terms from the following:
alias(Atom)
identify the connection as Alias (no default, interplays with Connection)
as_predicates(AsPred=false)
if true, create hook predicates that map each sqlite table to a prolog predicate. These are created in module user (see at_module()). The user should make sure the predicate is not previously defined.
at_module(AtMod=user)
the module at which the predicates will be asserted at (if as_predicates(true)) is also given)
arity(Arity=arity)
Arity denotes the arity of access clauses to be added in the prolog database that correspond to SQLite tables. The default is arity, which asserts a predicate matching the arity of the table. both adds two predicates, one matching the arity and a single argument one. The later can be interrogated with something like
?-  phones( [name=naku, telephone=T] ).

unary only adds the unary version, and palette adds a suite of predicates with arities from 1 to N, where N is the number of columns. These can be interrogated by :

?-  phones( name=Name ).
?-  phones( name=naku, telephone=T ).
?-  phones( [name=naku, telephone=T] ).

Predicated tables can be used to insert values to the database by virtue of all their columns are give ground values.

exists(Exists=true)
do not throw an error if file does not exist and Exists is false.
ext(Ext=sqlite)
database files are assumed to have an sqlite extension. To ovewrite this give a different Ext or '' for no extension.
table_as(Table, Pname, Arity)
map the table to predicate with name Pname. Arity should be defined for this representaition as per arity() option.
verbose(Verb=false)
Iff Verb==true print messages- currently about file used.

When unary predicates are defined the columns can be interrogated/accessed by list pairs of the form Column=Value. Column-Value and Column:Value are also recognised.

So for example, for table phones with columns Name, Address and Phone, prosqlite will add

     phones(_,_,_)
as a response to as_predicates, and
     phones(_)

if Arity is unary.

The latter can be interrogated by

     phones( ['Name'=naku','Phone'=Phone] ).

which will return the phone number(s) associated with individual named by naku.

author
- nicos angelopoulos
version
- 0.2 2018/03/17, fixed logic for existing connection to a file (existing alias is returned)
- 0.3 2022/04/30, add permissions error message, if new sqlite file cannot be created
See also
- examples/predicated.pl .
- pack(prosqlite/examples/two.pl)

*/

  273sqlite_connect(FileIn, Conn, OptIn) :-
  274     to_list( OptIn, Opts ),
  275     ( memberchk(ext(Ext),Opts) -> true; Ext=sqlite ),
  276     ( file_name_extension(_,Ext,FileIn) -> File=FileIn; file_name_extension(FileIn,Ext,File) ),
  277     sqlite_connect_1(File, Conn, Opts).
  278
  279sqlite_connect_1(File, _Conn, Opts) :-
  280     \+ exists_file(File),
  281     \+ memberchk(exists(false), Opts),
  282     !,
  283     open(File, read, _). % just so it throws a nice error
  284sqlite_connect_1(File1, Conn, Opts) :-
  285     sqlite_alias(Opts, Conn, Alias),
  286     \+ var(Alias),
  287     sqlite_connection(Alias,File2,_),
  288     !,
  289     ( File1==File2 -> 
  290          print_message( informational, sqlite(connection_already_open(Conn)) )
  291          ;
  292          sqlite_error( alias_in_use(Alias,File2) )
  293     ).
  294sqlite_connect_1(File, Alias, Opts) :-
  295     sqlite_alias(Opts, Conn, Alias),
  296     ( sqlite_connection(_Conn1,File,Alias1) ->
  297        Alias1 = Alias,
  298        ( (memberchk(verbose(Verb),Opts),Verb==true) -> 
  299                print_message( informational, sqlite(file_already_open(File,Alias1)) )
  300                ;
  301                true
  302        )
  303        ;
  304        ( (memberchk(verbose(Verb),Opts),Verb==true) -> 
  305            print_message( informational, sqlite(db_at(File)) )
  306            ;
  307            true
  308        ),
  309        % 22.04.30: adding the following 2 commands to get an informative error when file cannot be open for updating (report on github by korvo)
  310        open( File, append, TmpStream ),
  311        close( TmpStream ),
  312        c_sqlite_connect(File, Conn),
  313        asserta( sqlite_connection(Alias,File,Conn) ),
  314        ( sqlite_establish_predicates(Opts, Conn) ->
  315            true
  316            ;
  317            retractall( sqlite_connection(Alias,File,Conn) ),
  318            c_sqlite_disconnect(Conn),
  319            sqlite_error( predicated_creation_error(File,Alias) )
  320        )
  321    ).
  322
  323/*
  324sqlite_connect(File, Conn, Opts) :-
  325     c_sqlite_connect(File, Internal),
  326     !,
  327     assert( sqlite_connection(Conn,File,Internal) ). 
  328     */
  329
  330% this is currently private only for use with at_halt.
  331% 
  332sqlite_disconnect :-
  333     sqlite_connection(Alias,_,_),
  334     sqlite_disconnect( Alias ),
  335     fail.
  336sqlite_disconnect.
 sqlite_disconnect(+Alias)
Terminate the connection to a SQLite database file.
  sqlite_disconnect(uniprot).
  346sqlite_disconnect( Alias ) :-
  347     once( sqlite_connection(Alias,_,Conn) ),
  348     !,
  349     debug( sqlite, 'Disconnecting from db with alias: ~w.', [Alias] ),
  350     c_sqlite_disconnect( Conn ),
  351     retractall( sqlite_connection(Alias,_,Conn) ),
  352     findall( pam(Pname,Arity,Mod), sqlite_db:sqlite_asserted(Conn,Pname,Arity,Mod), PAs ),
  353     maplist( sqlite_clean_up_predicated_for(Conn), PAs ).
  354
  355sqlite_disconnect( Alias ) :-
  356     sqlite_fail( not_a_connection(Alias) ).
  357
  358sqlite_clean_up_predicated_for( Conn, pam(Pname,Arity,Mod) ) :-
  359     % functor( Head, Pname, Arity ),
  360     % retractall( Mod:Head ),
  361     abolish( Mod:Pname, Arity ),
  362     retractall( sqlite_db:sqlite_asserted(Conn,Pname,Arity,Mod) ).
 sqlite_current_connection(-Connection)
Return or interrogate the name of open connection handles.
  368sqlite_current_connection(Conn) :-
  369     sqlite_connection(Conn,_,_).
 sqlite_default_connection(-Connection)
Return or interrogate the name of the default connection. This is the last connection opened.
  376sqlite_default_connection(Alias) :-
  377     sqlite_connection(Alias,_,_),
  378     !.
 sqlite_query(+Sql, -Row)
Post an Sql query to default connection and get row result in Row.
  384sqlite_query(Sql, Row) :-
  385     sqlite_default_connection(Alias),
  386     sqlite_query(Alias, Sql, Row).
 sqlite_query(+Connection, +Sql, -Row)
Post an Sql query to Sqlite Connection and get row result in Row.
  392sqlite_query(Alias, Query, Row) :-
  393     sqlite_alias_connection(Alias, Connection),
  394     debug( sqlite, 'Alias: ~w, sending: ~a', [Alias,Query] ),
  395     c_sqlite_query(Connection, Query, Row).
 sqlite_format_query(+Connection, +FAs, -Row)
Post a format style Sql query to Sqlite Connection and get row result in Row. FAs is a - pair structure : Format-Arguments.
   sqlite_format_query(uniprot, 'PRAGMA table_info(~w)'-Table, row(_, Column, _, _, _, _))
  407sqlite_format_query(Alias, Format-Arguments, Row) :-
  408    format(atom(Query), Format, Arguments),
  409    sqlite_query(Alias, Query, Row).
 sqlite_current_table(+Connection, -Table)
Return or interrogate tables in the Sqlite database associated with Connection.
  415sqlite_current_table(Alias, Table) :-
  416    var( Table ),
  417    !,
  418    sqlite_query(Alias, 'SELECT name FROM sqlite_master WHERE type = "table"', row(Table)).
  419sqlite_current_table(Alias, Table) :-
  420    ground( Table ),
  421    sqlite_query(Alias, 'SELECT name FROM sqlite_master WHERE type = "table"', row(TableIn)),
  422    %13.10.26: have a look at the C code above to see if 'row(Table)' can work on the above line.
  423    Table = TableIn,
  424    !.
 sqlite_current_table(+Connection, ?Table, -Facet)
Facet is a property of Table found at Connection. Currently only arity(Arity) is delivered.
  430sqlite_current_table(Connection, Table, Facet ) :-
  431     sqlite_current_table(Connection, Table),
  432     sqlite_facet_table( Facet, Connection, Table ).
 sqlite_table_column(+Connection, ?Table, -Column)
Return or interrogate tables and columns in the Sqlite database associated with Connection.
  438sqlite_table_column( Alias, Table, Column ) :-
  439     set_table( Alias, Table ),
  440    sqlite_format_query(Alias, 'PRAGMA table_info(~w)'-Table, row(_, Column, _, _, _, _)).
 sqlite_table_column(+Connection, ?Table, ?Column, -Facet)
Facet is one of:
  451sqlite_table_column(Alias, Table, Column, Facet) :-
  452    set_table( Alias, Table ),
  453    sqlite_format_query(Alias, 'PRAGMA table_info(~w)'-Table, Row ),
  454    Row = row(_, Column, _, _, _, _),
  455    sqlite_pragma_info_facet( Row, Facet ).
  456
  457sqlite_pragma_info_facet( row(Nth0,_,_,_,_,_), position(Nth0) ).
  458sqlite_pragma_info_facet( row(_,_,Dtype,_,_,_), data_type(Dtype) ).
  459sqlite_pragma_info_facet( row(_,_,_,Null,_,_), nullable(Null) ).  % fixme, ensure same semantics as ODBC
  460sqlite_pragma_info_facet( row(_,_,_,_,Default,_), default(Default) ).
  461sqlite_pragma_info_facet( row(_,_,_,_,_,Key), primary_key(Key) ).
 sqlite_pragma(+Alias, +Pragma, -Row)
Interrogate SQLite Pragmas. Currently only reading is supported. Pragma can be an atom or a - separated pair, as in table_info-TableName.
     sqlite_pragma( phone_db, encoding, Row).
  471sqlite_pragma( Alias, Pragma-Par, Row ) :-
  472     !,
  473     atomic_list_concat( ['PRAGMA',Pragma,'(~w)'],' ', Query ), 
  474    sqlite_format_query( Alias, Query-Par, Row ).
  475sqlite_pragma( Alias, Pragma, Row ) :-
  476     atomic_list_concat( ['PRAGMA',Pragma],' ', Query ), 
  477    sqlite_query( Alias, Query, Row ).
  478
  479% pragmas_info( [...,encoding,...,secure_delete,synchronous,temp_store,writable_schema] ).
  480pragmas_comm( [shrink_memory] ).
  481
  482
  483set_table( Alias, Table ) :-
  484     ( var(Table) -> 
  485          sqlite_current_table(Alias, Table) 
  486          ;
  487          true
  488     ).
 sqlite_table_count(+Connection, +Table, -Count)
True if Count is the number of rows in Sqlite Connection associated Table.
  494sqlite_table_count(Alias, Table, Count) :-
  495     Sel = 'Select count (*) from ~w',
  496    sqlite_format_query(Alias, Sel-Table, row(Count)),
  497     !.
 sqlite_date_sql_atom(Date, Sql)
Convert between a Prolog date/3 term and an Sql atom. The conversion is bidirectional. */
  504sqlite_date_sql_atom( date(Y,M,D), Sql ) :-
  505     ground( Sql ), 
  506     !,
  507     atomic_list_concat( Consts, '/', Sql ),
  508     maplist( atom_number, Consts, [Y,M,D] ).
  509sqlite_date_sql_atom( date(Y,M,D), Sql ) :-
  510     atomic_list_concat( ['"',Y], Ya ),
  511     atomic_list_concat( [D,'"'], Da ),
  512     atomic_list_concat( [Ya,M,Da], '/', Sql ).
  513
  514
  515%-Section non-interface sqlite specific predicates
  516%
  517
  518sqlite_alias(Opts, _Conn, Alias) :-
  519     memberchk(alias(Alias), Opts),
  520     !.
  521sqlite_alias(_Opts, _Conn, Alias ) :-
  522     atomic( Alias ),
  523     !.
  524sqlite_alias(_Opts, Conn, Conn).
  525
  526sqlite_establish_predicates( Opts, Conn ) :-
  527     memberchk(as_predicates(true), Opts), 
  528     !,
  529     findall(T-C, sqlite_table_column(Conn,T,C), TCs ),
  530     findall( T, member(T-_,TCs), RepTs ),
  531     sort( RepTs, Ts ),
  532     findall( T-Cs, (member(T,Ts),findall(C,member(T-C,TCs),Cs)), TdCs ),
  533     ( memberchk(at_module(Mod), Opts) -> true; Mod = user ),
  534     arity_option( Opts, ArityF ),
  535     sqlite_establish_tables(TdCs, Conn, Mod, ArityF, Opts ).
  536sqlite_establish_predicates(_Opts, _Conn ).
  537
  538sqlite_establish_tables( [], _Conn, _Mod, _ArityF, _Opts ).
  539sqlite_establish_tables( [Table-Columns|T], Conn, Mod, ArityF, Opts ) :-
  540     ( memberchk(table_as(Table,Pname,TArityF), Opts) ->
  541          true
  542          ;
  543          Pname = Table, TArityF = ArityF
  544     ), 
  545     sqlite_establish_table(TArityF,Table,Pname,Columns,Conn,Mod),
  546          % Internal = 'Internal prosqlite error. Unable to establish table',
  547          % throw( Internal:TArityF/Table )  % handled furter up now
  548     sqlite_establish_tables( T, Conn, Mod, ArityF, Opts ).
  549
  550sqlite_establish_table( arity, Table, Pname, Columns, Conn, Mod ) :-
  551     length( Columns, Arity ),
  552     sqlite_establish_table_typed( Table, Pname, Columns, Conn, Mod, predicate, Arity ).
  553sqlite_establish_table( both, Table, Pname, Columns, Conn, Mod ) :-
  554     sqlite_establish_table_typed( Table, Pname, Columns, Conn, Mod, unary, 1 ),
  555     length( Columns, Arity ),
  556     sqlite_establish_table_typed( Table, Pname, Columns, Conn, Mod, predicate, Arity ).
  557sqlite_establish_table( unary, Table, Pname, Columns, Conn, Mod ) :-
  558     sqlite_establish_table_typed( Table, Pname, Columns, Conn, Mod, unary, 1 ).
  559sqlite_establish_table( palette, Table, Pname, Columns, Conn, Mod ) :-
  560     length( Columns, Arity ),
  561     % Shorter is Arity - 1,
  562     findall( _, ( between(1,Arity,I), 
  563                   sqlite_establish_table_typed(Table, Pname, Columns, Conn, Mod, palette, I)
  564                 ), _ ).
  565
  566sqlite_establish_table_typed( Table, Pname, Columns, Conn, Mod, ArityF, Arity ) :-
  567     functor( Head, Pname, Arity ),
  568     Head =..[Pname|Args],
  569     Body = prosqlite:sqlite_holds(Conn,Table,Arity,ArityF,Columns,Args),
  570     ( clause(Mod:Head,_Body) ->
  571          sqlite_fail( maps_to_existing_predicate(Pname,Arity) )
  572          ;
  573          true
  574     ),
  575     % retractall( Mod:Head ),   % fixme: double check this and test it works
  576     ( sqlite_db:sqlite_asserted(Conn1,Pname,Args,_Mod1) ->
  577          sqlite_fail( predicate_already_registered(Conn1,Pname,Arity) )
  578          ;
  579          Mod:assert((Head :- Body))
  580     ),
  581     assert( sqlite_db:sqlite_asserted(Conn,Pname,Arity,Mod) ).
  582     % assert((Head :- Body)),
  583
  584sqlite_holds( AliasOr, Name, _Arity, Type, Columns, Args ) :-
  585     sqlite_alias_connection( AliasOr, Conn ),
  586     pl_as_predicate_to_sql_ready_data( Type, Columns, Args, KnwnClmPrs, UnKnwnCs, UnKnwnAs ),
  587    safe_column_names(Columns, SafeColumns),
  588     safe_column_names(UnKnwnCs, SafeUnKnwnCs),
  589     sqlite_holds_unknown( SafeUnKnwnCs, UnKnwnAs, KnwnClmPrs, Name, SafeColumns, Conn ).
  590
  591/* fixme:
  592sqlite_holds_unknown( [], _UnKnwnAs, KnwnClmPrs, Name, Columns, Conn ) :-
  593     shall we throw an error if there is nothing to report and nothing to assert ?
  594     */
  595
  596sqlite_holds_unknown( UnKnwnCs, UnKnwnAs, KnwnClmPrs, Name, _Columns, Conn ) :-
  597     sql_clm_value_pairs_to_where(KnwnClmPrs, Where),
  598     atomic_list_concat( UnKnwnCs, ',', UnC ),
  599     atomic_list_concat( ['Select ',UnC,'From',Name,Where,';'], ' ', Sql ),
  600     Row =.. [row|UnKnwnAs],
  601     debug( sqlite, 'Conn: ~w, sending: ~a', [Conn,Sql] ),
  602     c_sqlite_query(Conn, Sql, Row).
  603
  604sqlite_alias_connection( Alias, Connection ) :-
  605     sqlite_connection( Alias,_,Connection ),
  606     !.
  607% allows access with either alias or connection :
  608sqlite_alias_connection( Connection, Connection ) :-
  609     sqlite_connection(_,_,Connection),
  610     !.
  611sqlite_alias_connection( Alias, _Connection ) :-
  612     sqlite_error( unknown_alias(Alias) ).
  613
  614% fixme: we should really use the db_facts code here.
  615pl_as_predicate_to_sql_ready_data( unary, Columns, [Args], KnwnClmPrs, UnKnwnCs, UnKnwnAs ) :-
  616     pl_look_for_args_to_un_known( Args, Columns, KnwnClmPrs, UnKnwnCs, UnKnwnAs ).
  617pl_as_predicate_to_sql_ready_data( palette, Columns, ArgsIn, KnwnClmPrs, UnKnwnCs, UnKnwnAs ) :-
  618     ( (ArgsIn=[Args],is_list(Args)) -> true; Args = ArgsIn ),
  619     pl_args_column_arg_ground_or_not_pairs(Args,Columns,KnwnClmPrs,UnKnwnCs,UnKnwnAs),
  620     ( maplist(var,Args) ->
  621          true % then a palette predicate has been called with full arity and all variables
  622          ;
  623          % maplist( look_for_pair,Args,_,_),
  624          findall( LFA, (member(LFA,Args),look_for_pair_silent(LFA,_,_)), [] )
  625          % then a palette predicate has been called with full arity and look_for_pair
  626     ),
  627     !.
  628pl_as_predicate_to_sql_ready_data( palette, Columns, ArgsIn, KnwnClmPrs, UnKnwnCs, UnKnwnAs ) :-
  629     ( (ArgsIn=[Args],is_list(Args)) -> true; Args = ArgsIn ),
  630     pl_look_for_args_to_un_known( Args, Columns, KnwnClmPrs, UnKnwnCs, UnKnwnAs ).
  631pl_as_predicate_to_sql_ready_data( predicate, Columns, Args, KnwnClmPrs, UnKnwnCs, UnKnwnAs ) :-
  632     pl_args_column_arg_ground_or_not_pairs( Args, Columns, KnwnClmPrs, UnKnwnCs, UnKnwnAs ).
  633
  634pl_args_column_arg_ground_or_not_pairs( [], [], [], [], [] ).
  635pl_args_column_arg_ground_or_not_pairs( [A|As], [C|Cs], Knwn, UnCs, UnAs ) :-
  636     ( ground(A) -> 
  637          Knwn = [C-A|TKnwn],
  638          TUnCs = UnCs,
  639          TUnAs = UnAs
  640          ;
  641          TKnwn = Knwn,
  642          UnCs = [C|TUnCs],
  643          UnAs = [A|TUnAs]
  644     ),
  645     pl_args_column_arg_ground_or_not_pairs( As, Cs, TKnwn, TUnCs, TUnAs ).
  646
  647pl_look_for_args_to_un_known( [], _Columns, [], [], [] ).
  648pl_look_for_args_to_un_known( [A|As], Columns, Knwn, UnKnwnCs, UnKnownAs ) :-
  649     look_for_pair( A, Clm, Val ),
  650     is_one_of_columns( Clm, Columns ),
  651     ( ground(Val) ->
  652          Knwn = [Clm-Val|TKnwn],
  653          TUnKnwnCs = UnKnwnCs,
  654          TUnKnownAs = UnKnownAs
  655          ;
  656          TKnwn = Knwn,
  657          UnKnwnCs = [Clm|TUnKnwnCs],
  658          UnKnownAs = [Val|TUnKnownAs]
  659     ),
  660     pl_look_for_args_to_un_known( As, Columns, TKnwn, TUnKnwnCs, TUnKnownAs ).
  661
  662is_one_of_columns( Clm, Columns ) :-
  663     memberchk( Clm, Columns ), 
  664     !.
  665is_one_of_columns( Clm, Columns ) :-
  666     sqlite_error( unknown_column(Clm,Columns) ).
  667
  668look_for_pair( Pair, K, V ) :-
  669     look_for_pair_silent( Pair, K, V ),
  670     !.
  671look_for_pair( Term, _A, _B ) :-
  672    % print_message(informational, pack(git_fetch(Dir))).
  673     sqlite_error( pair_representation(Term) ).
  674     % type_error( 'Binary compound with functor {=,-,:}', Term ). 
  675     % Type = 'Binary compound with functor {=,-,:}',
  676     % print_message( error, error(type_error(Type,Term)) ),
  677     % abort.
  678
  679look_for_pair_silent( A=B, A, B ).
  680look_for_pair_silent( A-B, A, B ).
  681look_for_pair_silent( A:B, A, B ).
  682
  683/* error messages */
  684
  685sqlite_error( Term ) :-
  686     Type = error,
  687     print_message( Type, sqlite(Term) ),
  688     abort.
  689
  690sqlite_fail( Term ) :-
  691     Type = informational,
  692     sqlite_fail( Type, Term ).
  693
  694sqlite_fail( Type, Term ) :-
  695     print_message( Type, sqlite(Term) ),
  696     fail.
  697
  698%-Section error handling.
  699
  700:- multifile prolog:message//1.  701
  702prolog:message(sqlite(Message)) -->
  703    message(Message).
  704
  705
  706message( pair_representation(Term) ) -->
  707     ['Wrong term type ~q in predicated table arguments. Expected binary with functor, {=,:,-}.' - [Term] ].
  708message( unknown_column(Clm,Columns) ) -->
  709     [ 'Unkown column, ~q expected one in ~q.' - [Clm,Columns] ].
  710message( unknown_alias(Alias) ) -->
  711     ['Not a known alias or connection:~q.' - Alias ].
  712message( wrong_arity_value(ArityF) ) -->
  713     { arity_flag_values( Arities ) },
  714     [ 'Unrecognised arity option value ~q, expected ~q.' - [ArityF,Arities] ].
  715message( predicated_creation_error(File,Alias) ) -->
  716     [ 'Closed connection ~q to file ~q due to failure in predicated table creation.' - [Alias,File] ].
  717message( connection_already_open(Conn) ) -->
  718     [ 'Connection already open ~q.'- [Conn] ].
  719message( alias_in_use(Conn,File) ) --> 
  720     [ 'Alias/connection ~q already in use for file ~q.'- [Conn,File] ].
  721message( not_a_connection(Alias) ) -->
  722     [ 'Not an open connection or known alias to a connection: ~q' - [Alias] ].
  723message( insufficient_columns(Goal,Op) ) -->
  724     [ 'Insufficient number of known column values in ~q for operation ~q.' - [Goal,Op] ].
  725message( predicate_already_registered(Conn,Pname,Arity) ) -->
  726     [ 'Predicate ~q already registered by connection ~q' - [Pname/Arity,Conn] ].
  727message( maps_to_existing_predicate(Pname,Arity) ) -->
  728     ['Predicated table maps to existing predicate ~q.' - [Pname/Arity] ].
  729message( file_already_open(File,Alias) ) -->
  730     ['File, ~q already open with alias ~q.' - [File,Alias] ].
  731message( db_at(File) ) -->
  732     ['Using database from file: ~q.' - [File] ].
  733message( asserting_non_ground(Goal) ) -->
  734     [ 'Asserting non ground term ~q.' - [Goal] ].
  735message( debug(Format,Args) ) -->
  736     [ 'Found Format (1st arg) ~q and Args (2nd arg) ~q.' - [Format,Args] ].
  737     
  738%-Section sqlite non-specific auxiliary predicates 
  739%
  740to_list(OptIn, Opts) :-
  741     is_list(OptIn),
  742     !,
  743     Opts = OptIn.
  744to_list(Opt, [Opt] ).
  745
  746dquote( Val, Quoted ) :-
  747     number( Val ), 
  748     !,
  749     Quoted = Val.
  750dquote( Val, Quoted ) :-
  751     atom( Val ),
  752     !,
  753     atomic_list_concat( ['"',Val,'"'], Quoted ).
  754dquote( Val, Quoted ) :-
  755     is_list( Val ),
  756     append( [0'"|Val], [0'"], QuotedCs ),
  757     atom_codes( Quoted, QuotedCs ).
  758
  759sql_clm_value_pairs_to_where(Known, Where) :-
  760     sql_clm_value_pairs_to_where_conjunction(Known, Conjunction),
  761     sql_where_conjunction_to_where(Conjunction, Where).
  762
  763sql_where_conjunction_to_where('', '' ) :- !.
  764sql_where_conjunction_to_where(Conjunction, Where ) :-
  765     atom_concat( 'Where ', Conjunction, Where ).
  766
  767sql_clm_value_pairs_to_where_conjunction([], '').
  768sql_clm_value_pairs_to_where_conjunction([K-V|T], Where) :-
  769     sql_clm_value_pairs_to_where_conjunction(T, InWhere),
  770     sql_clm_and_val_to_sql_equals_atom(K, V, KVAtm),
  771     ( InWhere == '' -> 
  772          Where = KVAtm
  773          ;
  774          atomic_list_concat([KVAtm, ' AND ', InWhere], Where)
  775     ).
  776
  777sql_clm_and_val_to_sql_equals_atom(K, V, KVAtm) :-
  778     ( number(V) -> 
  779          atom_number(Vatm, V),
  780          atom_concat('=',Vatm,EqV)
  781          ;
  782          atom_concat(V, '\'', VDsh),
  783          atom_concat('=\'',VDsh,EqV)
  784     ),
  785     atom_concat(K, EqV, KVAtm).
  786
  787sqlite_facet_table( arity(Arity), Connection, Table ) :-
  788     findall( Column, sqlite_table_column(Connection, Table, Column), Columns ),
  789     length( Columns, Arity ).
  790
  791arity_option( Opts, ArityF ) :-
  792     memberchk( arity(ArityF), Opts ),
  793     arity_flag_values( Arities ),
  794     memberchk( ArityF, Arities ),
  795     !.
  796arity_option( Opts, ArityF ) :-
  797     memberchk( arity(ArityF), Opts ),
  798     !,
  799     sqlite_fail( wrong_arity_value(ArityF) ).
  800arity_option( _Opts, arity ). % default for this flag, although we should 
  801                             % move all defaults to one location/list (fixme)
  802
  803kv_decompose( [], [], [] ).
  804kv_decompose( [K-V|T], [K|Ks], [V|Vs] ) :-
  805     kv_decompose( T, Ks, Vs ).
 safe_column_names(+Cols, -SafeCols) is det
author
- : Steve Moyle

+Cols is a list of column names stored in the sqlite db -SafeCols is the each element of the input is the atom wrapped in [].

sqlite (and possibly other RDBMSs) does not like columns with names including periods like:

'id.orig_h' They need to be refered to in the select statement as: [id.orig_h]

?- safe_column_names(['id.orig_h'], S). Correct to: "prosqlite:safe_column_names(['id.orig_h'],S)"? yes S = ['[id.orig_h]'].

  826safe_column_names([], []).
  827safe_column_names([Col | Cols], [SafeCol | SafeCols]) :-
  828    safe_column_name(Col, SafeCol),
  829    safe_column_names(Cols, SafeCols).
  830
  831safe_column_name(Col, SafeCol) :-
  832        format(atom(SafeCol), '[~w]', [Col])