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-2015, VU University Amsterdam
   7    All rights reserved.
   8
   9    Redistribution and use in source and binary forms, with or without
  10    modification, are permitted provided that the following conditions
  11    are met:
  12
  13    1. Redistributions of source code must retain the above copyright
  14       notice, this list of conditions and the following disclaimer.
  15
  16    2. Redistributions in binary form must reproduce the above copyright
  17       notice, this list of conditions and the following disclaimer in
  18       the documentation and/or other materials provided with the
  19       distribution.
  20
  21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
  26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
  27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
  31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
  32    POSSIBILITY OF SUCH DAMAGE.
  33*/
  34
  35:- module('$pack',
  36          [ attach_packs/0,
  37            attach_packs/1,                     % +Dir
  38            '$pack_detach'/2,                   % +Name, -Dir
  39            '$pack_attach'/1                    % +Dir
  40          ]).
  41
  42:- multifile user:file_search_path/2.
  43:- dynamic user:file_search_path/2.
  44
  45:- dynamic
  46    pack_dir/3,                             % Pack, Type, Dir
  47    pack/2.                                 % Pack, BaseDir
  48:- volatile
  49    pack_dir/3,
  50    pack/2.
  51
  52
  53user:file_search_path(pack, app_data(pack)).
  54user:file_search_path(pack, swi(pack)).
  55
  56user:file_search_path(library, PackLib) :-
  57    pack_dir(_Name, prolog, PackLib).
  58user:file_search_path(foreign, PackLib) :-
  59    pack_dir(_Name, foreign, PackLib).
  60
  61%!  '$pack_detach'(+Name, -Dir) is det.
  62%
  63%   Detach the given package  from  the   search  paths  and list of
  64%   registered packages, but does not delete the files.
  65
  66'$pack_detach'(Name, Dir) :-
  67    (   atom(Name)
  68    ->  true
  69    ;   throw(error(type_error(atom, Name), _))
  70    ),
  71    (   retract(pack(Name, Dir))
  72    ->  retractall(pack_dir(Name, _, _)),
  73        reload_library_index
  74    ;   throw(error(existence_error(pack, Name), _))
  75    ).
  76
  77%!  '$pack_attach'(+Dir) is det.
  78%
  79%   Attach the given package
  80
  81'$pack_attach'(Dir) :-
  82    attach_package(Dir),
  83    !.
  84'$pack_attach'(Dir) :-
  85    (   exists_directory(Dir)
  86    ->  throw(error(existence_error(directory, Dir), _))
  87    ;   throw(error(domain_error(pack, Dir), _))
  88    ).
  89
  90%!  attach_packs
  91%
  92%   Attach packages from all package directories.
  93
  94attach_packs :-
  95    findall(PackDir, absolute_file_name(pack(.), PackDir,
  96                                        [ file_type(directory),
  97                                          access(read),
  98                                          solutions(all)
  99                                        ]),
 100            PackDirs),
 101    (   PackDirs \== []
 102    ->  remove_dups(PackDirs, UniquePackDirs, []),
 103        forall('$member'(PackDir, UniquePackDirs),
 104               attach_packs(PackDir))
 105    ;   true
 106    ).
 107
 108%!  remove_dups(+List, -Unique, +Seen) is det.
 109%
 110%   Remove duplicates from List, keeping the first solution.
 111
 112remove_dups([], [], _).
 113remove_dups([H|T0], T, Seen) :-
 114    memberchk(H, Seen),
 115    !,
 116    remove_dups(T0, T, Seen).
 117remove_dups([H|T0], [H|T], Seen) :-
 118    remove_dups(T0, T, [H|Seen]).
 119
 120
 121%!  attach_packs(+Dir)
 122%
 123%   Attach packages from directory Dir.
 124
 125attach_packs(Dir) :-
 126    catch(directory_files(Dir, Entries), _, fail),
 127    !,
 128    ensure_slash(Dir, SDir),
 129    attach_packages(Entries, SDir).
 130attach_packs(_).
 131
 132attach_packages([], _).
 133attach_packages([H|T], Dir) :-
 134    attach_package(H, Dir),
 135    attach_packages(T, Dir).
 136
 137attach_package(Entry, Dir) :-
 138    \+ special(Entry),
 139    atom_concat(Dir, Entry, PackDir),
 140    attach_package(PackDir),
 141    !.
 142attach_package(_, _).
 143
 144special(.).
 145special(..).
 146
 147
 148%!  attach_package(+PackDir) is semidet.
 149%
 150%   @tbd    Deal with autoload index.  Reload?
 151
 152attach_package(PackDir) :-
 153    atomic_list_concat([PackDir, '/pack.pl'], InfoFile),
 154    access_file(InfoFile, read),
 155    file_base_name(PackDir, Pack),
 156    check_existing(Pack, PackDir),
 157    foreign_dir(Pack, PackDir, ForeignDir),
 158    prolog_dir(PackDir, PrologDir),
 159    !,
 160    assertz(pack(Pack, PackDir)),
 161    assertz(pack_dir(Pack, prolog, PrologDir)),
 162    update_autoload(PrologDir),
 163    (   ForeignDir \== (-)
 164    ->  assertz(pack_dir(Pack, foreign, ForeignDir))
 165    ;   true
 166    ),
 167    print_message(silent, pack(attached(Pack, PackDir))).
 168
 169
 170%!  check_existing(+Pack, +PackDir) is semidet.
 171%
 172%   Verify that we did not load this package before.
 173
 174check_existing(Entry, Dir) :-
 175    retract(pack(Entry, Dir)),             % registered from same place
 176    !,
 177    retractall(pack_dir(Entry, _, _)).
 178check_existing(Entry, Dir) :-
 179    pack(Entry, OldDir),
 180    !,
 181    print_message(warning, pack(duplicate(Entry, OldDir, Dir))),
 182    fail.
 183check_existing(_, _).
 184
 185
 186prolog_dir(PackDir, PrologDir) :-
 187    atomic_list_concat([PackDir, '/prolog'], PrologDir),
 188    exists_directory(PrologDir).
 189
 190update_autoload(PrologDir) :-
 191    atom_concat(PrologDir, '/INDEX.pl', IndexFile),
 192    (   exists_file(IndexFile)
 193    ->  reload_library_index
 194    ;   true
 195    ).
 196
 197foreign_dir(Pack, PackDir, ForeignDir) :-
 198    current_prolog_flag(arch, Arch),
 199    atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
 200    exists_directory(ForeignBaseDir),
 201    !,
 202    atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
 203    (   exists_directory(ForeignDir)
 204    ->  assertz(pack_dir(Pack, foreign, ForeignDir))
 205    ;   print_message(warning, pack(no_arch(Pack, Arch))),
 206        fail
 207    ).
 208foreign_dir(_, _, (-)).
 209
 210ensure_slash(Dir, SDir) :-
 211    (   sub_atom(Dir, _, _, 0, /)
 212    ->  SDir = Dir
 213    ;   atom_concat(Dir, /, SDir)
 214    ).