1/* Part of fileutils
    2	Copyright 2012-2015 Samer Abdallah (Queen Mary University of London; UCL)
    3
    4	This program is free software; you can redistribute it and/or
    5	modify it under the terms of the GNU Lesser General Public License
    6	as published by the Free Software Foundation; either version 2
    7	of the License, or (at your option) any later version.
    8
    9	This program is distributed in the hope that it will be useful,
   10	but WITHOUT ANY WARRANTY; without even the implied warranty of
   11	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   12	GNU Lesser General Public License for more details.
   13
   14	You should have received a copy of the GNU Lesser General Public
   15	License along with this library; if not, write to the Free Software
   16	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
   17*/
   18
   19:- module(fileutils, [
   20		read_lines/2,           % +Stream, +ListOfLists
   21		with_stream/3,          % @Stream, +Opener, +Goal DEPRECATED
   22		with_stream/2,          % +Opener, +Pred
   23		with_output_to_file/2,  % +File, +Goal
   24		with_output_to_file/3,  % +File, +Goal, +Opts
   25		with_input_from_file/2, % +File, +Goal
   26		with_input_from_file/3, % +File, +Goal, +Opts
   27		with_input_from/2,      % +Source, +Goal
   28
   29      directory_entry/2,      % +Dir, -File
   30      expand_pattern/2,       % +Pattern, -File
   31      find_files/2,           % +FindSpec, -File
   32      file_under/4,           % +Root, +Pattern, -File, -RelPath
   33      file_under_dl/5,        % +Root, +Options, -File, ?DirsHead, ?DirsTail
   34
   35      file_extension/2,
   36      extension_in/2,
   37
   38      with_temp_dir/2,        % @Dir, +Goal
   39      in_temp_dir/1,          % +Goal
   40      file_modes/4            % +File, -UserClass, -Action, -Legal
   41	]).

File reading, writing, and finding utilities

This module provides a number of meta-predicates for directing the input or output streams of arbitrary goals from or to files or streams. It also provides some predicates for finding files in the file system, and for matching files on the basis of extension.

Types

What follows is a half-baked scheme for assigning types to things like search paths and file names.

First, a path is an atom that can be interpreted as a legal path in the file system, either relative or absolute. Next path(file) is a path that leads to a file and path(dir) is a path that leads to a directory.

A pattern is an atom that can be understood by expand_file_name/2 and expanded to a legal path. Thus, it can include wildcards "*?[]{}", environment variables "$var" and "~", which is equivalent to "$HOME". Thus, the type of expand_file_name/2 is pred(+pattern, -path).

A spec(T) is a term that can be expanded by expand_file_search_path/2 to produce an atom of type T. So, spec(pattern) expands to a pattern, and spec(path(file)) expands to a file name. The type of expand_file_search_path/2 is pred(+spec(T), -T).

Then, for finding files, we have:

findspec ---> in(spec(pattern), pattern)
            ; in(spec(pattern))
            ; under(spec(pattern), pattern)
            ; under(spec(pattern))
            ; like(spec(pattern)).
To be done
-
  • Consider extending with_output_to/2 and with_input_from/2 to understand file(Filename) and file(Filename,Opts) as sources/sinks.
  • Consider removing file_under/4 and providing another mechanism to obtain the path of a file as a list of directory names.
  • Consider other ways to represent recursive directory search, eg double-star notation: the pattern '/a/b/ ** /c/d/f' (without spaces). Note this allows matching on arbitrary segments of the directory path. */
   93:- meta_predicate
   94		with_output_to_file(+,0),
   95		with_output_to_file(+,0,+),
   96		with_input_from_file(+,0),
   97		with_input_from_file(+,0,+),
   98		with_input_from(+,0),
   99		with_stream(-,0,0),
  100		with_stream(1,1),
  101      with_temp_dir(-,0),
  102      in_temp_dir(0).  103
  104:- use_module(library(filesex)).  105
  106:- meta_predicate flip(2, ?, ?).  107flip(P, X, Y) :- call(P, Y, X).
 with_stream(+Opener:pred(-stream), +User:pred(+stream)) is semidet
