View source with raw comments or as raw
   1/*  Part of ClioPatria SeRQL and SPARQL server
   2
   3    Author:        Jan Wielemaker
   4    E-mail:        J.Wielemaker@cs.vu.nl
   5    WWW:           http://www.swi-prolog.org
   6    Copyright (C): 2010 VU University Amsterdam
   7
   8    This program is free software; you can redistribute it and/or
   9    modify it under the terms of the GNU General Public License
  10    as published by the Free Software Foundation; either version 2
  11    of the License, or (at your option) any later version.
  12
  13    This program is distributed in the hope that it will be useful,
  14    but WITHOUT ANY WARRANTY; without even the implied warranty of
  15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16    GNU General Public License for more details.
  17
  18    You should have received a copy of the GNU General Public
  19    License along with this library; if not, write to the Free Software
  20    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  21
  22    As a special exception, if you link this library with other files,
  23    compiled with a Free Software compiler, to produce an executable, this
  24    library does not by itself cause the resulting executable to be covered
  25    by the GNU General Public License. This exception does not however
  26    invalidate any other reasons why the executable file might be covered by
  27    the GNU General Public License.
  28*/
  29
  30:- module(conf_d,
  31	  [ load_conf_d/2,		% +Directories, +Options
  32	    conf_d_enabled/1,		% -ConfDir
  33	    conf_d_reload/0,
  34	    conf_d_members/3,		% +Directory, -FileData, +Options
  35	    conf_d_member_data/3,	% ?Field, +FileData, -Value
  36	    conf_d_configuration/3	% +Available, +Enabled, -Configs
  37	  ]).
  38:- use_module(library(option)).
  39:- use_module(library(ordsets)).
  40:- use_module(library(lists)).
  41:- use_module(library(apply)).
  42:- use_module(library(version)).
  43:- use_module(library(prolog_xref)).
  44:- if(exists_source(library(pldoc/doc_process))).
  45:- use_module(library(pldoc)).
  46:- use_module(library(pldoc/doc_process)).
  47:- endif.
  48
  49/** <module> Load configuration directories
  50
  51This module deals with  loading   configuration-files  from a directory.
  52This is pretty simple because  we   assume  that configuration files are
  53Prolog  source-files.  We  (can)  use    file_search_path/2   to  define
  54one or more configuration directories.
  55
  56Files are loaded in alphabetical  order.   If  one  config file requires
  57another, there are two solutions:
  58
  59    * Use some numbering scheme, e.g., name the files 00-prefixes.pl,
  60    01-paths.pl, etc.
  61    * Use a use_module/1 call to include the config file(s) on which we
  62    depend.
  63*/
  64
  65%%	load_conf_d(+Spec, +Options) is det.
  66%
  67%	Locate configuration directories and load   their  config files.
  68%	Config files themselves are Prolog source files.  Options:
  69%
  70%	    * solutions(+Sols)
  71%	    Passed to absolute_file_name/3.  Default is =all=, loading
  72%	    config files from all directories described by Spec.
  73%	    * extension(+Ext)
  74%	    File-name extension for the config files.  Default is =pl=.
  75%
  76%	Other options are passed to load_files/2.
  77%
  78%	@param	Spec is either the specification of a directory according
  79%		to absolute_file_name/3 or a list thereof.  Duplicate
  80%		directories are removed.
  81%	@tbd	There is a bug forking processes in one thread and
  82%		waiting for X11 in another, which deadlocks in
  83%		fork_atfree().  So, we must ensure we have the git
  84%		versions in time :-(
  85
  86load_conf_d(Spec, Options) :-
  87	set_top_dir,
  88	select_option(solutions(Sols), Options, LoadOptions0, all),
  89	merge_options(LoadOptions0,
  90		      [ if(changed),
  91			extension(pl)
  92		      ], LoadOptions),
  93	phrase(collect_dirs(Spec, Sols), Dirs),
  94	list_to_set(Dirs, Set),
  95	maplist(load_conf_dir(LoadOptions), Set),
  96	git_update_versions(_).		% See above
  97
  98collect_dirs([], _) --> !.
  99collect_dirs([H|T], Sols) --> !,
 100	collect_dirs(H, Sols),
 101	collect_dirs(T, Sols).
 102collect_dirs(Spec, Sols) -->
 103	findall(Dir, absolute_file_name(Spec, Dir,
 104					[ file_type(directory),
 105					  file_errors(fail),
 106					  access(read),
 107					  solutions(Sols)
 108					])).
 109
 110
 111:- dynamic
 112	conf_d/3.			% Directory, Options, Files
 113
 114load_conf_dir(Options, Dir) :-
 115	conf_d_files(Dir, Files, Options),
 116	delete(Options, extension(_), LoadOptions),
 117	update_conf_d(Dir, Files, Options),
 118	load_files(user:Files, LoadOptions).
 119
 120conf_d_files(Dir, Files, Options) :-
 121	option(extension(Ext), Options, pl),
 122	atomic_list_concat([Dir, '/*.', Ext], Pattern),
 123	expand_file_name(Pattern, Matches),
 124	include(accessible, Matches, AccessibleFiles),
 125	maplist(absolute_file_name, AccessibleFiles, CanonicalFiles),
 126	sort(CanonicalFiles, Files).
 127
 128accessible(File) :-
 129	access_file(File, read).
 130
 131update_conf_d(Dir, Files, Options) :-
 132	\+ conf_d(Dir, _, _), !,
 133	assert(conf_d(Dir, Options, Files)).
 134update_conf_d(Dir, Files, Options) :-
 135	retract(conf_d(Dir, _, OldFiles)), !,
 136	ord_subtract(OldFiles, Files, Removed),
 137	(   Removed \== []
 138	->  print_message(informational, conf_d(unload(Removed))),
 139	    catch(maplist(unload_file, Removed), E,
 140		  print_message(error, E))
 141	;   true
 142	),
 143	ord_subtract(Files, OldFiles, New),
 144	(   New \== []
 145	->  print_message(informational, conf_d(new(New)))
 146	;   true
 147	),
 148	assert(conf_d(Dir, Options, Files)).
 149
 150%%	conf_d_enabled(-Dir) is nondet.
 151%
 152%	True if Dir is a directory from which config files are loaded.
 153
 154conf_d_enabled(Dir) :-
 155	conf_d(Dir, _, _).
 156
 157%%	conf_d_reload is det.
 158%
 159%	Reload configuration files  after  adding   or  deleting  config
 160%	files. Note that this is not exactly  the same as restarting the
 161%	server. First of all, the order in   which  the files are loaded
 162%	may be different and second, wiping a config file only wipes the
 163%	clauses and module. Side effects, for   example  due to executed
 164%	directives, are *not* reverted.
 165
 166conf_d_reload :-
 167	findall(Dir-Options, conf_d(Dir, Options, _Files), Pairs),
 168	forall(member(Dir-Options, Pairs),
 169	       load_conf_dir(Options, Dir)).
 170
 171%%	conf_d_members(+Dir, -InfoRecords:list, Options) is det
 172%
 173%	Provide information about config files in Dir.
 174%
 175%	@param InfoRecords is a list of terms. The predicate
 176%	conf_d_member_data/3 must be used to extract data from these
 177%	terms.
 178
 179conf_d_members(DirSpec, InfoRecords, Options) :-
 180	findall(Files,
 181		( absolute_file_name(DirSpec, Dir,
 182				     [ file_type(directory),
 183				       solutions(all)
 184				     ]),
 185		  conf_d_files(Dir, Files, Options)
 186		), FileLists),
 187	append(FileLists, Files0),
 188	sort(Files0, Files), % remove duplicates introduced by absolute & relative ClioPatria paths
 189	maplist(conf_file, Files, InfoRecords).
 190
 191conf_file(File, config_file(Path, Module, Title)) :-
 192	xref_public_list(File, Path, Module, _Public, _Meta, []), !,
 193	(   current_predicate(doc_comment/4),
 194	    doc_comment(_:module(Title), Path:_, _Summary, _Comment)
 195	->  true
 196	;   true
 197	).
 198conf_file(File, config_file(File, _Module, _Title)).
 199
 200%%	conf_d_member_data(?Field, +ConfigInfo, ?Value) is nondet.
 201%
 202%	True if Value is the value   for Field in ConfigInfo. ConfigInfo
 203%	is an opaque term as returned   by conf_d_info/3. Defined fields
 204%	are:
 205%
 206%	    * file
 207%	    Absolute path of the file
 208%	    * module
 209%	    Module defined in the file (can fail)
 210%	    * title
 211%	    Comment-title (from /** <module> Title .. */)
 212%	    * loaded
 213%	    Boolean, indicating whether the file is currently loaded.
 214
 215conf_d_member_data(file,   config_file(F, _, _), F).
 216conf_d_member_data(module, config_file(_, M, _), M) :- nonvar(M).
 217conf_d_member_data(title,  config_file(_, _, T), T) :- nonvar(T).
 218conf_d_member_data(loaded, config_file(F, _, _), B) :-
 219	(   source_file(F)
 220	->  B = true
 221	;   B = false
 222	).
 223
 224
 225%%	set_top_dir
 226%
 227%	Maintains a file search path  =cpapp_topdir=   to  point  to the
 228%	directory from which the configuration is loaded. Normally, that
 229%	is the directory holding =|run.pl|=.
 230
 231set_top_dir :-
 232	(   source_file(add_relative_search_path(_,_), File)
 233	->  file_directory_name(File, Dir)
 234	;   prolog_load_context(directory, Dir)
 235	->  true
 236	;   working_directory(Dir,Dir)
 237	),
 238	(   user:file_search_path(cp_application, Dir)
 239	->  true
 240	;   assert(user:file_search_path(cp_application, Dir))
 241	).
 242
 243%%	conf_d_configuration(+Available, +Enabled, -Configs) is det.
 244%
 245%	@param	Available is a directory or alias providing the
 246%		available configurations (e.g., config_available(.))
 247%	@param	Enabled	is a directory or alias providing the installed
 248%		configuration (e.g., 'config-enabled')
 249%	@param	Configs is a list if Key-[Example,Installed], where
 250%		either is (-) or a config data item as required by
 251%		conf_d_member_data/3.  The list is sorted on Key.
 252
 253conf_d_configuration(Available, Enabled, Configs) :-
 254	keyed_config(Available, Templ),
 255	keyed_config(Enabled, Installed),
 256	merge_pairlists([Templ, Installed], Configs).
 257
 258
 259keyed_config(Dir, List) :-
 260	conf_d_members(Dir, TemplMembers, []),
 261	map_list_to_pairs(key_by_file, TemplMembers, List0),
 262	keysort(List0, List).
 263
 264key_by_file(Data, Key) :-
 265	conf_d_member_data(file, Data, Path),
 266	file_name_extension(Plain, _, Path),
 267	file_base_name(Plain, Key).
 268
 269
 270		 /*******************************
 271		 *	       LIB		*
 272		 *******************************/
 273
 274%%	merge_pairlists(+PairLists, -Merged)
 275%
 276%	PairLists is a list of lists  of   K-V  pairs.  Merged is a K-VL
 277%	list, where each VL is  a  list   of  values  on K in PairLists.
 278%	Missing values are returned as (-).  For example:
 279%
 280%	  ==
 281%	  ?- merge_pairlists([ [a-1, d-4],
 282%			       [a-1, c-3],
 283%			       [b-2]
 284%			     ], Merged).
 285%	  Merged = [a-[1,1,-], b-[-,-,2], d-[4,-,-], c-[-,3,-]].
 286%	  ==
 287%
 288%	@tbd Is this useful and generic enough for library(pairs)?
 289
 290merge_pairlists(Lists, Merged) :-
 291	heads(Lists, Heads),
 292	sort(Heads, Sorted),
 293	merge_pairlists(Sorted, Lists, Merged).
 294
 295heads([], []).
 296heads([[K-_|_]|T0], [K|T]) :- !,
 297	heads(T0, T).
 298heads([[]|T0], T) :-
 299	heads(T0, T).
 300
 301merge_pairlists([], _, []).
 302merge_pairlists([K|T0], Lists, [K-Vs|T]) :-
 303	take_key(Lists, K, NewLists, NewKsUnsorted, Vs),
 304	sort(NewKsUnsorted, NewKs),
 305	ord_union(T0, NewKs, Ks),
 306	merge_pairlists(Ks, NewLists, T).
 307
 308take_key([], _, [], [], []).
 309take_key([List|T0], K, NewLists, NewKs, Vs) :-
 310	(   List = [KH-V|ListT],
 311	    KH == K
 312	->  NewLists = [ListT|T],
 313	    Vs = [V|Vs1],
 314	    (	ListT = [NewK-_|_]
 315	    ->	NewKs = [NewK|NewKs1]
 316	    ;	NewKs1 = NewKs
 317	    ),
 318	    take_key(T0, K, T, NewKs1, Vs1)
 319	;   NewLists = [List|T],
 320	    Vs = [(-)|Vs1],
 321	    take_key(T0, K, T, NewKs, Vs1)
 322	).
 323
 324
 325		 /*******************************
 326		 *	      MESSAGES		*
 327		 *******************************/
 328
 329:- multifile
 330	prolog:message//1.
 331
 332prolog:message(conf_d(unload(Files))) -->
 333	[ 'Unloaded the following config files:'-[] ],
 334	files(Files).
 335prolog:message(conf_d(new(Files))) -->
 336	[ 'Added the following config files:'-[] ],
 337	files(Files).
 338
 339files([]) --> [].
 340files([H|T]) --> [ nl, '    ~w'-[H] ], files(T).