1:- module(
    2  hash_ext,
    3  [
    4    hash_algorithm/1, % ?Name
    5    hash_directory/2, % +Hash, -Directory
    6    hash_directory/3, % +Root, +Hash, -Directory
    7    hash_file/3,      % +Hash, +Local, -File
    8    hash_file/4,      % +Root, +Hash, +Local, -File
    9    md5/2,            % +Term, -Hash
   10    md5/3,            % +Term, -Hash, +Options
   11    md5_text/2,       % +Text, -Hash
   12    md5_text/3,       % +Text, -Hash, +Options
   13    sha/2,            % +Term, -Hash
   14    sha/3,            % +Term, -Hash, +Options
   15    sha_text/2,       % +Text, -Hash
   16    sha_text/3        % +Text, -Hash, +Options
   17  ]
   18).

Extended support for hashes

*/

   24:- use_module(library(lists)).   25:- reexport(library(md5), [
   26     md5_hash/3 as md5_text
   27   ]).   28:- reexport(library(sha), [
   29     sha_hash/3 as sha_text
   30   ]).   31
   32:- use_module(library(dict)).   33:- use_module(library(file_ext)).
 hash_algorithm(+Name:atom) is semidet
hash_algorithm(-Name:atom) is multi
The hash types that are supported by this module.
   44hash_algorithm(md5).
   45hash_algorithm(sha1).
   46hash_algorithm(sha224).
   47hash_algorithm(sha256).
   48hash_algorithm(sha384).
   49hash_algorithm(sha512).
 hash_directory(+Hash:atom, -Directory:atom) is det
 hash_directory(+Root:atom, +Hash:atom, -Directory:atom) is det
   56hash_directory(Hash, Dir2) :-
   57  working_directory(Root),
   58  hash_directory(Root, Hash, Dir2).
   59
   60
   61hash_directory(Root, Hash, Dir2) :-
   62  sub_atom(Hash, 0, 2, _, Subdir1),
   63  directory_file_path(Root, Subdir1, Dir1),
   64  sub_atom(Hash, 2, _, 0, Subdir2),
   65  directory_file_path(Dir1, Subdir2, Dir2).
 hash_file(+Hash:atom, +Local:atom, -File:atom) is det
 hash_file(+Root:atom, +Hash:atom, +Local:atom, -File:atom) is det
   72hash_file(Hash, Local, File) :-
   73  working_directory(Root),
   74  hash_file(Root, Hash, Local, File).
   75
   76
   77hash_file(Root, Hash, Local, File) :-
   78  hash_directory(Root, Hash, Dir),
   79  create_directory(Dir),
   80  directory_file_path(Dir, Local, File).
 md5(+Term, -Hash:atom) is det
 md5(+Term, -Hash:atom, +Options:options) is det
   87md5(Term, Hash) :-
   88  md5(Term, Hash, options{}).
   89
   90
   91md5(Term, Hash, Options1) :-
   92  term_to_atom(Term, Atom),
   93  dict_terms(Options1, Options2),
   94  md5_hash(Atom, Hash, Options2).
 md5_text(+Text:text, -Hash:atom) is det
 md5_text(+Text:text, -Hash:atom, +Options:options) is det
  101md5_text(Text, Hash) :-
  102  md5_text(Text, Hash, []).
 sha(+Term, -Hash:atom) is det
 sha(+Term, -Hash:atom, +Options:options) is det
  109sha(Data, Hash) :-
  110  sha(Data, Hash, options{}).
  111
  112
  113sha(Term, Hash, Options1) :-
  114  term_to_atom(Term, Atom),
  115  dict_terms(Options1, Options2),
  116  sha_hash(Atom, Hash, Options2).
 sha_text(+Text:text, -Hash:atom) is det
 sha_text(+Text:text, -Hash:atom, +Options:options) is det
  123sha_text(Text, Hash) :-
  124  sha_text(Text, Hash, [])