X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fmetadata%2FmetadataDeps.ml;h=7454663400a32db88db5e1113a5764b25eedde10;hb=7c1364138afcea82e7928dbb88054d6e33478687;hp=f2b1d049644cb72e589e5f86a6a8d4e2c9c74c80;hpb=f998e3da4179cbff6b3c3ec871c5892d0a76adbf;p=helm.git diff --git a/helm/software/components/metadata/metadataDeps.ml b/helm/software/components/metadata/metadataDeps.ml index f2b1d0496..745466340 100644 --- a/helm/software/components/metadata/metadataDeps.ml +++ b/helm/software/components/metadata/metadataDeps.ml @@ -65,9 +65,9 @@ let direct_deps ~dbd uri = assert false in let do_query tbl = - let res = HMysql.exec dbd (SqlStatements.direct_deps tbl uri) in + let res = HSql.exec dbd (SqlStatements.direct_deps tbl uri) in let deps = - HMysql.map res (fun row -> unbox_row (obj_metadata_of_row row)) in + HSql.map res (fun row -> unbox_row (obj_metadata_of_row row)) in deps in do_query (MetadataTypes.obj_tbl ()) @@ -83,9 +83,9 @@ let inverse_deps ~dbd uri = assert false in let do_query tbl = - let res = HMysql.exec dbd (SqlStatements.inverse_deps tbl uri) in + let res = HSql.exec dbd (SqlStatements.inverse_deps tbl uri) in let deps = - HMysql.map res (fun row -> unbox_row (inv_obj_metadata_of_row row)) in + HSql.map res (fun row -> unbox_row (inv_obj_metadata_of_row row)) in deps in do_query (MetadataTypes.obj_tbl ()) @@ -101,6 +101,34 @@ let topological_sort ~dbd uris = 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 = HSql.exec dbd query in + let map cols = match cols.(0) with + | Some s -> UriManager.uri_of_string s + | _ -> assert false + in + let uris = HSql.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