View source with raw 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)  2002-2023, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9                              SWI-Prolog Solutions b.v.
   10    All rights reserved.
   11
   12    Redistribution and use in source and binary forms, with or without
   13    modification, are permitted provided that the following conditions
   14    are met:
   15
   16    1. Redistributions of source code must retain the above copyright
   17       notice, this list of conditions and the following disclaimer.
   18
   19    2. Redistributions in binary form must reproduce the above copyright
   20       notice, this list of conditions and the following disclaimer in
   21       the documentation and/or other materials provided with the
   22       distribution.
   23
   24    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   25    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   26    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   27    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   28    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   29    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   30    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   31    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   32    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   33    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   34    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   35    POSSIBILITY OF SUCH DAMAGE.
   36*/
   37
   38:- module(files_ex,
   39          [ set_time_file/3,            % +File, -OldTimes, +NewTimes
   40            link_file/3,                % +OldPath, +NewPath, +Type
   41            chmod/2,                    % +File, +Mode
   42            relative_file_name/3,       % ?AbsPath, +RelTo, ?RelPath
   43            directory_file_path/3,      % +Dir, +File, -Path
   44            directory_member/3,		% +Dir, -Member, +Options
   45            copy_file/2,                % +From, +To
   46            make_directory_path/1,      % +Directory
   47            ensure_directory/1,         % +Directory
   48            copy_directory/2,           % +Source, +Destination
   49            delete_directory_and_contents/1, % +Dir
   50            delete_directory_contents/1 % +Dir
   51          ]).   52:- autoload(library(apply),[maplist/2,maplist/3,foldl/4]).   53:- autoload(library(error),
   54	    [permission_error/3,must_be/2,domain_error/2]).   55:- autoload(library(lists),[member/2]).   56:- autoload(library(nb_set),[empty_nb_set/1,add_nb_set/3]).

Extended operations on files

This module provides additional operations on files. This covers both more obscure and possible non-portable low-level operations and high-level utilities.

Using these Prolog primitives is typically to be preferred over using operating system primitives through shell/1 or process_create/3 because (1) there are no potential file name quoting issues, (2) there is no dependency on operating system commands and (3) using the implementations from this library is usually faster. */

   72:- predicate_options(directory_member/3, 3,
   73                     [ recursive(boolean),
   74                       follow_links(boolean),
   75                       file_type(atom),
   76                       extensions(list(atom)),
   77                       file_errors(oneof([fail,warning,error])),
   78                       access(oneof([read,write,execute])),
   79                       matches(text),
   80                       exclude(text),
   81                       exclude_directory(text),
   82                       hidden(boolean)
   83                     ]).   84
   85
   86:- use_foreign_library(foreign(files)).
 set_time_file(+File, -OldTimes, +NewTimes) is det
Query and set POSIX time attributes of a file. Both OldTimes and NewTimes are lists of option-terms. Times are represented in SWI-Prolog's standard floating point numbers. New times may be specified as now to indicate the current time. Defined options are:
access(Time)
Describes the time of last access of the file. This value can be read and written.
modified(Time)
Describes the time the contents of the file was last modified. This value can be read and written.
changed(Time)
Describes the time the file-structure itself was changed by adding (link()) or removing (unlink()) names.

Below are some example queries. The first retrieves the access-time, while the second sets the last-modified time to the current time.

?- set_time_file(foo, [access(Access)], []).
?- set_time_file(foo, [], [modified(now)]).
 link_file(+OldPath, +NewPath, +Type) is det
Create a link in the filesystem from NewPath to OldPath. Type defines the type of link and is one of hard or symbolic.

With some limitations, these functions also work on Windows. First of all, the underlying filesystem must support links. This requires NTFS. Second, symbolic links are only supported in Vista and later.

Errors
- domain_error(link_type, Type) if the requested link-type is unknown or not supported on the target OS.
 relative_file_name(+Path:atom, +RelToFile:atom, -RelPath:atom) is det
relative_file_name(-Path:atom, +RelToFile:atom, +RelPath:atom) is det
True when RelPath is Path, relative to the file RelToFile. Path and RelTo are first handed to absolute_file_name/2, which makes the absolute and canonical. Below are two examples:
?- relative_file_name('/home/janw/nice',
                      '/home/janw/deep/dir/file', Path).
Path = '../../nice'.

