View source with formatted comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2012-2024, VU University Amsterdam
    7                              SWI-Prolog Solutions b.v.
    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(uuid,
   37          [ uuid/1,                     % -UUID
   38            uuid/2,                     % -UUID, +Options
   39            is_uuid/1,                  % @UUID
   40            uuid_property/2             % +UUID, ?Property
   41          ]).   42:- autoload(library(apply), [maplist/2]).   43:- if(exists_source(library(shlib))).   44:- autoload(library(shlib), [load_foreign_library/1]).   45:- endif.   46
   47/** <module> Universally Unique Identifier (UUID) Library
   48
   49The library provides operations on UUIDs.   Please consult other sources
   50for understanding UUIDs and  the  implications   of  the  different UUID
   51versions.  Some typical calls are given below:
   52
   53  ==
   54  ?- uuid(X).
   55  X = 'ea6589fa-19dd-11e2-8a49-001d92e1879d'.
   56
   57  ?- uuid(X, [url('http://www.swi-prolog.org')]).
   58  X = '73a07870-6a90-3f2e-ae2b-ffa538dc7c2c'.
   59  ==
   60
   61@tbd Compare UUIDs, extract time and version from UUIDs
   62@see http://www.ossp.org/pkg/lib/uuid/
   63@see https://en.wikipedia.org/wiki/Universally_unique_identifier
   64*/
   65
   66link_uuid :-
   67    catch(load_foreign_library(foreign(uuid)), error(_,_), true).
   68
   69:- initialization(link_uuid, now).   70
   71%!  uuid(-UUID) is det.
   72%
   73%   UUID is an atom representing a  new   UUID.  This is the same as
   74%   calling uuid(UUID, []).  See uuid/2 for options.
   75
   76uuid(UUID) :-
   77    uuid(UUID, []).
   78
   79%!  uuid(-UUID, +Options) is det.
   80%
   81%   Create a new UUID according to   Options.  The following options
   82%   are defined:
   83%
   84%     * version(+Versions)
   85%     Integer in the range 1..5, which specifies the UUID version
   86%     that is created.  Default is 1.
   87%
   88%     * dns(DNS)
   89%     * url(URL)
   90%     * oid(OID)
   91%     * x500(X500)
   92%     Provide additional context information for UUIDs using version
   93%     3 or 5.  If there is no explicit version option, UUID version
   94%     3 is used.
   95%
   96%     * format(+Format)
   97%     Representation of the UUID.  Default is =atom=, yielding atoms
   98%     such as =|8304efdd-bd6e-5b7c-a27f-83f3f05c64e0|=. The
   99%     alternative is =integer=, returning a large integer that
  100%     represents the 128 bits of the UUID.
  101%
  102%   If SWI-Prolog was not built with the  OSSP UUID dependency library a
  103%   simple Prolog alternative that  only   implements  version  4 random
  104%   UUIDs is provided. In this case  the   default  version is 4 and the
  105%   only admissible options are version(4) and format(Format).
  106
  107:- if(current_predicate(ossp_uuid/2)).  108uuid(UUID, Options) :-
  109    ossp_uuid(UUID, Options).
  110
  111:- else.  112
  113uuid(UUID, []) :-
  114    !,
  115    random_uuid(UUID).
  116uuid(UUID, Options) :-
  117    option(version(4), Options, 4),
  118    option(format(Format), Options, atom),
  119    (   Format == atom
  120    ->  !, random_uuid(UUID)
  121    ;   Format == integer
  122    ->  !, random_int_uuid(UUID)
  123    ).
  124uuid(_UUID, Options) :-
  125    domain_error(uuid_options, Options).
  126
  127random_uuid(UUID) :-
  128    Version = 4,
  129    A is random(0xffffffff),
  130    B is random(0xffff),
  131    C is random(0x0fff) \/ Version<<12,
  132    D is random(0x3fff) \/ 0x8000,
  133    E is random(0xffffffffffff),
  134    format(atom(UUID),
  135           '~`0t~16r~8+-~|\c
  136            ~`0t~16r~4+-~|\c
  137            ~`0t~16r~4+-~|\c
  138            ~`0t~16r~4+-~|\c
  139            ~`0t~16r~12+', [A,B,C,D,E]).
  140
  141random_int_uuid(UUID) :-
  142    Version = 4,
  143    A is random(0xffffffff),
  144    B is random(0xffff),
  145    C is random(0x0fff) \/ Version<<12,
  146    D is random(0x3fff) \/ 0x8000,
  147    E is random(0xffffffffffff),
  148    UUID is (A<<96)+(B<<80)+(C<<84)+(D<<48)+E.
  149
  150:- endif.  151
  152%!  uuid_property(+UUID, ?Property)
  153%
  154%   True when UUID is a property of the given UUID. Supported properties
  155%   are:
  156%
  157%     - version(V)
  158%       Return the version of the UUID (1..5)
  159%     - time(-Stamp)
  160%       Time using SWI-Prolog's time stamp (float with seconds
  161%       since January 1, 1970, UTC).  Only for version 1 and 2
  162%       UUIDs
  163%
  164%   @tbd Implement more properties.
  165
  166uuid_property(UUID, P) :-
  167    property_uuid(P, UUID).
  168
  169property_uuid(version(V), UUID) :-
  170    split_string(UUID, "-", "", [_A,_B,C,_D,_E]),
  171    sub_string(C, 0, 1, _, F),
  172    char_type(F, xdigit(V)).
  173property_uuid(time(Time), UUID) :-
  174    split_string(UUID, "-", "", [A,B,C,_D,_E]),
  175    sub_atom(C, 0, 1, _, F),
  176    has_time(F),
  177    sub_string(C, 1, _, 0, T),
  178    atomics_to_string(["0x",T,B,A], Hex),
  179    number_string(Nanos, Hex),
  180    Offset is 24*60*60*141427*10 000 000,
  181    Time is (Nanos-Offset)/10000000.0.
  182
  183has_time('1').
  184has_time('2').
  185
  186%!  is_uuid(@UUID) is semidet.
  187%
  188%   True when UUID is a UUID represented as an atom. It merely validates
  189%   that the length is 36 characters, there   are `-` at the right place
  190%   and all other characters are hexadecimal.
  191
  192is_uuid(UUID) :-
  193    atom(UUID),
  194    atom_length(UUID, 36),
  195    atom_codes(UUID, Codes),
  196    Codes = [ _,_,_,_,_,_,_,_, 0'-,
  197              _,_,_,_, 0'-,
  198              _,_,_,_, 0'-,
  199              _,_,_,_, 0'-,
  200              _,_,_,_,_,_,_,_,_,_,_,_
  201            ],
  202    maplist(hex_or_minus, Codes).
  203
  204hex_or_minus(0'-) :-
  205    !.
  206hex_or_minus(Code) :-
  207    code_type(Code, xdigit(_))