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-2017, 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.