?- relative_file_name(Path, '/home/janw/deep/dir/file', '../../nice').
Path = '/home/janw/nice'.

Add a terminating / to get a path relative to a directory, e.g.

?- relative_file_name('/home/janw/deep/dir/file', './', Path).
Path = 'deep/dir/file'.
Arguments:
All- paths must be in canonical POSIX notation, i.e., using / to separate segments in the path. See prolog_to_os_filename/2.
bug
- It would probably have been cleaner to use a directory as second argument. We can not do such dynamically as this predicate is defined as a syntactical operation, which implies it may be used for non-existing paths and URLs.
  158relative_file_name(Path, RelTo, RelPath) :- % +,+,-
  159    nonvar(Path),
  160    !,
  161    absolute_file_name(Path, AbsPath),
  162    absolute_file_name(RelTo, AbsRelTo),
  163    atomic_list_concat(PL, /, AbsPath),
  164    atomic_list_concat(RL, /, AbsRelTo),
  165    delete_common_prefix(PL, RL, PL1, PL2),
  166    to_dot_dot(PL2, DotDot, PL1),
  167    (   DotDot == []
  168    ->  RelPath = '.'
  169    ;   atomic_list_concat(DotDot, /, RelPath)
  170    ).
  171relative_file_name(Path, RelTo, RelPath) :-
  172    (   is_absolute_file_name(RelPath)
  173    ->  Path = RelPath
  174    ;   file_directory_name(RelTo, RelToDir),
  175        directory_file_path(RelToDir, RelPath, Path0),
  176        absolute_file_name(Path0, Path)
  177    ).
  178
  179delete_common_prefix([H|T01], [H|T02], T1, T2) :-
  180    !,
  181    delete_common_prefix(T01, T02, T1, T2).
  182delete_common_prefix(T1, T2, T1, T2).
  183
  184to_dot_dot([], Tail, Tail).
  185to_dot_dot([_], Tail, Tail) :- !.
  186to_dot_dot([_|T0], ['..'|T], Tail) :-
  187    to_dot_dot(T0, T, Tail).
 directory_file_path(+Directory, +File, -Path) is det
directory_file_path(?Directory, ?File, +Path) is det
True when Path is the full path-name for File in Dir. This is comparable to atom_concat(Directory, File, Path), but it ensures there is exactly one / between the two parts. Notes:
  201directory_file_path(Dir, File, Path) :-
  202    nonvar(Dir), nonvar(File),
  203    !,
  204    (   (   is_absolute_file_name(File)
  205        ;   Dir == '.'
  206        )
  207    ->  Path = File
  208    ;   sub_atom(Dir, _, _, 0, /)
  209    ->  atom_concat(Dir, File, Path)
  210    ;   atomic_list_concat([Dir, /, File], Path)
  211    ).
  212directory_file_path(Dir, File, Path) :-
  213    nonvar(Path),
  214    !,
  215    (   nonvar(Dir)
  216    ->  (   Dir == '.',
  217            \+ is_absolute_file_name(Path)
  218        ->  File = Path
  219        ;   sub_atom(Dir, _, _, 0, /)
  220        ->  atom_concat(Dir, File, Path)
  221        ;   atom_concat(Dir, /, TheDir)
  222        ->  atom_concat(TheDir, File, Path)
  223        )
  224    ;   nonvar(File)
  225    ->  atom_concat(Dir0, File, Path),
  226        strip_trailing_slash(Dir0, Dir)
  227    ;   file_directory_name(Path, Dir),
  228        file_base_name(Path, File)
  229    ).
  230directory_file_path(_, _, _) :-
  231    throw(error(instantiation_error(_), _)).
  232
  233strip_trailing_slash(Dir0, Dir) :-
  234    (   atom_concat(D, /, Dir0),
  235        D \== ''
  236    ->  Dir = D
  237    ;   Dir = Dir0
  238    ).
 directory_member(+Directory, -Member, +Options) is nondet
True when Member is a path inside Directory. Options defined are:
recursive(+Boolean)
If true (default false), recurse into subdirectories
follow_links(+Boolean)
If true (default), follow symbolic links.
file_type(+Type)
See absolute_file_name/3.
extensions(+List)
Only return entries whose extension appears in List.
file_errors(+Errors)
How to handle errors. One of fail, warning or error. Default is warning. Errors notably happen if a directory is unreadable or a link points nowhere.
access(+Access)
Only return entries with Access
matches(+GlobPattern)
Only return files that match GlobPattern.
exclude(+GlobPattern)
Exclude files matching GlobPattern.
exclude_directory(+GlobPattern)
Do not recurse into directories matching GlobPattern.
hidden(+Boolean)
If true (default), also return hidden files.

