1/*  Part of SWISH
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2004-2018, VU University Amsterdam
    7                              CWI Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(swish_version,
   37          [ check_prolog_version/1,     % +NumericVersion
   38            prolog_version_atom/1,      % -Atom
   39            register_git_module/2,      % +Name, +Options
   40            git_module_property/2,      % ?Name, ?Property
   41            git_update_versions/1       % ?Name
   42          ]).   43:- use_module(library(option)).   44:- use_module(library(lists)).   45:- use_module(library(git)).

   57:- multifile
   58    git_module_hook/3.              % Name, Dir, Options

 check_prolog_version(+Required) is det

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

Errors

- prolog_version_error(Required) if Prolog does not have the required version.

   68check_prolog_version(Required) :-
   69    prolog_version_ok(Required),
   70    !.
   71check_prolog_version(Required) :-
   72    throw(error(prolog_version_error(Required), _)).
   73
   74prolog_version_ok(or(V1, V2)) :-
   75    !,
   76    (   prolog_version_ok(V1)
   77    ->  true
   78    ;   prolog_version_ok(V2)
   79    ).
   80prolog_version_ok(Required) :-
   81    current_prolog_flag(version, MyVersion),
   82    MyVersion >= Required.

 prolog_version_atom(-Atom) is det

Atom describes the current Prolog version

   88prolog_version_atom(Version) :-
   89    current_prolog_flag(version_git, Version),
   90    !.
   91prolog_version_atom(Version) :-
   92    current_prolog_flag(version_data, swi(Major,Minor,Patch,Options)),
   93    (   memberchk(tag(Tag), Options)
   94    ->  format(atom(Version), '~w.~w.~w-~w', [Major, Minor, Patch, Tag])
   95    ;   format(atom(Version), '~w.~w.~w',    [Major, Minor, Patch])
   96    ).
   97
   98
   99
  100:- multifile
  101    prolog:message//1,
  102    prolog:error_message//1.  103
  104prolog:error_message(prolog_version_error(Required)) -->
  105    { current_prolog_flag(version, MyVersion),
  106      user_version(MyVersion, MyV),
  107      user_version(Required, Req)
  108    },
  109    [ 'This program requires SWI-Prolog ~w'-[Req], nl,
  110      'while you are running version ~w.'-[MyV], nl,
  111      'Please visit http://www.swi-prolog.org and', nl,
  112      'upgrade your version of SWI-Prolog.'
  113    ].
  114prolog:message(git(no_version)) -->
  115    [ 'Sorry, cannot retrieve version stamp from GIT.' ].
  116prolog:message(git(update_versions)) -->
  117    [ 'Updating GIT version stamps in the background.' ].
  118
  119
  120user_version(or(V1,V2), Version) :-
  121    !,
  122    user_version(V1, A1),
  123    user_version(V2, A2),
  124    format(atom(Version), '~w or ~w', [A1, A2]).
  125user_version(N, Version) :-
  126    Major is N // 10000,
  127    Minor is (N // 100) mod 100,
  128    Patch is N mod 100,
  129    atomic_list_concat([Major, Minor, Patch], '.', Version).
  130
  131
  132                 /*******************************
  133                 *         REGISTRATION         *
  134                 *******************************/
  135
  136:- dynamic
  137    git_module/3,           % Name, Dir, Options
  138    git_module_prop/3.      % Name, Property, Value

 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.

  155register_git_module(Name, Options) :-
  156    (   prolog_load_context(directory, BaseDir)
  157    ->  true
  158    ;   working_directory(BaseDir, BaseDir)
  159    ),
  160    select_option(directory(Dir), Options, RestOptions, '.'),
  161    absolute_file_name(Dir, AbsDir,
  162                       [ file_type(directory),
  163                         relative_to(BaseDir),
  164                         access(read)
  165                       ]),
  166    retractall(git_module(Name, _, _)),
  167    assert(git_module(Name, AbsDir, RestOptions)).
  168
  169git_update_versions(Name) :-
  170    catch(forall(current_git_module(Name, _, _),
  171                 update_version(Name)),
  172          _,
  173          print_message(warning, git(no_version))).
  174
  175update_version(Name) :-
  176    current_git_module(Name, Dir, Options),
  177    (   catch(git_describe(GitVersion, [directory(Dir)|Options]), _, fail)
  178    ->  true
  179    ;   GitVersion = unknown
  180    ),
  181    retractall(git_module_prop(Name, version, _)),
  182    assert(git_module_prop(Name, version, GitVersion)).
  183
  184current_git_module(Name, Dir, Options) :-
  185    git_module(Name, Dir, Options).
  186current_git_module(Name, Dir, Options) :-
  187    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

remote(URL)

Location we are cloned from

home_url(URL)

Project home

  204git_module_property(Name, Property) :-
  205    (   var(Name)
  206    ->  current_git_module(Name, _, _),
  207        git_module_property(Name, Property)
  208    ;   compound(Property)
  209    ->  once(gen_module_property(Name, Property))
  210    ;   gen_module_property(Name, Property)
  211    ).
  212
  213gen_module_property(Name, version(Version)) :-
  214    (   git_module_prop(Name, version, Version0)
  215    ->  true
  216    ;   git_update_versions(Name),
  217        git_module_prop(Name, version, Version0)
  218    ),
  219    Version0 \== unknown,
  220    Version = Version0.
  221gen_module_property(Name, directory(Dir)) :-
  222    current_git_module(Name, Dir, _).
  223gen_module_property(Name, remote(Alias, Remote)) :-
  224    (   ground(Alias)
  225    ->  true
  226    ;   Alias = origin
  227    ),
  228    current_git_module(Name, Dir, _),
  229    (   git_module_prop(Name, remote, Alias-Remote)
  230    ->  true
  231    ;   git_remote_url(Alias, Remote, [directory(Dir)]),
  232        asserta(git_module_prop(Name, remote, Alias-Remote))
  233    ).
  234gen_module_property(Name, Term) :-
  235    current_git_module(Name, _, Options),
  236    member(Term, Options).
  237
  238
  239
  240                 /*******************************
  241                 *        KEEP UP-TO-DATE       *
  242                 *******************************/
  243
  244bg_git_update_versions :-
  245    print_message(informational, git(update_versions)),
  246    thread_create(git_update_versions(_), _,
  247                  [ detached(true)
  248                  ]).
  249
  250:- multifile
  251    user:message_hook/3.  252
  253user:message_hook(make(done(_)), _, _) :-
  254    bg_git_update_versions,
  255    fail.
  256
  257% do not update versions in background because we need to fork
  258:- if(current_predicate(http_unix_daemon:http_daemon/0)).  259:- initialization git_update_versions(_).  260:- else.  261:- initialization bg_git_update_versions.  262:- endif.