Base predicate for doing things with stream. Opener is a unary predicate (ie callable with call/2) which must prepare the stream. User is a unary predicate, called with the open stream. The stream is guaranteed to be closed on exit. Eg, using the lambda library to form anonymous predicates:
with_stream(open('out.txt',write), \S^writeln(S,'Hello!')).
with_stream(open('in.txt',read), \S^read(S,T)).
  120with_stream(Opener, User) :-
  121   setup_call_cleanup(call(Opener, S), call(User, S), close(S)).
 with_stream(@Stream, :Opener, :Goal) is semidet
DEPRECATED due to nasty term copying. Base predicate for doing things with stream. Opener is a goal which must prepare the stream, Stream is the variable which will hold the valid stream handle, and Goal is called with the stream open. The stream is guaranteed to be closed on exit. Stream will remain unbound on exit, but any other variables in Opener or Goal will be left in the state that Opener and Goal leave them in. The idea is that Opener and Goal share the Stream variable, eg:
with_stream( S, open('out.txt',write,S), writeln(S,'Hello!')).
with_stream( S, open('in.txt',read,S), read(S,T)).
  137with_stream(Stream,Opener,Goal) :-
  138   replace_var(Stream,S,Opener-Goal,O-G),
  139   copy_term(t(FreeVars,Stream,Opener,Goal),t(FreeVars,S,O,G)),
  140	setup_call_cleanup(O,G,close(S)).
 replace_var(Var1, Var2, Term1, Term2) is det
Replace all instances of Var1 in Term1 with Var2, producing Term2. Other variables are not copied, but shared between Term1 and Term2.
  145replace_var(V1,V2,T1,T2) :-
  146   term_variables(T1,Vars),
  147   remove_var(V1,Vars,Shared), !,
  148   copy_term(t(Shared,V1,T1),t(Shared,V2,T2)).
  149
  150remove_var(V,[X|Xs],Xs) :- V==X.
  151remove_var(V,[X|Xs],[X|Ys]) :- remove_var(V,Xs,Ys).
  152
  153% Alternative implementation built on explicit term walk.
  154% replace_var(V1,V2,T1,T2) :-
  155%    (  var(T1) -> (T1==V1 -> T2=V2; T2=T1)
  156%    ;  T1=..[F|A1], maplist(replace_var(V1,V2),A1,A2),
  157%       T2=..[F|A2] ).
 with_output_to_file(+File, :Goal) is semidet
 with_output_to_file(+File, :Goal, +Opts) is semidet
Call Goal redirecting output to the file File, which is opened as with open(File,write,Str) or open(File,write,Opts,Str). However, if the option mode(Mode) is present, it is removed from the list (leaving Opts1) and the file is opened as with open(File,Mode,Opts1,Str). The default mode is write.
  170:- predicate_options(with_output_to_file/3,3,
  171      [  mode(oneof([write,append]))
  172      ,  pass_to(system:open/4,4) % !!! explicit module to work-around bug in predicate options system (2016-06)
  173      ]).  174
  175with_output_to_file(File,Goal) :- with_output_to_file(File,Goal,[]).
  176with_output_to_file(File,Goal,Opts) :-
  177   maplist(check_predicate_option(with_output_to_file/3,3),Opts),
  178	select_option(mode(Mode),Opts,Opts1,write),
  179   with_stream(open_opts(File,Mode,Opts1), flip(with_output_to, Goal)).
  180
  181open_opts(Name, Mode, Opts, S) :- open(Name, Mode, S, Opts).
 with_input_from_file(+File, :Goal) is semidet
 with_input_from_file(+File, :Goal, +Opts) is semidet
Call Goal redirecting output to the file File, which is opened as with open(File,write,Str) or open(File,write,Opts,Str).
  190:- predicate_options(with_input_from_file/3,3,[pass_to(open/4,4)]).  191
  192with_input_from_file(File,Goal) :- with_input_from_file(File,Goal,[]).
  193with_input_from_file(File,Goal,Opts) :-
  194	with_stream(open_opts(File,read,Opts), flip(with_input_from, Goal)).
 with_input_from(+Source, :Goal) is semidet
