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

   52:- multifile
   53	git_module_hook/3.		% Name, Dir, Options

 check_prolog_version(+Required)

Validate the program is running under Prolog version Required or newer. Required is in numeric notation (e.g. 50317 for 5.3.17)

   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

 register_git_module(+Name, +Options)

Register the directory from which the Prolog file was loaded as a GIT component about which to report version information. This should be used as a directive. Defined options:

directory(Dir)

Use Dir as the location of the GIT repository instead of the directory of the file from which this directive was called. If Dir is not absolute, it is taken relative to the directory holding the file from which this directive was called.

home_url(URL)

Used to create a link to the components home-page.

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

 git_module_property(?Name, ?Property) is nondet

Property is a property of the named git-component. Defined properties are:

version(Version)

git-describe like version information

directory(Dir)

Base directory of the component

To be done

- Extend with more detailed version (e.g., remote)

  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.