37
38:- module(files_ex,
39 [ set_time_file/3, 40 link_file/3, 41 chmod/2, 42 relative_file_name/3, 43 directory_file_path/3, 44 directory_member/3, 45 copy_file/2, 46 make_directory_path/1, 47 copy_directory/2, 48 delete_directory_and_contents/1, 49 delete_directory_contents/1 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]). 56
57
70
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)). 86
115
127
156
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).
187
188
199
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 ).
238
239
272
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
333hidden_file(Entry, Dict) :-
334 false == Dict.get(hidden),
335 sub_atom(Entry, 0, _, _, '.').
336
340
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).
374
375
379
380filter_directory(Entry, Dict) :-
381 Exclude = Dict.get(exclude_directory),
382 wildcard_match(Exclude, Entry),
383 !, fail.
384filter_directory(_, _).
385
386
391
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).
411
412
417
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 )).
443
450
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(..).
472
478
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 ).
506
513
514delete_directory_contents(Dir) :-
515 directory_files(Dir, Files),
516 maplist(delete_directory_contents(Dir), Files).
517
518
533
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