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-2022, 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 copy_directory/2, % +Source, +Destination 48 delete_directory_and_contents/1, % +Dir 49 delete_directory_contents/1 % +Dir 50 ]). 51:- autoload(library(apply),[maplist/2,maplist/3,foldl/4]). 52:- autoload(library(error), 53 [permission_error/3,must_be/2,domain_error/2]). 54:- autoload(library(lists),[member/2]). 55:- autoload(library(nb_set),[empty_nb_set/1,add_nb_set/3]).
71:- predicate_options(directory_member/3, 3, 72 [ recursive(boolean), 73 follow_links(boolean), 74 file_type(atom), 75 extensions(list(atom)), 76 file_errors(oneof([fail,warning,error])), 77 access(oneof([read,write,execute])), 78 matches(text), 79 exclude(text), 80 exclude_directory(text), 81 hidden(boolean) 82 ]). 83 84 85:- 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'.
157relative_file_name(Path, RelTo, RelPath) :- % +,+,- 158 nonvar(Path), 159 !, 160 absolute_file_name(Path, AbsPath), 161 absolute_file_name(RelTo, AbsRelTo), 162 atomic_list_concat(PL, /, AbsPath), 163 atomic_list_concat(RL, /, AbsRelTo), 164 delete_common_prefix(PL, RL, PL1, PL2), 165 to_dot_dot(PL2, DotDot, PL1), 166 ( DotDot == [] 167 -> RelPath = '.' 168 ; atomic_list_concat(DotDot, /, RelPath) 169 ). 170relative_file_name(Path, RelTo, RelPath) :- 171 ( is_absolute_file_name(RelPath) 172 -> Path = RelPath 173 ; file_directory_name(RelTo, RelToDir), 174 directory_file_path(RelToDir, RelPath, Path0), 175 absolute_file_name(Path0, Path) 176 ). 177 178delete_common_prefix([H|T01], [H|T02], T1, T2) :- 179 !, 180 delete_common_prefix(T01, T02, T1, T2). 181delete_common_prefix(T1, T2, T1, T2). 182 183to_dot_dot([], Tail, Tail). 184to_dot_dot([_], Tail, Tail) :- !. 185to_dot_dot([_|T0], ['..'|T], Tail) :- 186 to_dot_dot(T0, T, Tail).
atom_concat(Directory, File, Path), but it ensures
there is exactly one / between the two parts. Notes:
200directory_file_path(Dir, File, Path) :- 201 nonvar(Dir), nonvar(File), 202 !, 203 ( ( is_absolute_file_name(File) 204 ; Dir == '.' 205 ) 206 -> Path = File 207 ; sub_atom(Dir, _, _, 0, /) 208 -> atom_concat(Dir, File, Path) 209 ; atomic_list_concat([Dir, /, File], Path) 210 ). 211directory_file_path(Dir, File, Path) :- 212 nonvar(Path), 213 !, 214 ( nonvar(Dir) 215 -> ( Dir == '.', 216 \+ is_absolute_file_name(Path) 217 -> File = Path 218 ; sub_atom(Dir, _, _, 0, /) 219 -> atom_concat(Dir, File, Path) 220 ; atom_concat(Dir, /, TheDir) 221 -> atom_concat(TheDir, File, Path) 222 ) 223 ; nonvar(File) 224 -> atom_concat(Dir0, File, Path), 225 strip_trailing_slash(Dir0, Dir) 226 ; file_directory_name(Path, Dir), 227 file_base_name(Path, File) 228 ). 229directory_file_path(_, _, _) :- 230 throw(error(instantiation_error(_), _)). 231 232strip_trailing_slash(Dir0, Dir) :- 233 ( atom_concat(D, /, Dir0), 234 D \== '' 235 -> Dir = D 236 ; Dir = Dir0 237 ).
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.
273directory_member(Directory, Member, Options) :- 274 dict_create(Dict, options, Options), 275 ( Dict.get(recursive) == true, 276 \+ Dict.get(follow_links) == false 277 -> empty_nb_set(Visited), 278 DictOptions = Dict.put(visited, Visited) 279 ; DictOptions = Dict 280 ), 281 directory_member_dict(Directory, Member, DictOptions). 282 283directory_member_dict(Directory, Member, Dict) :- 284 directory_files(Directory, Files, Dict), 285 member(Entry, Files), 286 \+ special(Entry), 287 directory_file_path(Directory, Entry, AbsEntry), 288 filter_link(AbsEntry, Dict), 289 ( exists_directory(AbsEntry) 290 -> ( filter_dir_member(AbsEntry, Entry, Dict), 291 Member = AbsEntry 292 ; filter_directory(Entry, Dict), 293 Dict.get(recursive) == true, 294 \+ hidden_file(Entry, Dict), 295 no_link_cycle(AbsEntry, Dict), 296 directory_member_dict(AbsEntry, Member, Dict) 297 ) 298 ; filter_dir_member(AbsEntry, Entry, Dict), 299 Member = AbsEntry 300 ). 301 302directory_files(Directory, Files, Dict) :- 303 Errors = Dict.get(file_errors), 304 !, 305 errors_directory_files(Errors, Directory, Files). 306directory_files(Directory, Files, _Dict) :- 307 errors_directory_files(warning, Directory, Files). 308 309errors_directory_files(fail, Directory, Files) :- 310 catch(directory_files(Directory, Files), _, fail). 311errors_directory_files(warning, Directory, Files) :- 312 catch(directory_files(Directory, Files), E, 313 ( print_message(warning, E), 314 fail)). 315errors_directory_files(error, Directory, Files) :- 316 directory_files(Directory, Files). 317 318 319filter_link(File, Dict) :- 320 \+ ( Dict.get(follow_links) == false, 321 read_link(File, _, _) 322 ). 323 324no_link_cycle(Directory, Dict) :- 325 Visited = Dict.get(visited), 326 !, 327 absolute_file_name(Directory, Canonical, 328 [ file_type(directory) 329 ]), 330 add_nb_set(Canonical, Visited, true). 331no_link_cycle(_, _). 332 (Entry, Dict) :- 334 false == Dict.get(hidden), 335 sub_atom(Entry, 0, _, _, '.').
341filter_dir_member(_AbsEntry, Entry, Dict) :- 342 Exclude = Dict.get(exclude), 343 wildcard_match(Exclude, Entry), 344 !, fail. 345filter_dir_member(_AbsEntry, Entry, Dict) :- 346 Include = Dict.get(matches), 347 \+ wildcard_match(Include, Entry), 348 !, fail. 349filter_dir_member(AbsEntry, _Entry, Dict) :- 350 Type = Dict.get(file_type), 351 \+ matches_type(Type, AbsEntry), 352 !, fail. 353filter_dir_member(_AbsEntry, Entry, Dict) :- 354 ExtList = Dict.get(extensions), 355 file_name_extension(_, Ext, Entry), 356 \+ memberchk(Ext, ExtList), 357 !, fail. 358filter_dir_member(AbsEntry, _Entry, Dict) :- 359 Access = Dict.get(access), 360 \+ access_file(AbsEntry, Access), 361 !, fail. 362filter_dir_member(_AbsEntry, Entry, Dict) :- 363 hidden_file(Entry, Dict), 364 !, fail. 365filter_dir_member(_, _, _). 366 367matches_type(directory, Entry) :- 368 !, 369 exists_directory(Entry). 370matches_type(Type, Entry) :- 371 \+ exists_directory(Entry), 372 user:prolog_file_type(Ext, Type), 373 file_name_extension(_, Ext, Entry).
exclude_directory(+GlobPattern) option.380filter_directory(Entry, Dict) :- 381 Exclude = Dict.get(exclude_directory), 382 wildcard_match(Exclude, Entry), 383 !, fail. 384filter_directory(_, _).
392copy_file(From, To) :- 393 destination_file(To, From, Dest), 394 setup_call_cleanup( 395 open(Dest, write, Out, [type(binary)]), 396 copy_from(From, Out), 397 close(Out)). 398 399copy_from(File, Stream) :- 400 setup_call_cleanup( 401 open(File, read, In, [type(binary)]), 402 copy_stream_data(In, Stream), 403 close(In)). 404 405destination_file(Dir, File, Dest) :- 406 exists_directory(Dir), 407 !, 408 file_base_name(File, Base), 409 directory_file_path(Dir, Base, Dest). 410destination_file(Dest, _, Dest).
418make_directory_path(Dir) :- 419 make_directory_path_2(Dir), 420 !. 421make_directory_path(Dir) :- 422 permission_error(create, directory, Dir). 423 424make_directory_path_2(Dir) :- 425 exists_directory(Dir), 426 !. 427make_directory_path_2(Dir) :- 428 atom_concat(RealDir, '/', Dir), 429 RealDir \== '', 430 !, 431 make_directory_path_2(RealDir). 432make_directory_path_2(Dir) :- 433 Dir \== (/), 434 !, 435 file_directory_name(Dir, Parent), 436 make_directory_path_2(Parent), 437 E = error(existence_error(directory, _), _), 438 catch(make_directory(Dir), E, 439 ( exists_directory(Dir) 440 -> true 441 ; throw(E) 442 )).
451copy_directory(From, To) :- 452 ( exists_directory(To) 453 -> true 454 ; make_directory(To) 455 ), 456 directory_files(From, Entries), 457 maplist(copy_directory_content(From, To), Entries). 458 459copy_directory_content(_From, _To, Special) :- 460 special(Special), 461 !. 462copy_directory_content(From, To, Entry) :- 463 directory_file_path(From, Entry, Source), 464 directory_file_path(To, Entry, Dest), 465 ( exists_directory(Source) 466 -> copy_directory(Source, Dest) 467 ; copy_file(Source, Dest) 468 ). 469 470special(.). 471special(..).
479delete_directory_and_contents(Dir) :- 480 read_link(Dir, _, _), 481 !, 482 delete_file(Dir). 483delete_directory_and_contents(Dir) :- 484 directory_files(Dir, Files), 485 maplist(delete_directory_contents(Dir), Files), 486 E = error(existence_error(directory, _), _), 487 catch(delete_directory(Dir), E, 488 ( \+ exists_directory(Dir) 489 -> true 490 ; throw(E) 491 )). 492 493delete_directory_contents(_, Entry) :- 494 special(Entry), 495 !. 496delete_directory_contents(Dir, Entry) :- 497 directory_file_path(Dir, Entry, Delete), 498 ( exists_directory(Delete) 499 -> delete_directory_and_contents(Delete) 500 ; E = error(existence_error(file, _), _), 501 catch(delete_file(Delete), E, 502 ( \+ exists_file(Delete) 503 -> true 504 ; throw(E))) 505 ).
514delete_directory_contents(Dir) :-
515 directory_files(Dir, Files),
516 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).
534chmod(File, +Spec) :- 535 must_be(ground, Spec), 536 !, 537 mode_bits(Spec, Bits), 538 file_mode_(File, Mode0), 539 Mode is Mode0 \/ Bits, 540 chmod_(File, Mode). 541chmod(File, -Spec) :- 542 must_be(ground, Spec), 543 !, 544 mode_bits(Spec, Bits), 545 file_mode_(File, Mode0), 546 Mode is Mode0 /\ \Bits, 547 chmod_(File, Mode). 548chmod(File, Spec) :- 549 must_be(ground, Spec), 550 !, 551 mode_bits(Spec, Bits), 552 chmod_(File, Bits). 553 554mode_bits(Spec, Spec) :- 555 integer(Spec), 556 !. 557mode_bits(Name, Bits) :- 558 atom(Name), 559 !, 560 ( file_mode(Name, Bits) 561 -> true 562 ; domain_error(posix_file_mode, Name) 563 ). 564mode_bits(Spec, Bits) :- 565 must_be(list(atom), Spec), 566 phrase(mode_bits(0, Bits), Spec). 567 568mode_bits(Bits0, Bits) --> 569 [Spec], !, 570 ( { file_mode(Spec, B), Bits1 is Bits0\/B } 571 -> mode_bits(Bits1, Bits) 572 ; { domain_error(posix_file_mode, Spec) } 573 ). 574mode_bits(Bits, Bits) --> 575 []. 576 577file_mode(suid, 0o4000). 578file_mode(sgid, 0o2000). 579file_mode(svtx, 0o1000). 580file_mode(Name, Bits) :- 581 atom_chars(Name, Chars), 582 phrase(who_mask(0, WMask0), Chars, Rest), 583 ( WMask0 =:= 0 584 -> WMask = 0o0777 585 ; WMask = WMask0 586 ), 587 maplist(mode_char, Rest, MBits), 588 foldl(or, MBits, 0, Mask), 589 Bits is Mask /\ WMask. 590 591who_mask(M0, M) --> 592 [C], 593 { who_mask(C,M1), !, 594 M2 is M0\/M1 595 }, 596 who_mask(M2,M). 597who_mask(M, M) --> 598 []. 599 600who_mask(o, 0o0007). 601who_mask(g, 0o0070). 602who_mask(u, 0o0700). 603 604mode_char(r, 0o0444). 605mode_char(w, 0o0222). 606mode_char(x, 0o0111). 607 608or(B1, B2, B) :- 609 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. */