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]).
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)).
now to indicate the current time. Defined options
are:
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)]).
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.
?- 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'.
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).
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 ).
true (default false), recurse into subdirectoriestrue (default), follow symbolic links.fail, warning or error.
Default is warning. Errors notably happen if a directory is
unreadable or a link points nowhere.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 (Entry, Dict) :- 335 false == Dict.get(hidden), 336 sub_atom(Entry, 0, _, _, '.').
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).
exclude_directory(+GlobPattern) option.381filter_directory(Entry, Dict) :- 382 Exclude = Dict.get(exclude_directory), 383 wildcard_match(Exclude, Entry), 384 !, fail. 385filter_directory(_, _).
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).
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).
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 )).
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(..).
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 ).
536delete_directory_contents(Dir) :-
537 directory_files(Dir, Files),
538 maplist(delete_directory_contents(Dir), Files).+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
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. */