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-2017, 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            attach_packs/2,                     % +Dir, +Options
   39            '$pack_detach'/2,                   % +Name, -Dir
   40            '$pack_attach'/1                    % +Dir
   41          ]).   42
   43:- multifile user:file_search_path/2.   44:- dynamic user:file_search_path/2.   45
   46:- dynamic
   47    pack_dir/3,                             % Pack, Type, Dir
   48    pack/2.                                 % Pack, BaseDir
   49:- volatile
   50    pack_dir/3,
   51    pack/2.   52
   53
   54user:file_search_path(pack, app_data(pack)).
   55user:file_search_path(pack, swi(pack)).
   56
   57user:file_search_path(library, PackLib) :-
   58    pack_dir(_Name, prolog, PackLib).
   59user:file_search_path(foreign, PackLib) :-
   60    pack_dir(_Name, foreign, PackLib).

 $pack_detach(+Name, -Dir) is det

Detach the given package from the search paths and list of registered packages, but does not delete the files.

   67'$pack_detach'(Name, Dir) :-
   68    (   atom(Name)
   69    ->  true
   70    ;   throw(error(type_error(atom, Name), _))
   71    ),
   72    (   retract(pack(Name, Dir))
   73    ->  retractall(pack_dir(Name, _, _)),
   74        reload_library_index
   75    ;   throw(error(existence_error(pack, Name), _))
   76    ).

 $pack_attach(+Dir) is det

Attach the given package

   82'$pack_attach'(Dir) :-
   83    attach_package(Dir, []),
   84    !.
   85'$pack_attach'(Dir) :-
   86    (   exists_directory(Dir)
   87    ->  throw(error(existence_error(directory, Dir), _))
   88    ;   throw(error(domain_error(pack, Dir), _))
   89    ).

 attach_packs

Attach packages from all package directories.

   95attach_packs :-
   96    findall(PackDir, absolute_file_name(pack(.), PackDir,
   97                                        [ file_type(directory),
   98                                          access(read),
   99                                          solutions(all)
  100                                        ]),
  101            PackDirs),
  102    (   PackDirs \== []
  103    ->  remove_dups(PackDirs, UniquePackDirs, []),
  104        forall('$member'(PackDir, UniquePackDirs),
  105               attach_packs(PackDir))
  106    ;   true
  107    ).

 remove_dups(+List, -Unique, +Seen) is det

Remove duplicates from List, keeping the first solution.

  113remove_dups([], [], _).
  114remove_dups([H|T0], T, Seen) :-
  115    memberchk(H, Seen),
  116    !,
  117    remove_dups(T0, T, Seen).
  118remove_dups([H|T0], [H|T], Seen) :-
  119    remove_dups(T0, T, [H|Seen]).

 attach_packs(+Dir) is det

 attach_packs(+Dir, +Options) is det

Attach packages from directory Dir. Options processed:

duplicate(+Action)

What to do if the same package is already installed in a different directory. Action is one of

warning

Warn and ignore the package

keep

Silently ignore the package

replace

Unregister the existing and insert the new package

search(+Where)

Determines the order of searching package library directories. Default is last, alternative is first.

  140attach_packs(Dir) :-
  141    attach_packs(Dir, []).
  142
  143attach_packs(Dir, Options) :-
  144    absolute_file_name(Dir, Path,
  145                       [ file_type(directory),
  146                         file_errors(fail)
  147                       ]),
  148    catch(directory_files(Path, Entries), _, fail),
  149    !,
  150    ensure_slash(Path, SPath),
  151    attach_packages(Entries, SPath, Options).
  152attach_packs(_, _).
  153
  154attach_packages([], _, _).
  155attach_packages([H|T], Dir, Options) :-
  156    attach_package(H, Dir, Options),
  157    attach_packages(T, Dir, Options).
  158
  159attach_package(Entry, Dir, Options) :-
  160    \+ special(Entry),
  161    atom_concat(Dir, Entry, PackDir),
  162    attach_package(PackDir, Options),
  163    !.
  164attach_package(_, _, _).
  165
  166special(.).
  167special(..).

 attach_package(+PackDir, +Options) is semidet

To be done

- Deal with autoload index. Reload?

  174attach_package(PackDir, Options) :-
  175    atomic_list_concat([PackDir, '/pack.pl'], InfoFile),
  176    access_file(InfoFile, read),
  177    file_base_name(PackDir, Pack),
  178    check_existing(Pack, PackDir, Options),
  179    foreign_dir(Pack, PackDir, ForeignDir),
  180    prolog_dir(PackDir, PrologDir),
  181    !,
  182    assertz(pack(Pack, PackDir)),
  183    '$option'(search(Where), Options, last),
  184    (   Where == last
  185    ->  assertz(pack_dir(Pack, prolog, PrologDir))
  186    ;   Where == first
  187    ->  asserta(pack_dir(Pack, prolog, PrologDir))
  188    ;   '$domain_error'(option_search, Where)
  189    ),
  190    update_autoload(PrologDir),
  191    (   ForeignDir \== (-)
  192    ->  assertz(pack_dir(Pack, foreign, ForeignDir))
  193    ;   true
  194    ),
  195    print_message(silent, pack(attached(Pack, PackDir))).

 check_existing(+Pack, +PackDir, +Options) is semidet

Verify that we did not load this package before.

  202check_existing(Entry, Dir, _) :-
  203    retract(pack(Entry, Dir)),             % registered from same place
  204    !,
  205    retractall(pack_dir(Entry, _, _)).
  206check_existing(Entry, Dir, Options) :-
  207    pack(Entry, OldDir),
  208    !,
  209    '$option'(duplicate(Action), Options, warning),
  210    (   Action == warning
  211    ->  print_message(warning, pack(duplicate(Entry, OldDir, Dir))),
  212        fail
  213    ;   Action == keep
  214    ->  fail
  215    ;   Action == replace
  216    ->  print_message(silent, pack(replaced(Entry, OldDir, Dir))),
  217        '$pack_detach'(Entry, OldDir)
  218    ;   '$domain_error'(option_duplicate, Action)
  219    ).
  220check_existing(_, _, _).
  221
  222
  223prolog_dir(PackDir, PrologDir) :-
  224    atomic_list_concat([PackDir, '/prolog'], PrologDir),
  225    exists_directory(PrologDir).
  226
  227update_autoload(PrologDir) :-
  228    atom_concat(PrologDir, '/INDEX.pl', IndexFile),
  229    (   exists_file(IndexFile)
  230    ->  reload_library_index
  231    ;   true
  232    ).
  233
  234foreign_dir(Pack, PackDir, ForeignDir) :-
  235    current_prolog_flag(arch, Arch),
  236    atomic_list_concat([PackDir, '/lib'], ForeignBaseDir),
  237    exists_directory(ForeignBaseDir),
  238    !,
  239    atomic_list_concat([PackDir, '/lib/', Arch], ForeignDir),
  240    (   exists_directory(ForeignDir)
  241    ->  assertz(pack_dir(Pack, foreign, ForeignDir))
  242    ;   print_message(warning, pack(no_arch(Pack, Arch))),
  243        fail
  244    ).
  245foreign_dir(_, _, (-)).
  246
  247ensure_slash(Dir, SDir) :-
  248    (   sub_atom(Dir, _, _, 0, /)
  249    ->  SDir = Dir
  250    ;   atom_concat(Dir, /, SDir)
  251    )