X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fmetadata%2FmetadataDeps.ml;h=3309843509c65c22af46a3e018c3615f5f96a57c;hb=7adc1d3082ee8d50e236a549a2c341b96becf1fe;hp=b393dbb91a8f0f0a3ca74983758e386c02738c3a;hpb=abd2098b6c4a40b36bb4b950c607eb4b4a7852bc;p=helm.git diff --git a/helm/software/components/metadata/metadataDeps.ml b/helm/software/components/metadata/metadataDeps.ml index b393dbb91..330984350 100644 --- a/helm/software/components/metadata/metadataDeps.ml +++ b/helm/software/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