This predicate is safe against cycles introduced by symbolic links to directories.

The idea for a non-deterministic file search predicate comes from Nicos Angelopoulos.

  274directory_member(Directory, Member, Options) :-
  275    dict_create(Dict, options, Options),
  276    (   Dict.get(recursive) == true,
  277        \+ Dict.get(follow_links) == false
  278    ->  empty_nb_set(Visited),
  279        DictOptions = Dict.put(visited, Visited)
  280    ;   DictOptions = Dict
  281    ),
  282    directory_member_dict(Directory, Member, DictOptions).
  283
  284directory_member_dict(Directory, Member, Dict) :-
  285    directory_files(Directory, Files, Dict),
  286    member(Entry, Files),
  287    \+ special(Entry),
  288    directory_file_path(Directory, Entry, AbsEntry),
  289    filter_link(AbsEntry, Dict),
  290    (   exists_directory(AbsEntry)
  291    ->  (   filter_dir_member(AbsEntry, Entry, Dict),
  292            Member = AbsEntry
  293        ;   filter_directory(Entry, Dict),
  294            Dict.get(recursive) == true,
  295            \+ hidden_file(Entry, Dict),
  296            no_link_cycle(AbsEntry, Dict),
  297            directory_member_dict(AbsEntry, Member, Dict)
  298        )
  299    ;   filter_dir_member(AbsEntry, Entry, Dict),
  300        Member = AbsEntry
  301    ).
  302
  303directory_files(Directory, Files, Dict) :-
  304    Errors = Dict.get(file_errors),
  305    !,
  306    errors_directory_files(Errors, Directory, Files).
  307directory_files(Directory, Files, _Dict) :-
  308    errors_directory_files(warning, Directory, Files).
  309
  310errors_directory_files(fail, Directory, Files) :-
  311    catch(directory_files(Directory, Files), _, fail).
  312errors_directory_files(warning, Directory, Files) :-
  313    catch(directory_files(Directory, Files), E,
  314          (   print_message(warning, E),
  315              fail)).
  316errors_directory_files(error, Directory, Files) :-
  317    directory_files(Directory, Files).
  318
  319
  320filter_link(File, Dict) :-
  321    \+ ( Dict.get(follow_links) == false,
  322         read_link(File, _, _)
  323       ).
  324
  325no_link_cycle(Directory, Dict) :-
  326    Visited = Dict.get(visited),
  327    !,
  328    absolute_file_name(Directory, Canonical,
  329                       [ file_type(directory)
  330                       ]),
  331    add_nb_set(Canonical, Visited, true).
  332no_link_cycle(_, _).
  333
  334hidden_file(Entry, Dict) :-
  335    false == Dict.get(hidden),
  336    sub_atom(Entry, 0, _, _, '.').
 filter_dir_member(+Absolute, +BaseName, +Options)
True when the given file satisfies the filter expressions.
  342filter_dir_member(_AbsEntry, Entry, Dict) :-
  343    Exclude = Dict.get(exclude),
  344    wildcard_match(Exclude, Entry),
  345    !, fail.
  346filter_dir_member(_AbsEntry, Entry, Dict) :-
  347    Include = Dict.get(matches),
  348    \+ wildcard_match(Include, Entry),
  349    !, fail.
  350filter_dir_member(AbsEntry, _Entry, Dict) :-
  351    Type = Dict.get(file_type),
  352    \+ matches_type(Type, AbsEntry),
  353    !, fail.
  354filter_dir_member(_AbsEntry, Entry, Dict) :-
  355    ExtList = Dict.get(extensions),
  356    file_name_extension(_, Ext, Entry),
  357    \+ memberchk(Ext, ExtList),
  358    !, fail.
  359filter_dir_member(AbsEntry, _Entry, Dict) :-
  360    Access = Dict.get(access),
  361    \+ access_file(AbsEntry, Access),
  362    !, fail.
  363filter_dir_member(_AbsEntry, Entry, Dict) :-
  364    hidden_file(Entry, Dict),
  365    !, fail.
  366filter_dir_member(_, _, _).
  367
  368matches_type(directory, Entry) :-
  369    !,
  370    exists_directory(Entry).
  371matches_type(Type, Entry) :-
  372    \+ exists_directory(Entry),
  373    user:prolog_file_type(Ext, Type),
  374    file_name_extension(_, Ext, Entry).
 filter_directory(+Entry, +Dict) is semidet
