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): 2004-2010, University of Amsterdam,
   7			      VU University Amsterdam
   8
   9    This program is free software; you can redistribute it and/or
  10    modify it under the terms of the GNU General Public License
  11    as published by the Free Software Foundation; either version 2
  12    of the License, or (at your option) any later version.
  13
  14    This program is distributed in the hope that it will be useful,
  15    but WITHOUT ANY WARRANTY; without even the implied warranty of
  16    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17    GNU General Public License for more details.
  18
  19    You should have received a copy of the GNU General Public
  20    License along with this library; if not, write to the Free Software
  21    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  22
  23    As a special exception, if you link this library with other files,
  24    compiled with a Free Software compiler, to produce an executable, this
  25    library does not by itself cause the resulting executable to be covered
  26    by the GNU General Public License. This exception does not however
  27    invalidate any other reasons why the executable file might be covered by
  28    the GNU General Public License.
  29*/
  30
  31:- module(prolog_version,
  32	  [ check_prolog_version/1,	% +NumericVersion
  33	    register_git_module/2,	% +Name, +Options
  34	    git_module_property/2,	% ?Name, ?Property
  35	    git_update_versions/1	% ?Name
  36	  ]).
  37:- use_module(library(process)).
  38:- use_module(library(option)).
  39:- use_module(library(readutil)).
  40:- use_module(library(git)).
  41
  42
  43/** <module> Manage software versions
  44
  45The module deals with software  versions.   It  currently implements two
  46features:  test  whether   SWI-Prolog   is    sufficiently   new   using
  47check_prolog_version/1 and find GIT version   signatures for the running
  48server. Modules that want  their  version   info  available  through the
  49web-page can do so using a call to register_git_module/2.
  50*/
  51
  52:- multifile
  53	git_module_hook/3.		% Name, Dir, Options
  54
  55%%	check_prolog_version(+Required)
  56%
  57%	Validate the program is running under Prolog version Required or
  58%	newer. Required is in numeric notation (e.g. 50317 for 5.3.17)
  59
  60check_prolog_version(Required) :-
  61	prolog_version_ok(Required), !.
  62check_prolog_version(Required) :-
  63	print_message(error,
  64		      required_prolog_version(Required)),
  65	format(user_error, '~nPress any key to exit> ', []),
  66	get_single_char(_), nl(user_error),
  67	halt(1).
  68
  69prolog_version_ok(or(V1, V2)) :-
  70	(   prolog_version_ok(V1)
  71	->  true
  72	;   prolog_version_ok(V2)
  73	).
  74prolog_version_ok(Required) :-
  75        current_prolog_flag(version, MyVersion),
  76	MyVersion >= Required.
  77
  78:- multifile
  79	prolog:message/3.
  80
  81prolog:message(required_prolog_version(Required)) -->
  82	{ current_prolog_flag(version, MyVersion),
  83	  user_version(MyVersion, MyV),
  84	  user_version(Required, Req)
  85	},
  86	[ 'This program requires SWI-Prolog ~w'-[Req], nl,
  87	  'while you are running version ~w.'-[MyV], nl,
  88	  'Please visit http://www.swi-prolog.org and', nl,
  89	  'upgrade your version of SWI-Prolog.'
  90	].
  91prolog:message(git(no_version)) -->
  92	[ 'Sorry, cannot retrieve version stamp from GIT.' ].
  93prolog:message(git(update_versions)) -->
  94	[ 'Updating GIT version stamps in the background.' ].
  95
  96
  97user_version(or(V1,V2), Version) :- !,
  98	user_version(V1, A1),
  99	user_version(V2, A2),
 100	format(atom(Version), '~w or ~w', [A1, A2]).
 101user_version(N, Version) :-
 102        Major is N // 10000,
 103        Minor is (N // 100) mod 100,
 104        Patch is N mod 100,
 105        atomic_list_concat([Major, Minor, Patch], '.', Version).
 106
 107
 108		 /*******************************
 109		 *	   REGISTRATION		*
 110		 *******************************/
 111
 112:- dynamic
 113	git_module/3,		% Name, Dir, Options
 114	git_module_version/2.	% Name, Version
 115
 116%%	register_git_module(+Name, +Options)
 117%
 118%	Register the directory from which the  Prolog file was loaded as
 119%	a GIT component about which to  report version information. This
 120%	should be used as a directive.  Defined options:
 121%
 122%	    * directory(Dir)
 123%	    Use Dir as the location of the GIT repository instead of the
 124%	    directory of the file from which this directive was called.
 125%	    If Dir is not absolute, it is taken relative to the
 126%	    directory holding the file from which this directive was called.
 127%
 128%	    * home_url(URL)
 129%	    Used to create a link to the components home-page.
 130
 131register_git_module(Name, Options) :-
 132	(   prolog_load_context(directory, BaseDir)
 133	->  true
 134	;   working_directory(BaseDir, BaseDir)
 135	),
 136	select_option(directory(Dir), Options, RestOptions, '.'),
 137	absolute_file_name(Dir, AbsDir,
 138			   [ file_type(directory),
 139			     relative_to(BaseDir),
 140			     access(read)
 141			   ]),
 142	retractall(git_module(Name, _, _)),
 143	assert(git_module(Name, AbsDir, RestOptions)).
 144
 145git_update_versions(Name) :-
 146	catch(forall(current_git_module(Name, _, _),
 147		     update_version(Name)),
 148	      _,
 149	      print_message(warning, git(no_version))).
 150
 151update_version(Name) :-
 152	current_git_module(Name, Dir, Options),
 153	(   catch(git_describe(GitVersion, [directory(Dir)|Options]), _, fail)
 154	->  true
 155	;   GitVersion = unknown
 156	),
 157	retractall(git_module_version(Name, _)),
 158	assert(git_module_version(Name, GitVersion)).
 159
 160current_git_module(Name, Dir, Options) :-
 161	git_module(Name, Dir, Options).
 162current_git_module(Name, Dir, Options) :-
 163	git_module_hook(Name, Dir, Options).
 164
 165
 166%%	git_module_property(?Name, ?Property) is nondet.
 167%
 168%	Property is a property of the named git-component. Defined
 169%	properties are:
 170%
 171%	    * version(Version)
 172%	    git-describe like version information
 173%	    * directory(Dir)
 174%	    Base directory of the component
 175%
 176%	@tbd Extend with more detailed version (e.g., _remote_)
 177
 178git_module_property(Name, Property) :-
 179	(   var(Name)
 180	->  current_git_module(Name, _, _),
 181	    git_module_property(Name, Property)
 182	;   compound(Property)
 183	->  once(gen_module_property(Name, Property))
 184	;   gen_module_property(Name, Property)
 185	).
 186
 187gen_module_property(Name, version(Version)) :-
 188	(   git_module_version(Name, Version0)
 189	->  true
 190	;   git_update_versions(Name),
 191	    git_module_version(Name, Version0)
 192	),
 193	Version0 \== unknown,
 194	Version = Version0.
 195gen_module_property(Name, directory(Dir)) :-
 196	current_git_module(Name, Dir, _).
 197gen_module_property(Name, remote(Alias, Remote)) :-
 198	(   ground(Alias)
 199	->  true
 200	;   Alias = origin
 201	),
 202	current_git_module(Name, Dir, _),
 203	git_remote_url(Alias, Remote, [directory(Dir)]).
 204gen_module_property(Name, Term) :-
 205	current_git_module(Name, _, Options),
 206	member(Term, Options).
 207
 208
 209
 210		 /*******************************
 211		 *	  KEEP UP-TO-DATE	*
 212		 *******************************/
 213
 214bg_git_update_versions :-
 215	print_message(informational, git(update_versions)),
 216	thread_create(git_update_versions(_), _,
 217		      [ detached(true)
 218		      ]).
 219
 220:- multifile
 221	user:message_hook/3.
 222
 223user:message_hook(make(done(_)), _, _) :-
 224	bg_git_update_versions,
 225	fail.
 226
 227% do not update versions in background because we need to fork
 228:- if(current_predicate(http_unix_daemon:http_daemon/0)).
 229:- initialization git_update_versions(_).
 230:- else.
 231:- initialization bg_git_update_versions.
 232:- endif.