Temporarily switch current input to object specified by Source while calling Goal as in once/1. Source is a term like that supplied to with_output_to/2 and can be any of:
  206with_input_from(atom(A),G) :- !,
  207	setup_call_cleanup(
  208		atom_to_memory_file(A,MF),
  209		setup_call_cleanup(
  210			open_memory_file( MF, read, S),
  211			with_input_from(S,G),
  212			close(S)
  213		),
  214		free_memory_file(MF)
  215	).
  216
  217with_input_from(codes(Codes),G) :- !, atom_codes(Atom,Codes), with_input_from(atom(Atom),G).
  218with_input_from(chars(Chars),G) :- !, atom_chars(Atom,Chars), with_input_from(atom(Atom),G).
  219with_input_from(string(Str),G)  :- !, string_to_atom(Str,Atom), with_input_from(atom(Atom),G).
  220
  221with_input_from(S,G) :- is_stream(S), !,
  222	current_input(S0),
  223	setup_call_cleanup(set_input(S),once(G),set_input(S0)).
 read_lines(+Stream, -Lines:list(list(integer))) is semidet
Read all lines from Stream and return a list of lists of character codes.
  229read_lines(Stream,Lines) :-
  230	read_line_to_codes(Stream,Line),
  231	(	Line=end_of_file
  232	-> Lines=[]
  233	;	Lines=[Line|Lines1],
  234		read_lines(Stream,Lines1)).
 file_under(+Root:spec(pattern), +Pattern:pattern, -File:path(file), -RelPath:list(atom)) is nondet
Enumerate all files under directory root whose names match Pattern. Root can be a unary term as understood by expand_file_search_path/2. On exit, File is the fully qualified path to the file and RelPath is a list of directory names represented as atoms, relative to Root.
deprecated
- Consider using find_files/3 and doing without RelPath.
  246file_under(DirSpec,Pattern,File,RelPath) :-
  247   expand_directory_absolute(DirSpec,Root),
  248	file_under(Root,Pattern,File,RelPath,[]).
 file_under_dl(+Root:spec(dir), +Options:list, -File:atom, ?DirHead:list(atom), ?DirTail:list(atom)) is nondet
Finds files under directory Dir, succeeding multiple times with AbsPath bound to the absolute path (as an atom), and Parts bound to a list of directory components ending with the file name. Options can include:
abs(-AbsPath:path(file))
AbsPath is unified with the absolute path of each file found.
filter(+Filter:pred(+atom,+path(file)))
Filter is called with the name of and absolute path of each directory found. If it fails, that directory is not recursed into.

NB. this interface of this predicate is unstable and may change in future.

  264:- meta_predicate file_under_dl(+,:,-,?,?).  265file_under_dl(Spec,Opts,File,Parts,PartsT) :-
  266   call_dcg( (
  267      meta_options(meta_opt),
  268      option_default_select(abs(AbsPath), _),
  269      option_default_select(filter(DFilt),true)
  270   ), Opts, _),
  271   absolute_file_name(Spec,Dir),
  272   file_under(Dir,DFilt,File,AbsPath,Parts,PartsT).
  273
  274option_default_select(O,D,O1,O2):-select_option(O,O1,O2,D).
  275meta_opt(file_filter).
  276meta_opt(dir_filter).
  277true(_,_).
 find_files(+FindSpec:findspec, -File:path(file)) is nondet
General file finding predicate. FindSpec is one of:
in(DirSpec:spec(pattern), Pattern:pattern)
Looks for names matching Pattern in all directories matching DirSpec.
in(DirSpec:spec(pattern))
Equivalent to in(DirSpec,'*').
under(DirSpec:spec(pattern), Pattern:pattern)
Looks for names matching Pattern recursively under all directories matching DirSpec,
under(DirSpec:spec(pattern))
Equivalent to under(DirSpec,'*').
like(FileSpec:spec(pattern))