Implement the exclude_directory(+GlobPattern) option.
  381filter_directory(Entry, Dict) :-
  382    Exclude = Dict.get(exclude_directory),
  383    wildcard_match(Exclude, Entry),
  384    !, fail.
  385filter_directory(_, _).
 copy_file(+From, +To) is det
Copy a file into a new file or directory. The data is copied as binary data.
  393copy_file(From, To) :-
  394    destination_file(To, From, Dest),
  395    setup_call_cleanup(
  396        open(Dest, write, Out, [type(binary)]),
  397        copy_from(From, Out),
  398        close(Out)).
  399
  400copy_from(File, Stream) :-
  401    setup_call_cleanup(
  402        open(File, read, In, [type(binary)]),
  403        copy_stream_data(In, Stream),
  404        close(In)).
  405
  406destination_file(Dir, File, Dest) :-
  407    exists_directory(Dir),
  408    !,
  409    file_base_name(File, Base),
  410    directory_file_path(Dir, Base, Dest).
  411destination_file(Dest, _, Dest).
 make_directory_path(+Dir) is det
Create Dir and all required components (like mkdir -p). Can raise various file-specific exceptions.
  419make_directory_path(Dir) :-
  420    make_directory_path_2(Dir),
  421    !.
  422make_directory_path(Dir) :-
  423    permission_error(create, directory, Dir).
  424
  425make_directory_path_2(Dir) :-
  426    exists_directory(Dir),
  427    !.
  428make_directory_path_2(Dir) :-
  429    atom_concat(RealDir, '/', Dir),
  430    RealDir \== '',
  431    !,
  432    make_directory_path_2(RealDir).
  433make_directory_path_2(Dir) :-
  434    Dir \== (/),
  435    !,
  436    file_directory_name(Dir, Parent),
  437    make_directory_path_2(Parent),
  438    ensure_directory_(Dir).
 ensure_directory(+Dir) is det
Ensure the directory Dir exists. Similar to make_directory_path/1, but creates at most one new directory, i.e., the directory or its direct parent must exist.
  446ensure_directory(Dir) :-
  447    exists_directory(Dir),
  448    !.
  449ensure_directory(Dir) :-
  450    atom_concat(RealDir, '/', Dir),
  451    RealDir \== '',
  452    !,
  453    ensure_directory(RealDir).
  454ensure_directory(Dir) :-
  455    ensure_directory_(Dir).
  456
  457ensure_directory_(Dir) :-
  458    E = error(existence_error(directory, _), _),
  459    catch(make_directory(Dir), E,
  460          (   exists_directory(Dir)
  461          ->  true
  462          ;   throw(E)
  463          )).
 copy_directory(+From, +To) is det
Copy the contents of the directory From to To (recursively). If To is the name of an existing directory, the contents of From are copied into To. I.e., no subdirectory using the basename of From is created.
  473copy_directory(From, To) :-
  474    (   exists_directory(To)
  475    ->  true
  476    ;   make_directory(To)
  477    ),
  478    directory_files(From, Entries),
  479    maplist(copy_directory_content(From, To), Entries).
  480
  481copy_directory_content(_From, _To, Special) :-
  482    special(Special),
  483    !.
  484copy_directory_content(From, To, Entry) :-
  485    directory_file_path(From, Entry, Source),
  486    directory_file_path(To, Entry, Dest),
  487    (   exists_directory(Source)
  488    ->  copy_directory(Source, Dest)
  489    ;   copy_file(Source, Dest)
  490    ).
  491
  492special(.).
  493special(..).
 delete_directory_and_contents(+Dir) is det
