1:- module(file, 2 [file/3, combine_file/2, cat_text/2, clean_io/3, posix_file_path/2, 3% dsnap/3, 4 symbolic_link/2, 5 tmp_file_name/1, 6 cat_files_to_codes/3, 7 cat_files/2, 8 pipe_line/2, 9 dict_of_files/1, 10 read_lines_as_atoms/2, read_lines/2 11 ]). 12 13%;; (setq module-query "qcompile(util(file)), module(file).") 14% ?- qcompile(util(file)), module(file). 15 16:- use_module(pac(basic)). 17 18:- meta_predicate file(, , ). 19:- meta_predicate file(, , , ). 20:- meta_predicate snap(, ). 21 22 /************** 23 * file * 24 **************/ 25 26%%% standard I/O (read/write/append) files 27 28file(F, M, A):- file(F, M, A, [encoding(utf8)]). 29% 30file(F, M, A, Ops):- 31 ( expand_file_search_path(F, F0) -> true 32 ; absolute_file_name(F, F0) 33 ), 34 setup_call_cleanup( 35 open(F0, M, S, Ops), 36 clean_io(S, M, A), 37 close(S)). 38% 39clean_io(S, read, A) :- !, 40 current_input(Old), 41 set_input(S), 42 once(A), 43 set_input(Old). 44clean_io(S, _, A) :- 45 current_output(Old), 46 set_output(S), 47 once(A), 48 set_output(Old). 49 50% ?-pipe_line('echo $HOME', S). 51% ?-pipe_line(date, S). 52%@ S = "2024å¹´ 4æ24æ¥ æ°´ææ¥ 22æ22å02ç§ JST". 53 54pipe_line(Shell, String):- 55 open(pipe(Shell), read, S, [encoding(utf8)]), 56 read_string(S, "\n", "\r\t ", _, String), 57 close(S). 58% 59f_pipe(Data, Pipe) :- 60 file( pipe(Pipe), 61 write, 62 basic:smash(Data), 63 [encoding(octet)]). % was utf8 64 65combine_file(Ls, F) :- 66 maplist(through_list_or_string, Ls, CombinedCodes), 67 file(F, write, basic:smash(CombinedCodes)). 68 69 70% ?- cat_text([abc, def], deldel). 71% ?- cat_text(['\\a\nbc', '\n', 2, '\n', 3, '\n', def, '\n', file(deldel)], deldeldel). 72% ?- shell('cat deldeldel'). 73 74cat_text(Segments, F):- file(F, write, cat_text(Segments)). 75% 76cat_text([]):-!. 77cat_text([X|Y]):-!, cat_text(X), cat_text(Y). 78cat_text(codes(X)):-!, smash(X). 79cat_text(file(F)):-!, 80 file(F, read, read_current_text(X)), 81 write(X). 82cat_text(X):- atomic(X), write(X). 83% 84read_current_text(X):- current_input(S), 85 read_string(S, "\n", "\r\t ", -1, X). 86 87% ?- posix_file_path('~', X). 88% ?- posix_file_path('~/*', X). % fail. 89posix_file_path(X, Y):- expand_file_name(X, L), !, L = [Y]. 90 91% 92cat_files(G, F):- atomic(G), !, 93 cat_files([G], F). 94cat_files(Fs, F):- 95 tmp_file_stream(text, TMPfile, Stream), 96 close(Stream), 97 maplist(expand_file_name, Fs, Gs), 98 cat_files_rec(Gs, TMPfile), 99 expand_file_name(F, [F0|_]), 100 rename_file(TMPfile, F0). 101 102cat_files_rec([], _). 103cat_files_rec([X|Xs], T):- atomic(X), !, 104 pshell(cat(X) >> T), 105 cat_files_rec(Xs, T). 106cat_files_rec([X|Xs], T):- 107 cat_files_rec(X, T), 108 cat_files_rec(Xs, T). 109 110% 111cat_files_to_codes([], C, C). 112cat_files_to_codes([P|Q], C, C0):- 113 read_file_to_codes(P, C, [tail(C1), encoding(utf8)]), 114 cat_files_to_codes(Q, C1, C0). 115 116% 117through_list_or_string(X, X):- (listp(X); string(X)), !. 118through_list_or_string(X, Y):- call(X, Y).
122symbolic_link(Target, Link) :- expand_file_name(Link, [Link0]), 123 ( read_link(Link0,_,_) 124 -> true 125 ; expand_file_name(Target, [Target0]), 126 eh:sh(ln(-s, Target0, Link0)) 127 ), 128 !. 129 130% tmp_file_name(File):- tmp_file_stream(text, File, Stream), close(Stream). 131tmp_file_name(File):- tmp_file_stream(utf8, File, Stream), close(Stream). 132 133push_to_file(M, F):- expand_file_name(F, [F1]), 134 ( exists_file(F1) 135 -> tmp_file_name(T1), 136 file(T1, write, M), 137 tmp_file_name(T2), 138 pshell(cat(T1, F) + ' > ' + T2), 139 rename_file(T2, F1), 140 delete_file(T1) 141 ; file(F1, write, M) 142 ). 143 144% ?- open_url('http://web.sfc.keio.ac.jp/~mukai/paccgi7/index.html', IN). 145% sample coding 146open_url(URL, In, Option) :- 147 tmp_file_stream(text, File, Stream), 148 close(Stream), 149 process_create('/usr/bin/curl', ['-o', File, URL], []), 150 open(File, read, In, Option), 151 delete_file(File). % Unix-only 152% 153open_url(URL, In) :- open_url(URL, In, []).
?- file:dict_of_files(D).
162ignore_special((.)). 163ignore_special((..)). 164ignore_special(('.DS_Store')). 165ignore_special(('.git')). 166 167% 168dict_of_files(X):- directory_files((.), Files), 169 directory_files(Files, X, []). 170% 171directory_files([], X, X). 172directory_files([F|R], X, Y):- ignore_special(F), !, 173 directory_files(R, X, Y). 174directory_files([D|R], [D-Z|X], Y):- exists_directory(D), !, 175 directory_files(D, Files), 176 working_directory(_, D), 177 directory_files(Files, Z, []), 178 working_directory(_, (..)), 179 directory_files(R, X, Y). 180directory_files([F|R], [F|X], Y):- directory_files(R, X, Y). 181 182 /************** 183 * snap * 184 **************/ 185 186usersnap(C) :- getenv(snapshot, File), 187 do_snap(File, basic:smash, [C,"\n"]). 188% 189usersnap(M, C):- user:snap(M >> C). 190% 191usersnap(M, X, X):- basic:smash(X, X0), user:snap(["\n", M, "\n", X0]). 192% 193userdsnap(X, X):- user:snap(X). 194 195% 196do_snap(File, M, X):- 197 current_output(Old), 198 open(File, append, New, [encoding(utf8)]), 199 set_output(New), 200 call(M, X), 201 set_output(Old), 202 close(New). 203 204% Prevents "stream... does not exist (already closed)" error 205close_stream(Stream) :- 206 ( is_stream(Stream) 207 -> close(Stream) 208 ; true 209 ). 210 211read_stream_to_codes(Stream, Codes) :- 212 fill_buffer(Stream), 213 read_pending_codes(Stream, Codes, Tail), 214 ( Tail == [] 215 -> true 216 ; read_stream_to_codes(Stream, Tail) 217 ). 218 219% Recommended by Jan. 220 221read_lines_as_atoms(Stream, Lines) :- 222 read_string(Stream, "\n", "", Sep, String), 223 ( Sep == -1 224 -> Lines = [] 225 ; atom_string(Line, String), 226 Lines = [Line|Rest], 227 read_lines_as_atoms(Stream, Rest) 228 ). 229% 230read_lines(Out, Lines) :- 231 read_line_to_codes(Out, Line1), 232 read_lines(Line1, Out, Lines). 233 234% read_lines(end_of_file, _, []) :- !. 235read_lines(Codes, Out, [Line|Lines]) :- 236 atom_codes(Line, Codes), 237 read_line_to_codes(Out, Line2), 238 read_lines(Line2, Out, Lines)