DirSpec is an atom or file search path term as understood by expand_file_search_path/2. It may contain wildcards as understood by expand_file_name/2, and is used to find directories. Pattern is a pattern for file names, without any directory components. FileSpec is a files search path term that is used to find files. File is unified with the absolute path of matching, readable files.

  299find_files(in(DirSpec),File) :- find_files(in(DirSpec,'*'),File).
  300find_files(under(DirSpec),File) :- find_files(under(DirSpec,'*'),File).
  301find_files(in(DirSpec,Pattern),File) :-
  302   expand_directory_absolute(DirSpec,Root),
  303   file_in(Root,Pattern,File).
  304find_files(under(DirSpec,Pattern),File) :-
  305   expand_directory_absolute(DirSpec,Root),
  306	file_under(Root,Pattern,File,_,[]).
  307find_files(like(Spec),AbsFile) :-
  308	expand_file_search_path(Spec,Pattern),
  309   expand_file(Pattern,File),
  310   absolute_file_name(File,AbsFile).
 file_under(+Root:path(dir), +Pattern:pattern, -File:path(file))// is nondet
DCG rule common to file_under/4 and find_files/2. Finds file names matching Pattern in or under Root and matches final argument pair with difference list containing the directory names along the path from the the Root to the file. File is an absolute path to the file in question.
  319:- public file_under/5.  320file_under(Root,Pattern,File,P,P) :-
  321   file_in(Root,Pattern,File).
  322file_under(Root,Pattern,File,[DirName|P1],P2)  :-
  323   % directory_file_path(Root,'*',DirPatt),
  324   % expand_directory(DirPatt,Dir),
  325   % file_base_name(Dir,DirName),
  326	% file_under(Dir,Pattern,File,P1,P2).
  327   directory_entry(Root,DirName),
  328   directory_file_path(Root,DirName,Dir),
  329   exists_directory(Dir),
  330   file_under(Dir,Pattern,File,P1,P2).
 file_under(+Root:path(dir), +Filter, -Name:atom, -Path:path(file))// is nondet
Alternative implementation of file_under, with arbitrary filter predicate on directories. Name is the is the name component of the path to the file. Path is the path, of which Root is always a prefix.
  338:- meta_predicate file_under(+,2,-,-,?,?).  339file_under(Root,Filter,Name,Path,P1,P2) :-
  340   directory_entry(Root,Item),
  341   directory_file_path(Root,Item,ItemPath),
  342   file_under_x(Filter,Item,ItemPath,Name,Path,P1,P2).
  343
  344file_under_x(_,Item,ItemPath,Item,ItemPath,P1,P1) :-
  345   exists_file(ItemPath).
  346file_under_x(Filter,Item,ItemPath,Name,Path,[Item|P1],P2) :-
  347   exists_directory(ItemPath),
  348   call(Filter,Item,ItemPath),
  349   file_under(ItemPath,Filter,Name,Path,P1,P2).
 file_in(+Dir:path(dir), +Pattern:pattern, -File:path(file)) is nondet
used by find_files/2 and file_under//3 Directory must be an atom containing an expanded path (no wildcards) but can be relative or absolute.
  356file_in(Directory,Pattern,File) :-
  357   directory_file_path(Directory,Pattern,FullPattern),
  358   expand_file(FullPattern,File).
 expand_absolute_directory(+Spec:spec(pattern), -Dir:path(dir)) is nondet
expands directory spec to absolute accessible directory paths.
  362expand_directory_absolute(Spec,Dir) :-
  363   expand_file_search_path(Spec,DirPatt),
  364   expand_directory(DirPatt,RelDir),
  365   absolute_file_name(RelDir,Dir).
  366
  367expand_directory(Pattern,Dir) :- expand_pattern(Pattern,Dir), exists_directory(Dir).
  368expand_file(Pattern,File)     :- expand_pattern(Pattern,File), exists_file(File).
 expand_pattern(+Pattern:pattern, -File:path) is nondet
Expands Pattern and unifies File with names of matching, readable files, exactly as expand_file_name/1, except that matches are produced one by one on backtracking, instead of all together in a list. File which the current user does not have permission to read are not returned.
  377expand_pattern(Pattern,File) :-
  378   expand_file_name(Pattern,Files),
  379   member(File,Files),
  380   access_file(File,read).
 directory_entry(+Dir:path(dir), -Entry:atom) is nondet
