X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fmetadata%2FmetadataDeps.ml;h=e949984e423631d72e0371ee43e4fcee6a119822;hb=57c7d6ef239b4c2b070721715887684adf41159c;hp=13e1d23b49ce5260c6b4884d2e205d5551f625ba;hpb=0f3aa13cca7b39bf21b82738e1c183bc6c9e6ae3;p=helm.git diff --git a/helm/software/components/metadata/metadataDeps.ml b/helm/software/components/metadata/metadataDeps.ml index 13e1d23b4..e949984e4 100644 --- a/helm/software/components/metadata/metadataDeps.ml +++ b/helm/software/components/metadata/metadataDeps.ml @@ -64,14 +64,17 @@ let direct_deps ~dbd uri = prerr_endline "invalid (direct) refObj metadata row"; assert false in - let do_query tbl = - let res = HSql.exec dbd (SqlStatements.direct_deps tbl uri) in + let do_query (dbtype, tbl) = + let res = + HSql.exec dbtype dbd (SqlStatements.direct_deps tbl uri dbtype dbd) + in let deps = HSql.map res (fun row -> unbox_row (obj_metadata_of_row row)) in deps in - do_query (MetadataTypes.obj_tbl ()) - @ do_query MetadataTypes.library_obj_tbl + do_query (HSql.User, MetadataTypes.obj_tbl ()) + @ do_query (HSql.Library, MetadataTypes.library_obj_tbl) + @ do_query (HSql.Legacy, MetadataTypes.library_obj_tbl) let inverse_deps ~dbd uri = let inv_obj_metadata_of_row = @@ -82,14 +85,17 @@ let inverse_deps ~dbd uri = prerr_endline "invalid (inverse) refObj metadata row"; assert false in - let do_query tbl = - let res = HSql.exec dbd (SqlStatements.inverse_deps tbl uri) in + let do_query (dbtype, tbl) = + let res = + HSql.exec dbtype dbd (SqlStatements.inverse_deps tbl uri dbtype dbd) + in let deps = HSql.map res (fun row -> unbox_row (inv_obj_metadata_of_row row)) in deps in - do_query (MetadataTypes.obj_tbl ()) - @ do_query MetadataTypes.library_obj_tbl + do_query (HSql.User, MetadataTypes.obj_tbl ()) + @ do_query (HSql.Library, MetadataTypes.library_obj_tbl) + @ do_query (HSql.Legacy, MetadataTypes.library_obj_tbl) let topological_sort ~dbd uris = let module OrderedUri = @@ -105,21 +111,26 @@ let sorted_uris_of_baseuri ~dbd baseuri = let sql_pat = Pcre.replace ~pat:"([^\\\\])_" ~templ:"$1\\_" baseuri ^ "%" in - let query = + let query dbtype tbl = Printf.sprintf ("SELECT source FROM %s WHERE source LIKE \"%s\" " - ^^ HSql.escape_string_for_like ^^ " UNION " ^^ - "SELECT source FROM %s WHERE source LIKE \"%s\" " - ^^ HSql.escape_string_for_like) - (MetadataTypes.name_tbl ()) sql_pat - MetadataTypes.library_name_tbl sql_pat + ^^ HSql.escape_string_for_like dbtype dbd) + 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 uris = + List.fold_left + (fun acc (dbtype, table) -> + let result = HSql.exec dbtype dbd (query dbtype table) in + HSql.map result map @ acc) + [] + [HSql.User, MetadataTypes.name_tbl (); + HSql.Library, MetadataTypes.library_name_tbl; + HSql.Legacy, MetadataTypes.library_name_tbl] + in let sorted_uris = topological_sort ~dbd uris in let filter_map uri = let s = @@ -177,7 +188,8 @@ struct function | [] -> () | uri :: tl -> - let suri = UriManager.string_of_uri uri in + let nice = UriManager.strip_xpointer in + let suri = UriManager.string_of_uri (nice uri) in Pp.node suri ~attrs:([ "href", UriManager.string_of_uri uri; "label", label_of_uri uri @@ -193,8 +205,8 @@ struct List.iter (fun dest -> let uri1, uri2 = if invert then dest, uri else uri, dest in - Pp.edge (UriManager.string_of_uri uri1) - (UriManager.string_of_uri uri2) fmt) + Pp.edge (UriManager.string_of_uri (nice uri1)) + (UriManager.string_of_uri (nice uri2)) fmt) adjacency; new_nodes := adjacency end;