- nUri : added Sets of uris for use in "probe"

[helm.git] / matita / components / binaries / probe / engine.ml

diff --git a/matita/components/binaries/probe/engine.ml b/matita/components/binaries/probe/engine.ml
index e79f000f9e471ad61a6c983145f09b06a2107a65..55936e5423aa5b594eae1c1566c718bd261f87a3 100644 (file)
--- a/matita/components/binaries/probe/engine.ml
+++ b/matita/components/binaries/probe/engine.ml
@@ -9,15 +9,54 @@
      \ /   This software is distributed as is, NO WARRANTY.     
       V_______________________________________________________________ *)
 
+module F = Filename
 module L = List
 module P = Printf
 
-module U = NUri
+module U  = NUri
+module US = U.UriSet
+module B  = Librarian
+module H  = HExtlib
+
+let unsupported protocol =
+   failwith (P.sprintf "probe: unsupported protocol: %s" protocol)
+
+let missing path =
+   failwith (P.sprintf "probe: missing path: %s" path)
+
+let unrooted path =
+   failwith (P.sprintf "probe: missing root: %s" path)
+
+let out_int i = P.printf "%u\n" i
+
+let out_length uris = out_int (US.cardinal uris)
 
 let out_uris uris =
    let map uri = P.printf "%s\n" (U.string_of_uri uri) in
-   L.iter map uris
+   US.iter map uris
 
-let out_int i = P.printf "%u\n" i
+let is_registry str =
+   F.check_suffix str ".conf.xml"
 
-let out_length l = out_int (L.length l)
+let get_uri str =
+  let str = H.normalize_path str in
+  let dir, file =
+      if H.is_regular str && F.check_suffix str ".ma" 
+      then F.dirname str, F.chop_extension (F.basename str)
+      else if H.is_dir str then str, ""
+      else missing str
+   in
+   let rec aux bdir file = match B.find_roots_in_dir bdir with
+      | [root] -> 
+         let buri = L.assoc "baseuri" (B.load_root_file root) in         
+        F.concat bdir file, F.concat buri file
+      | _      -> 
+         if bdir = F.current_dir_name || bdir = F.dir_sep then unrooted dir else
+        aux (F.dirname bdir) (F.concat (F.basename bdir) file)
+   in
+   aux dir file
+(* 
+   
+   let bpath = F.dirname str ^ "/" in
+   bpath, buri
+*)