X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=components%2Fmetadata%2FmetadataDeps.ml;h=3309843509c65c22af46a3e018c3615f5f96a57c;hb=e8334d2db9b6d618f6a10aaee6d802aa75b63499;hp=b393dbb91a8f0f0a3ca74983758e386c02738c3a;hpb=2499f5fdcf4dbfecc6f4fafe925b24ae76f14be8;p=helm.git

diff --git a/components/metadata/metadataDeps.ml b/components/metadata/metadataDeps.ml
index b393dbb91..330984350 100644
--- a/components/metadata/metadataDeps.ml
+++ b/components/metadata/metadataDeps.ml
@@ -91,6 +91,44 @@ let inverse_deps ~dbd uri =
   do_query (MetadataTypes.obj_tbl ())
     @ do_query MetadataTypes.library_obj_tbl
 
+let topological_sort ~dbd uris =
+ let module OrderedUri =
+  struct
+   type t = UriManager.uri
+   let compare = UriManager.compare
+  end in
+ let module Topo = HTopoSort.Make(OrderedUri) in
+  Topo.topological_sort uris
+   (fun uri -> fst (List.split (direct_deps ~dbd uri)))
+
+let sorted_uris_of_baseuri ~dbd baseuri =
+   let sql_pat = 
+      Pcre.replace ~rex:(Pcre.regexp "_") ~templ:"\\_" baseuri ^ "%" 
+   in
+   let query =
+      Printf.sprintf
+         ("SELECT source FROM %s WHERE source LIKE \"%s\" UNION "^^
+          "SELECT source FROM %s WHERE source LIKE \"%s\"")
+         (MetadataTypes.name_tbl ()) sql_pat
+         MetadataTypes.library_name_tbl sql_pat
+   in
+   let result = HMysql.exec dbd query in
+   let map cols = match cols.(0) with
+      | Some s -> UriManager.uri_of_string s
+      | _ -> assert false
+   in
+   let uris = HMysql.map result map in
+   let sorted_uris = topological_sort ~dbd uris in
+   let filter_map uri =
+      let s =
+         Pcre.replace ~rex:(Pcre.regexp "#xpointer\\(1/1\\)") ~templ:""
+                      (UriManager.string_of_uri uri)
+      in
+      try ignore (Pcre.exec ~rex:(Pcre.regexp"#xpointer") s); None
+      with Not_found -> Some (UriManager.uri_of_string s)
+   in
+   HExtlib.filter_map filter_map sorted_uris
+
 module DepGraph =
 struct
   module UriTbl = UriManager.UriHashtbl