2 ||M|| This file is part of HELM, an Hypertextual, Electronic
3 ||A|| Library of Mathematics, developed at the Computer Science
4 ||T|| Department, University of Bologna, Italy.
6 ||T|| HELM is free software; you can redistribute it and/or
7 ||A|| modify it under the terms of the GNU General Public License
8 \ / version 2 or (at your option) any later version.
9 \ / This software is distributed as is, NO WARRANTY.
10 V_______________________________________________________________ *)
22 let unsupported protocol =
23 failwith (P.sprintf "probe: unsupported protocol: %s" protocol)
26 failwith (P.sprintf "probe: missing path: %s" path)
29 if F.check_suffix path "/" then S.sub path 0 (pred (S.length path))
33 let path = F.chop_extension path in
34 let str = F.concat "cic:" path in
35 O.objs := U.uri_of_string str :: !O.objs
38 let path = F.chop_extension path in
39 let str = F.concat "cic:" path ^ "/" in
40 O.srcs := U.uri_of_string str :: !O.srcs
42 let rec scan_entry base path =
43 if F.check_suffix path ".con.ng" then add_obj path else
44 if F.check_suffix path ".ind.ng" then add_obj path else
45 if F.check_suffix path ".var.ng" then add_obj path else
46 if F.check_suffix path ".ng" then add_src path else
47 let files = Y.readdir (F.concat base path) in
48 let map base file = scan_entry base (F.concat path file) in
49 A.iter (map base) files
51 let from_uri base uri =
52 let str = U.string_of_uri uri in
53 let i = S.index str '/' in
54 let protocol = S.sub str 0 i in
55 if protocol = "cic:" then
56 let path = S.sub str (succ i) (S.length str - succ i) in
57 let file = mk_file path in
58 if Y.file_exists (F.concat base file) then scan_entry base file
60 else unsupported protocol
62 let from_string base s =
63 from_uri base (U.uri_of_string s)