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, 55 must_be/2, 56 domain_error/2, 57 instantiation_error/1 58 ]). 59:- autoload(library(lists), [member/2]). 60:- autoload(library(nb_set), [empty_nb_set/1, add_nb_set/3]). 61:- autoload(library(option), [dict_options/2]).
77:- predicate_options(directory_member/3, 3, 78 [ recursive(boolean), 79 follow_links(boolean), 80 file_type(atom), 81 extensions(list(atom)), 82 file_errors(oneof([fail,warning,error])), 83 access(oneof([read,write,execute])), 84 matches(text), 85 exclude(text), 86 exclude_directory(text), 87 hidden(boolean) 88 ]). 89 90 91:- 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'.
163relative_file_name(Path, RelTo, RelPath) :- % +,+,- 164 nonvar(Path), 165 !, 166 absolute_file_name(Path, AbsPath), 167 absolute_file_name(RelTo, AbsRelTo), 168 atomic_list_concat(PL, /, AbsPath), 169 atomic_list_concat(RL, /, AbsRelTo), 170 delete_common_prefix(PL, RL, PL1, PL2), 171 to_dot_dot(PL2, DotDot, PL1), 172 ( DotDot == [] 173 -> RelPath = '.' 174 ; atomic_list_concat(DotDot, /, RelPath) 175 ). 176relative_file_name(Path, RelTo, RelPath) :- 177 ( is_absolute_file_name(RelPath) 178 -> Path = RelPath 179 ; file_directory_name(RelTo, RelToDir), 180 directory_file_path(RelToDir, RelPath, Path0), 181 absolute_file_name(Path0, Path) 182 ). 183 184delete_common_prefix([H|T01], [H|T02], T1, T2) :- 185 !, 186 delete_common_prefix(T01, T02, T1, T2). 187delete_common_prefix(T1, T2, T1, T2). 188 189to_dot_dot([], Tail, Tail). 190to_dot_dot([_], Tail, Tail) :- !. 191to_dot_dot([_|T0], ['..'|T], Tail) :- 192 to_dot_dot(T0, T, Tail).
atom_concat(Directory, File, Path), but it ensures
there is exactly one / between the two parts. Notes:
206directory_file_path(Dir, File, Path) :- 207 nonvar(Dir), nonvar(File), 208 !, 209 ( ( is_absolute_file_name(File) 210 ; Dir == '.' 211 ; Dir == '' 212 ) 213 -> Path = File 214 ; sub_atom(Dir, _, _, 0, /) 215 -> atom_concat(Dir, File, Path) 216 ; atomic_list_concat([Dir, /, File], Path) 217 ). 218directory_file_path(Dir, File, Path) :- 219 nonvar(Path), 220 !, 221 ( nonvar(Dir) 222 -> ( ( Dir == '.' 223 -> true 224 ; Dir == '' 225 ), 226 \+ is_absolute_file_name(Path) 227 -> File = Path 228 ; sub_atom(Dir, _, _, 0, /) 229 -> atom_concat(Dir, File, Path) 230 ; atom_concat(Dir, /, TheDir) 231 -> atom_concat(TheDir, File, Path) 232 ) 233 ; nonvar(File) 234 -> atom_concat(Dir0, File, Path), 235 strip_trailing_slash(Dir0, Dir) 236 ; file_directory_name(Path, Dir), 237 file_base_name(Path, File) 238 ). 239directory_file_path(Dir, _, _) :- 240 instantiation_error(Dir). 241 242strip_trailing_slash(Dir0, Dir) :- 243 ( atom_concat(D, /, Dir0), 244 D \== '' 245 -> Dir = D 246 ; Dir = Dir0 247 ).
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.
283directory_member(Directory, Member, Options) :- 284 dict_options(Dict, Options), 285 ( Dict.get(recursive) == true, 286 \+ Dict.get(follow_links) == false 287 -> empty_nb_set(Visited), 288 DictOptions = Dict.put(visited, Visited) 289 ; DictOptions = Dict 290 ), 291 directory_member_dict(Directory, Member, DictOptions). 292 293directory_member_dict(Directory, Member, Dict) :- 294 directory_files(Directory, Files, Dict), 295 member(Entry, Files), 296 \+ special(Entry), 297 directory_file_path(Directory, Entry, AbsEntry), 298 filter_link(AbsEntry, Dict), 299 ( exists_directory(AbsEntry) 300 -> ( filter_dir_member(AbsEntry, Entry, Dict), 301 Member = AbsEntry 302 ; filter_directory(Entry, Dict), 303 Dict.get(recursive) == true, 304 \+ hidden_file(Entry, Dict), 305 no_link_cycle(AbsEntry, Dict), 306 directory_member_dict(AbsEntry, Member, Dict) 307 ) 308 ; filter_dir_member(AbsEntry, Entry, Dict), 309 Member = AbsEntry 310 ). 311 312directory_files(Directory, Files, Dict) :- 313 Errors = Dict.get(file_errors), 314 !, 315 errors_directory_files(Errors, Directory, Files). 316directory_files(Directory, Files, _Dict) :- 317 errors_directory_files(warning, Directory, Files). 318 319errors_directory_files(fail, Directory, Files) :- 320 catch(directory_files(Directory, Files), _, fail). 321errors_directory_files(warning, Directory, Files) :- 322 catch(directory_files(Directory, Files), E, 323 ( print_message(warning, E), 324 fail)). 325errors_directory_files(error, Directory, Files) :- 326 directory_files(Directory, Files). 327 328 329filter_link(File, Dict) :- 330 \+ ( Dict.get(follow_links) == false, 331 read_link(File, _, _) 332 ). 333 334no_link_cycle(Directory, Dict) :- 335 Visited = Dict.get(visited), 336 !, 337 absolute_file_name(Directory, Canonical, 338 [ file_type(directory) 339 ]), 340 add_nb_set(Canonical, Visited, true). 341no_link_cycle(_, _). 342 (Entry, Dict) :- 344 false == Dict.get(hidden), 345 sub_atom(Entry, 0, _, _, '.').
351filter_dir_member(_AbsEntry, Entry, Dict) :- 352 Exclude = Dict.get(exclude), 353 wildcard_match(Exclude, Entry), 354 !, fail. 355filter_dir_member(_AbsEntry, Entry, Dict) :- 356 Include = Dict.get(matches), 357 \+ wildcard_match(Include, Entry), 358 !, fail. 359filter_dir_member(AbsEntry, _Entry, Dict) :- 360 Type = Dict.get(file_type), 361 \+ matches_type(Type, AbsEntry), 362 !, fail. 363filter_dir_member(_AbsEntry, Entry, Dict) :- 364 ExtList = Dict.get(extensions), 365 file_name_extension(_, Ext, Entry), 366 \+ memberchk(Ext, ExtList), 367 !, fail. 368filter_dir_member(AbsEntry, _Entry, Dict) :- 369 Access = Dict.get(access), 370 \+ access_file(AbsEntry, Access), 371 !, fail. 372filter_dir_member(_AbsEntry, Entry, Dict) :- 373 hidden_file(Entry, Dict), 374 !, fail. 375filter_dir_member(_, _, _). 376 377matches_type(directory, Entry) :- 378 !, 379 exists_directory(Entry). 380matches_type(Type, Entry) :- 381 \+ exists_directory(Entry), 382 user:prolog_file_type(Ext, Type), 383 file_name_extension(_, Ext, Entry).
exclude_directory(+GlobPattern) option.390filter_directory(Entry, Dict) :- 391 Exclude = Dict.get(exclude_directory), 392 wildcard_match(Exclude, Entry), 393 !, fail. 394filter_directory(_, _).
402copy_file(From, To) :- 403 destination_file(To, From, Dest), 404 setup_call_cleanup( 405 open(Dest, write, Out, [type(binary)]), 406 copy_from(From, Out), 407 close(Out)). 408 409copy_from(File, Stream) :- 410 setup_call_cleanup( 411 open(File, read, In, [type(binary)]), 412 copy_stream_data(In, Stream), 413 close(In)). 414 415destination_file(Dir, File, Dest) :- 416 exists_directory(Dir), 417 !, 418 file_base_name(File, Base), 419 directory_file_path(Dir, Base, Dest). 420destination_file(Dest, _, Dest).
428make_directory_path(Dir) :- 429 make_directory_path_2(Dir), 430 !. 431make_directory_path(Dir) :- 432 permission_error(create, directory, Dir). 433 434make_directory_path_2(Dir) :- 435 exists_directory(Dir), 436 !. 437make_directory_path_2(Dir) :- 438 atom_concat(RealDir, '/', Dir), 439 RealDir \== '', 440 !, 441 make_directory_path_2(RealDir). 442make_directory_path_2(Dir) :- 443 Dir \== (/), 444 !, 445 file_directory_name(Dir, Parent), 446 make_directory_path_2(Parent), 447 ensure_directory_(Dir).
455ensure_directory(Dir) :- 456 exists_directory(Dir), 457 !. 458ensure_directory(Dir) :- 459 atom_concat(RealDir, '/', Dir), 460 RealDir \== '', 461 !, 462 ensure_directory(RealDir). 463ensure_directory(Dir) :- 464 ensure_directory_(Dir). 465 466ensure_directory_(Dir) :- 467 E = error(existence_error(directory, _), _), 468 catch(make_directory(Dir), E, 469 ( exists_directory(Dir) 470 -> true 471 ; throw(E) 472 )).
482copy_directory(From, To) :- 483 ( exists_directory(To) 484 -> true 485 ; make_directory(To) 486 ), 487 directory_files(From, Entries), 488 maplist(copy_directory_content(From, To), Entries). 489 490copy_directory_content(_From, _To, Special) :- 491 special(Special), 492 !. 493copy_directory_content(From, To, Entry) :- 494 directory_file_path(From, Entry, Source), 495 directory_file_path(To, Entry, Dest), 496 ( exists_directory(Source) 497 -> copy_directory(Source, Dest) 498 ; copy_file(Source, Dest) 499 ). 500 501special(.). 502special(..).
510delete_directory_and_contents(Dir) :- 511 read_link(Dir, _, _), 512 !, 513 delete_file(Dir). 514delete_directory_and_contents(Dir) :- 515 directory_files(Dir, Files), 516 maplist(delete_directory_contents(Dir), Files), 517 E = error(existence_error(directory, _), _), 518 catch(delete_directory(Dir), E, 519 ( \+ exists_directory(Dir) 520 -> true 521 ; throw(E) 522 )). 523 524delete_directory_contents(_, Entry) :- 525 special(Entry), 526 !. 527delete_directory_contents(Dir, Entry) :- 528 directory_file_path(Dir, Entry, Delete), 529 ( exists_directory(Delete) 530 -> delete_directory_and_contents(Delete) 531 ; E = error(existence_error(file, _), _), 532 catch(delete_file(Delete), E, 533 ( \+ exists_file(Delete) 534 -> true 535 ; throw(E))) 536 ).
545delete_directory_contents(Dir) :-
546 directory_files(Dir, Files),
547 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).
565chmod(File, +Spec) :- 566 must_be(ground, Spec), 567 !, 568 mode_bits(Spec, Bits), 569 file_mode_(File, Mode0), 570 Mode is Mode0 \/ Bits, 571 chmod_(File, Mode). 572chmod(File, -Spec) :- 573 must_be(ground, Spec), 574 !, 575 mode_bits(Spec, Bits), 576 file_mode_(File, Mode0), 577 Mode is Mode0 /\ \Bits, 578 chmod_(File, Mode). 579chmod(File, Spec) :- 580 must_be(ground, Spec), 581 !, 582 mode_bits(Spec, Bits), 583 chmod_(File, Bits). 584 585mode_bits(Spec, Spec) :- 586 integer(Spec), 587 !. 588mode_bits(Name, Bits) :- 589 atom(Name), 590 !, 591 ( file_mode(Name, Bits) 592 -> true 593 ; domain_error(posix_file_mode, Name) 594 ). 595mode_bits(Spec, Bits) :- 596 must_be(list(atom), Spec), 597 phrase(mode_bits(0, Bits), Spec). 598 599mode_bits(Bits0, Bits) --> 600 [Spec], !, 601 ( { file_mode(Spec, B), Bits1 is Bits0\/B } 602 -> mode_bits(Bits1, Bits) 603 ; { domain_error(posix_file_mode, Spec) } 604 ). 605mode_bits(Bits, Bits) --> 606 []. 607 608file_mode(suid, 0o4000). 609file_mode(sgid, 0o2000). 610file_mode(svtx, 0o1000). 611file_mode(Name, Bits) :- 612 atom_chars(Name, Chars), 613 phrase(who_mask(0, WMask0), Chars, Rest), 614 ( WMask0 =:= 0 615 -> WMask = 0o0777 616 ; WMask = WMask0 617 ), 618 maplist(mode_char, Rest, MBits), 619 foldl(or, MBits, 0, Mask), 620 Bits is Mask /\ WMask. 621 622who_mask(M0, M) --> 623 [C], 624 { who_mask(C,M1), !, 625 M2 is M0\/M1 626 }, 627 who_mask(M2,M). 628who_mask(M, M) --> 629 []. 630 631who_mask(o, 0o0007). 632who_mask(g, 0o0070). 633who_mask(u, 0o0700). 634 635mode_char(r, 0o0444). 636mode_char(w, 0o0222). 637mode_char(x, 0o0111). 638 639or(B1, B2, B) :- 640 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. */