Recursively remove the directory Dir and its contents. If Dir is a symbolic link or symbolic links inside Dir are encountered, the links are removed rather than their content. Use with care!
  501delete_directory_and_contents(Dir) :-
  502    read_link(Dir, _, _),
  503    !,
  504    delete_file(Dir).
  505delete_directory_and_contents(Dir) :-
  506    directory_files(Dir, Files),
  507    maplist(delete_directory_contents(Dir), Files),
  508    E = error(existence_error(directory, _), _),
  509    catch(delete_directory(Dir), E,
  510          (   \+ exists_directory(Dir)
  511          ->  true
  512          ;   throw(E)
  513          )).
  514
  515delete_directory_contents(_, Entry) :-
  516    special(Entry),
  517    !.
  518delete_directory_contents(Dir, Entry) :-
  519    directory_file_path(Dir, Entry, Delete),
  520    (   exists_directory(Delete)
  521    ->  delete_directory_and_contents(Delete)
  522    ;   E = error(existence_error(file, _), _),
  523        catch(delete_file(Delete), E,
  524              (   \+ exists_file(Delete)
  525              ->  true
  526              ;   throw(E)))
  527    ).
 delete_directory_contents(+Dir) is det
Remove all content from directory Dir, without removing Dir itself. Similar to delete_directory_and_contents/2, if symbolic links are encountered in Dir, the links are removed rather than their content.
  536delete_directory_contents(Dir) :-
  537    directory_files(Dir, Files),
  538    maplist(delete_directory_contents(Dir), Files).
 chmod(+File, +Spec) is det
Set the mode of the target file. Spec is one of +Mode, -Mode or a plain Mode, which adds new permissions, revokes permissions or sets the exact permissions. Mode itself is an integer, a POSIX mode name or a list of POSIX mode names. Defines names are suid, sgid, svtx and all names defined by the regular expression [ugo]*[rwx]*. Specifying none of "ugo" is the same as specifying all of them. For example, to make a file executable for the owner (user) and group, we can use:
?- chmod(myfile, +ugx).
  556chmod(File, +Spec) :-
  557    must_be(ground, Spec),
  558    !,
  559    mode_bits(Spec, Bits),
  560    file_mode_(File, Mode0),
  561    Mode is Mode0 \/ Bits,
  562    chmod_(File, Mode).
  563chmod(File, -Spec) :-
  564    must_be(ground, Spec),
  565    !,
  566    mode_bits(Spec, Bits),
  567    file_mode_(File, Mode0),
  568    Mode is Mode0 /\ \Bits,
  569    chmod_(File, Mode).
  570chmod(File, Spec) :-
  571    must_be(ground, Spec),
  572    !,
  573    mode_bits(Spec, Bits),
  574    chmod_(File, Bits).
  575
  576mode_bits(Spec, Spec) :-
  577    integer(Spec),
  578    !.
  579mode_bits(Name, Bits) :-
  580    atom(Name),
  581    !,
  582    (   file_mode(Name, Bits)
  583    ->  true
  584    ;   domain_error(posix_file_mode, Name)
  585    ).
  586mode_bits(Spec, Bits) :-
  587    must_be(list(atom), Spec),
  588    phrase(mode_bits(0, Bits), Spec).
  589
  590mode_bits(Bits0, Bits) -->
  591    [Spec], !,
  592    (   { file_mode(Spec, B), Bits1 is Bits0\/B }
  593    ->  mode_bits(Bits1, Bits)
  594    ;   { domain_error(posix_file_mode, Spec) }
  595    ).
  596mode_bits(Bits, Bits) -->
  597    [].
  598
  599file_mode(suid, 0o4000).
  600file_mode(sgid, 0o2000).
  601file_mode(svtx, 0o1000).
  602file_mode(Name, Bits) :-
  603    atom_chars(Name, Chars),
  604    phrase(who_mask(0, WMask0), Chars, Rest),
  605    (   WMask0 =:= 0
  606    ->  WMask = 0o0777
  607    ;   WMask = WMask0
  608    ),
  609    maplist(mode_char, Rest, MBits),
  610    foldl(or, MBits, 0, Mask),
  611    Bits is Mask /\ WMask.
  612
  613who_mask(M0, M) -->
  614    [C],
  615    { who_mask(C,M1), !,
  616      M2 is M0\/M1
  617    },
  618    who_mask(M2,M).
  619who_mask(M, M) -->
  620    [].
  621
  622who_mask(o, 0o0007).
  623who_mask(g, 0o0070).
  624who_mask(u, 0o0700).
  625
  626mode_char(r, 0o0444).
  627mode_char(w, 0o0222).
  628mode_char(x, 0o0111).
  629
  630or(B1, B2, B) :-
  631    B is B1\/B2