]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/software/components/metadata/metadataDeps.ml
maxipatch for support of multiple DBs.
[helm.git] / helm / software / components / metadata / metadataDeps.ml
index 13e1d23b49ce5260c6b4884d2e205d5551f625ba..d34bd1c83eb9241bea1549a2f8527d583c27abd1 100644 (file)
@@ -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 =