35
36:- module('$rc',
37 [ open_resource/2, 38 open_resource/3, 39 current_resource/2 40 ]). 41
42:- meta_predicate
43 open_resource(:, -),
44 open_resource(:, -, +),
45 current_resource(:, ?). 46
47:- dynamic
48 user:resource/2,
49 user:resource/3. 50:- multifile
51 user:resource/2,
52 user:resource/3.
60open_resource(Name, Handle) :-
61 open_resource(Name, Handle, []).
62
63open_resource(Module:RcName, Stream, Options) :-
64 is_list(Options),
65 !,
66 ( default_module(Module, RModule),
67 current_resource(RModule:RcName, FileSpec)
68 -> absolute_file_name(FileSpec, File),
69 open(File, read, Stream, Options)
70 ; '$rc_handle'(Zipper),
71 tag_rc_name(Module, RcName, TaggedName),
72 zipper_goto(Zipper, file(TaggedName))
73 -> zipper_open_current(Zipper, Stream,
74 [ release(true)
75 | Options
76 ])
77 ; '$existence_error'(resource, Module:RcName)
78 ).
79open_resource(Name, _Class, Stream) :-
80 open_resource(Name, Stream).
81
82tag_rc_name(user, RcName, RcName) :- !.
83tag_rc_name(Module, RcName, TaggedName) :-
84 atomic_list_concat([Module, ':', RcName], TaggedName).
85tag_rc_name(_, RcName, RcName).
92current_resource(M:Name, File) :-
93 current_module(M),
94 ( current_predicate(M:resource/2),
95 M:resource(Name, File)
96 ; current_predicate(M:resource/3),
97 M:resource(Name, _Class, File)
98 ).
104:- public c_open_resource/3. 105:- meta_predicate c_open_resource(:, +, -). 106
107c_open_resource(Name, Mode, Stream) :-
108 atom_chars(Mode, Chars),
109 ( Chars = [r|MChars]
110 -> mode_options(MChars, Options),
111 open_resource(Name, Stream, Options)
112 ; '$domain_error'(open_resource_mode, Mode)
113 ).
114
115mode_options([], []).
116mode_options([t|Chars], [type(text)|T]) :-
117 !,
118 mode_options(Chars, T).
119mode_options([b|Chars], [type(binary)|T]) :-
120 !,
121 mode_options(Chars, T).
122mode_options([_|Chars], T) :-
123 mode_options(Chars, T).
124
125
126 129
130:- register_iri_scheme(res, res_iri_hook, []).
138res_iri_hook(open(Mode,Options), IRI, Stream) :-
139 ( Mode == read
140 -> setup_call_cleanup(
141 iri_zipper(IRI, Zipper),
142 zipper_open_current(Zipper, Stream, Options),
143 zip_close_(Zipper, _))
144 ; '$permission_error'(open, source_sink, IRI)
145 ).
146res_iri_hook(access(Mode), IRI0, True) :-
147 ( read_mode(Mode),
148 '$absolute_file_name'(IRI0, Canonical0),
149 entry_name(Canonical0, Canonical),
150 iri_offset(Canonical, _Offset)
151 -> access_ok(Mode, Canonical, True)
152 ; True = false
153 ).
154res_iri_hook(time, IRI, Time) :-
155 setup_call_cleanup(
156 iri_zipper_ex(IRI, Zipper),
157 zipper_file_property(Zipper, _, time, Time),
158 zip_close_(Zipper, _)).
159res_iri_hook(size, IRI, Size) :-
160 setup_call_cleanup(
161 iri_zipper_ex(IRI, Zipper),
162 zipper_file_property(Zipper, _, size, Size),
163 zip_close_(Zipper, _)).
164
165read_mode(read).
166read_mode(exists).
167read_mode(file).
168read_mode(directory).
169
170entry_name(Entry, Entry).
171entry_name(Entry0, Entry) :-
172 \+ sub_atom(Entry0, _, _, 0, /),
173 atom_concat(Entry0, /, Entry).
180access_ok(directory, Entry, True) :-
181 !,
182 ( sub_atom(Entry, _, _, 0, /)
183 -> True = true
184 ; True = false
185 ).
186access_ok(file, Entry, True) :-
187 !,
188 ( sub_atom(Entry, _, _, 0, /)
189 -> True = false
190 ; True = true
191 ).
192access_ok(_, _, true).
199iri_zipper(IRI, Clone) :-
200 '$absolute_file_name'(IRI, Canonical),
201 iri_offset(Canonical, Offset),
202 '$rc_handle'(Zipper),
203 zip_clone(Zipper, Clone),
204 zipper_goto(Clone, offset(Offset)).
205
206iri_zipper_ex(IRI, Zipper) :-
207 iri_zipper(IRI, Zipper),
208 !.
209iri_zipper_ex(IRI, _Zipper) :-
210 '$existence_error'(source_sink, IRI).
216:- dynamic rc_index_db/2, rc_index_done/0. 217:- volatile rc_index_db/2, rc_index_done/0. 218
219iri_offset(Entry, Offset) :-
220 rc_index_done,
221 !,
222 rc_index_db(Entry, Offset).
223iri_offset(Entry, Offset) :-
224 with_mutex('$rc', index_rc),
225 !,
226 rc_index_db(Entry, Offset).
227
228index_rc :-
229 rc_index_done,
230 !.
231index_rc :-
232 '$rc_handle'(Zipper),
233 setup_call_cleanup(
234 zip_clone(Zipper, Clone),
235 ( zipper_goto(Clone, first),
236 index_rc(Clone)
237 ),
238 zip_close_(Clone, _)),
239 asserta(rc_index_done).
240
241index_rc(Zipper) :-
242 zipper_file_property(Zipper, Name, offset, Offset),
243 atom_concat('res://', Name, IRI),
244 assertz(rc_index_db(IRI, Offset)),
245 ( zipper_goto(Zipper, next)
246 -> index_rc(Zipper)
247 ; true
248 ).
253zipper_file_property(Zipper, Name, Prop, Value) :-
254 zip_file_info_(Zipper, Name, Info),
255 zip_prop_arg(Prop, Arg),
256 arg(Arg, Info, Value).
257
258zip_prop_arg(size, 2).
259zip_prop_arg(time, 5).
260zip_prop_arg(offset, 6)