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-2015, University of Amsterdam
   7                              Vu University Amsterdam
   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(files_ex,
  37          [ set_time_file/3,            % +File, -OldTimes, +NewTimes
  38            link_file/3,                % +OldPath, +NewPath, +Type
  39            relative_file_name/3,       % ?AbsPath, +RelTo, ?RelPath
  40            directory_file_path/3,      % +Dir, +File, -Path
  41            copy_file/2,                % +From, +To
  42            make_directory_path/1,      % +Directory
  43            copy_directory/2,           % +Source, +Destination
  44            delete_directory_and_contents/1, % +Dir
  45            delete_directory_contents/1 % +Dir
  46          ]).
  47
  48/** <module> Extended operations on files
  49
  50This module provides additional operations on   files.  This covers both
  51more  obscure  and  possible  non-portable    low-level  operations  and
  52high-level utilities.
  53
  54Using these Prolog primitives is typically   to  be preferred over using
  55operating system primitives through shell/1  or process_create/3 because
  56(1) there are no potential file  name   quoting  issues, (2) there is no
  57dependency  on  operating   system   commands    and   (3)   using   the
  58implementations from this library is usually faster.
  59*/
  60
  61
  62:- use_foreign_library(foreign(files), install_files).
  63
  64%!  set_time_file(+File, -OldTimes, +NewTimes) is det.
  65%
  66%   Query and set POSIX time attributes of a file. Both OldTimes and
  67%   NewTimes are lists of  option-terms.   Times  are represented in
  68%   SWI-Prolog's standard floating point numbers.   New times may be
  69%   specified as =now= to indicate the current time. Defined options
  70%   are:
  71%
  72%       * access(Time)
  73%       Describes the time of last access   of  the file. This value
  74%       can be read and written.
  75%
  76%       * modified(Time)
  77%       Describes the time  the  contents  of   the  file  was  last
  78%       modified. This value can be read and written.
  79%
  80%       * changed(Time)
  81%       Describes the time the file-structure  itself was changed by
  82%       adding (link()) or removing (unlink()) names.
  83%
  84%   Below  are  some  example  queries.   The  first  retrieves  the
  85%   access-time, while the second sets the last-modified time to the
  86%   current time.
  87%
  88%       ==
  89%       ?- set_time_file(foo, [access(Access)], []).
  90%       ?- set_time_file(foo, [], [modified(now)]).
  91%       ==
  92
  93%!  link_file(+OldPath, +NewPath, +Type) is det.
  94%
  95%   Create a link in the filesystem   from  NewPath to OldPath. Type
  96%   defines the type of link and is one of =hard= or =symbolic=.
  97%
  98%   With some limitations, these  functions   also  work on Windows.
  99%   First of all, the unerlying filesystem  must support links. This
 100%   requires NTFS. Second, symbolic  links   are  only  supported in
 101%   Vista and later.
 102%
 103%   @error  domain_error(link_type, Type) if the requested link-type
 104%           is unknown or not supported on the target OS.
 105
 106%!  relative_file_name(+Path:atom, +RelTo:atom, -RelPath:atom) is det.
 107%!  relative_file_name(-Path:atom, +RelTo:atom, +RelPath:atom) is det.
 108%
 109%   True when RelPath is Path, relative to RelTo. Path and RelTo are
 110%   first handed to absolute_file_name/2, which   makes the absolute
 111%   *and* canonical. Below are two examples:
 112%
 113%   ==
 114%   ?- relative_file_name('/home/janw/nice',
 115%                         '/home/janw/deep/dir/file', Path).
 116%   Path = '../../nice'.
 117%
 118%   ?- relative_file_name(Path, '/home/janw/deep/dir/file', '../../nice').
 119%   Path = '/home/janw/nice'.
 120%   ==
 121%
 122%   @param  All paths must be in canonical POSIX notation, i.e.,
 123%           using / to separate segments in the path.  See
 124%           prolog_to_os_filename/2.
 125%   @bug    This predicate is defined as a _syntactical_ operation.
 126
 127relative_file_name(Path, RelTo, RelPath) :- % +,+,-
 128    nonvar(Path),
 129    !,
 130    absolute_file_name(Path, AbsPath),
 131    absolute_file_name(RelTo, AbsRelTo),
 132    atomic_list_concat(PL, /, AbsPath),
 133    atomic_list_concat(RL, /, AbsRelTo),
 134    delete_common_prefix(PL, RL, PL1, PL2),
 135    to_dot_dot(PL2, DotDot, PL1),
 136    atomic_list_concat(DotDot, /, RelPath).
 137relative_file_name(Path, RelTo, RelPath) :-
 138    (   is_absolute_file_name(RelPath)
 139    ->  Path = RelPath
 140    ;   file_directory_name(RelTo, RelToDir),
 141        directory_file_path(RelToDir, RelPath, Path0),
 142        absolute_file_name(Path0, Path)
 143    ).
 144
 145delete_common_prefix([H|T01], [H|T02], T1, T2) :-
 146    !,
 147    delete_common_prefix(T01, T02, T1, T2).
 148delete_common_prefix(T1, T2, T1, T2).
 149
 150to_dot_dot([], Tail, Tail).
 151to_dot_dot([_], Tail, Tail) :- !.
 152to_dot_dot([_|T0], ['..'|T], Tail) :-
 153    to_dot_dot(T0, T, Tail).
 154
 155
 156%!  directory_file_path(+Directory, +File, -Path) is det.
 157%!  directory_file_path(?Directory, ?File, +Path) is det.
 158%
 159%   True when Path is the full path-name   for  File in Dir. This is
 160%   comparable to atom_concat(Directory, File, Path), but it ensures
 161%   there is exactly one / between the two parts.  Notes:
 162%
 163%     * In mode (+,+,-), if File is given and absolute, Path
 164%     is unified to File.
 165%     * Mode (-,-,+) uses file_directory_name/2 and file_base_name/2
 166
 167directory_file_path(Dir, File, Path) :-
 168    nonvar(Dir), nonvar(File),
 169    !,
 170    (   (   is_absolute_file_name(File)
 171        ;   Dir == '.'
 172        )
 173    ->  Path = File
 174    ;   sub_atom(Dir, _, _, 0, /)
 175    ->  atom_concat(Dir, File, Path)
 176    ;   atomic_list_concat([Dir, /, File], Path)
 177    ).
 178directory_file_path(Dir, File, Path) :-
 179    nonvar(Path),
 180    !,
 181    (   nonvar(Dir)
 182    ->  (   Dir == '.',
 183            \+ is_absolute_file_name(Path)
 184        ->  File = Path
 185        ;   sub_atom(Dir, _, _, 0, /)
 186        ->  atom_concat(Dir, File, Path)
 187        ;   atom_concat(Dir, /, TheDir)
 188        ->  atom_concat(TheDir, File, Path)
 189        )
 190    ;   nonvar(File)
 191    ->  atom_concat(Dir, File, Path)
 192    ;   file_directory_name(Path, Dir),
 193        file_base_name(Path, File)
 194    ).
 195directory_file_path(_, _, _) :-
 196    throw(error(instantiation_error(_), _)).
 197
 198%!  copy_file(From, To) is det.
 199%
 200%   Copy a file into a new file or  directory. The data is copied as
 201%   binary data.
 202
 203copy_file(From, To) :-
 204    destination_file(To, From, Dest),
 205    setup_call_cleanup(open(Dest, write, Out, [type(binary)]),
 206                       copy_from(From, Out),
 207                       close(Out)).
 208
 209copy_from(File, Stream) :-
 210    setup_call_cleanup(
 211        open(File, read, In, [type(binary)]),
 212        copy_stream_data(In, Stream),
 213        close(In)).
 214
 215destination_file(Dir, File, Dest) :-
 216    exists_directory(Dir),
 217    !,
 218    file_base_name(File, Base),
 219    directory_file_path(Dir, Base, Dest).
 220destination_file(Dest, _, Dest).
 221
 222
 223%!  make_directory_path(+Dir) is det.
 224%
 225%   Create Dir and all required  components   (like  mkdir  -p). Can
 226%   raise various file-specific exceptions.
 227
 228make_directory_path(Dir) :-
 229    make_directory_path_2(Dir),
 230    !.
 231make_directory_path(Dir) :-
 232    permission_error(create, directory, Dir).
 233
 234make_directory_path_2(Dir) :-
 235    exists_directory(Dir),
 236    !.
 237make_directory_path_2(Dir) :-
 238    atom_concat(RealDir, '/', Dir),
 239    RealDir \== '',
 240    !,
 241    make_directory_path_2(RealDir).
 242make_directory_path_2(Dir) :-
 243    Dir \== (/),
 244    !,
 245    file_directory_name(Dir, Parent),
 246    make_directory_path_2(Parent),
 247    make_directory(Dir).
 248
 249%!  copy_directory(+From, +To) is det.
 250%
 251%   Copy the contents of the directory  From to To (recursively). If
 252%   To is the name of an existing  directory, the _contents_ of From
 253%   are copied into To. I.e., no  subdirectory using the basename of
 254%   From is created.
 255
 256copy_directory(From, To) :-
 257    (   exists_directory(To)
 258    ->  true
 259    ;   make_directory(To)
 260    ),
 261    directory_files(From, Entries),
 262    maplist(copy_directory_content(From, To), Entries).
 263
 264copy_directory_content(_From, _To, Special) :-
 265    special(Special),
 266    !.
 267copy_directory_content(From, To, Entry) :-
 268    directory_file_path(From, Entry, Source),
 269    directory_file_path(To, Entry, Dest),
 270    (   exists_directory(Source)
 271    ->  copy_directory(Source, Dest)
 272    ;   copy_file(Source, Dest)
 273    ).
 274
 275special(.).
 276special(..).
 277
 278%!  delete_directory_and_contents(+Dir) is det.
 279%
 280%   Recursively remove the directory Dir and its contents. If Dir is
 281%   a symbolic link or symbolic links   inside  Dir are encountered,
 282%   the links are removed rather than their content. Use with care!
 283
 284delete_directory_and_contents(Dir) :-
 285    read_link(Dir, _, _),
 286    !,
 287    delete_file(Dir).
 288delete_directory_and_contents(Dir) :-
 289    directory_files(Dir, Files),
 290    maplist(delete_directory_contents(Dir), Files),
 291    delete_directory(Dir).
 292
 293delete_directory_contents(_, Entry) :-
 294    special(Entry),
 295    !.
 296delete_directory_contents(Dir, Entry) :-
 297    directory_file_path(Dir, Entry, Delete),
 298    (   exists_directory(Delete)
 299    ->  delete_directory_and_contents(Delete)
 300    ;   delete_file(Delete)
 301    ).
 302
 303%!  delete_directory_contents(+Dir) is det.
 304%
 305%   Remove all content from  directory   Dir,  without  removing Dir
 306%   itself. Similar to delete_directory_and_contents/2,  if symbolic
 307%   links are encountered in Dir, the  links are removed rather than
 308%   their content.
 309
 310delete_directory_contents(Dir) :-
 311    directory_files(Dir, Files),
 312    maplist(delete_directory_contents(Dir), Files).