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