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 ensure_directory/1, 48 copy_directory/2, 49 delete_directory_and_contents/1, 50 delete_directory_contents/1 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]). 57
58
71
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)). 87
116
128
157
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).
188
189
200
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 ).
239
240
273
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
334hidden_file(Entry, Dict) :-
335 false == Dict.get(hidden),
336 sub_atom(Entry, 0, _, _, '.').
337
341
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).
375
376
380
381filter_directory(Entry, Dict) :-
382 Exclude = Dict.get(exclude_directory),
383 wildcard_match(Exclude, Entry),
384 !, fail.
385filter_directory(_, _).
386
387
392
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).
412
413
418
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).
439
445
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 )).
464
465
472
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(..).
494
500
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 ).
528
535
536delete_directory_contents(Dir) :-
537 directory_files(Dir, Files),
538 maplist(delete_directory_contents(Dir), Files).
539
540
555
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