Is true when Entry is a file or directory in the directory Dir, not including the special entries '.' and '..'.
  386directory_entry(Dir,Entry) :-
  387   directory_files(Dir,Entries),
  388   member(Entry,Entries),
  389   Entry\='.', Entry\='..'.
 file_extension(+File:path, -Ext:atom) is nondet
file_extension(+File:path, +Ext:atom) is semidet
True if Filename has an extensions of Ext, where Ext does not include the dot. An extension is defined as any sequence of characters (including dots) after a dot that is not the first character of the name part of a path. Succeeds multiple times if File has multiple extensions, eg, these are all true:
file_extension('doc.ps.gz','ps.gz').
file_extension('doc.ps.gz','gz').

The predicate is case sensitive and case presevering.

  404file_extension(Path,Ext) :-
  405   sub_atom(Path,BDot,1,_,'.'),    % find any dot
  406   succ(BBDot,BDot),              % must be something before dot
  407   \+sub_atom(Path,BBDot,1,_,'/'), % must not be /
  408   succ(BDot,Dot),                % look after dot
  409   sub_atom(Path,Dot,_,0,Ext),     % Ext=extension exluding dot
  410   \+sub_atom(Ext,_,_,_,'/').      % Ext cannot contain /
 extension_in(+File:path, +Extensions:list(atom)) is semidet
True if File has one of the extensions in the list Extensions. Extensions are case insensitive. An extension is any sequence of characters following a dot in the name part of a file name.
  418extension_in(Path,Exts) :-
  419   file_extension(Path,Ext),
  420   memberchk(Ext,Exts).
 in_temp_dir(+Goal:callable) is semidet
Calls Goal with the current directory set to a newly created directory (using with_temp_dir/2) which is deleted after the call is finished. Goal is called as once(Goal) to ensure that the working directory is restored to its original value for any subsequent goals.
  431in_temp_dir(Goal) :-
  432   with_temp_dir(Dir,
  433      setup_call_cleanup(
  434         working_directory(Old,Dir), once(Goal),
  435         working_directory(_,Old))).
 with_temp_dir(@Dir:path, +Goal:callable) is nondet
Calls Goal with Dir bound to a new temporary directory. Once Goal is finished, the directory and its contents are deleted.
  442with_temp_dir(Dir,Goal) :-
  443   tmp_file(swi,Dir),
  444   debug(fileutils(temp),"Will make dir ~w...",Dir),
  445   setup_call_cleanup(
  446      make_directory(Dir), Goal,
  447      delete_directory_and_contents(Dir)).
  448
  449:- if(current_prolog_flag(unix,true)).  450
  451:- if(current_prolog_flag(apple,true)).  452stat_args(File,['-f','%Sp',File]).
  453:- else.  454stat_args(File,['-f','%A',File]).
  455:- endif.
 file_modes(+File:path, +UserClass:oneof([owner,group,other]), +Action:oneof([read,write,execute]), -Legal:boolean) is det
file_modes(+File:path, -UserClass:oneof([owner,group,other]), -Action:oneof([read,write,execute]), -Legal:boolean) is multi
  459file_modes(File,UserClass,Action,Legal) :-
  460   stat_args(File,StatArgs),
  461   setup_call_cleanup(
  462      process_create('/usr/bin/stat',StatArgs,[stdout(pipe(Out))]),
  463      read_line_to_string(Out,Modes),
  464      close(Out)),
  465   user_action_index(UserClass,Action,I,TrueVal),
  466   sub_string(Modes,I,1,_,Val),
  467   (  Val=TrueVal -> Legal=true
  468   ;  Val="-"     -> Legal=false
  469   ;  throw(unexpected_mode_char(File,I,Val))
  470   ).
  471
  472user_action_index(owner,read,1,"r").
  473user_action_index(owner,write,2,"w").
  474user_action_index(owner,execute,3,"x").
  475user_action_index(group,read,4,"r").
  476user_action_index(group,write,5,"w").
  477user_action_index(group,execute,6,"x").
  478user_action_index(other,read,7,"r").
  479user_action_index(other,write,8,"w").
  480user_action_index(other,execute,9,"x").
  481
  482:- else.  483
  484file_modes(_,_,_,_) :- throw(not_implemented(file_modes/4)).
  485
  486:- endif.