many changes:

[helm.git] / helm / software / components / library / libraryClean.ml

diff --git a/helm/software/components/library/libraryClean.ml b/helm/software/components/library/libraryClean.ml
index f61fc89c27f0ada471af7926b734f470a5570e28..0a19d8d5603451fa1e7ccd63e6e4a6170327ebd9 100644 (file)
--- a/helm/software/components/library/libraryClean.ml
+++ b/helm/software/components/library/libraryClean.ml
@@ -51,17 +51,20 @@ let one_step_depend suri =
         let buri = buri ^ "/" in 
         let buri = HSql.escape buri in
         let obj_tbl = MetadataTypes.obj_tbl () in
-       if HSql.isMysql then        
-         sprintf ("SELECT source, h_occurrence FROM %s WHERE " 
-         ^^ "h_occurrence REGEXP '^%s[^/]*$'") obj_tbl buri
-       else
-        begin
+        if HSql.isMysql then        
+          sprintf ("SELECT source, h_occurrence FROM %s WHERE " 
+            ^^ "h_occurrence REGEXP '^%s[^/]*$'") obj_tbl buri
+       else
+               begin
+            sprintf ("SELECT source, h_occurrence FROM %s WHERE " 
+            ^^ "REGEXP(h_occurrence, '^%s[^/]*$')") obj_tbl buri
+          (* implementation with vanilla ocaml-sqlite3
           HLog.debug "Warning SELECT without REGEXP";
-         sprintf
-          ("SELECT source, h_occurrence FROM %s WHERE " ^^ 
-          "h_occurrence LIKE '%s%%'")
-         obj_tbl buri
-        end
+         sprintf
+            ("SELECT source, h_occurrence FROM %s WHERE " ^^ 
+             "h_occurrence LIKE '%s%%' ESCAPE \"\\\"")
+                 obj_tbl buri*)
+               end
       in
       try 
         let rc = HSql.exec (LibraryDb.instance ()) query in
@@ -84,6 +87,42 @@ let safe_buri_of_suri suri =
   with
     UM.IllFormedUri _ -> suri
 
+let db_uris_of_baseuri buri =
+ let query = 
+  let buri = buri ^ "/" in 
+  let buri = HSql.escape buri in
+  let obj_tbl = MetadataTypes.name_tbl () in
+  if HSql.isMysql then        
+    sprintf ("SELECT source FROM %s WHERE " 
+    ^^ "source REGEXP '^%s[^/]*$'") obj_tbl buri
+  else
+   begin
+    sprintf ("SELECT source FROM %s WHERE " 
+      ^^ "REGEXP(source, '^%s[^/]*$')") obj_tbl buri
+     (* implementation with vanilla ocaml-sqlite3
+    HLog.debug "Warning SELECT without REGEXP";
+    sprintf
+    ("SELECT source, h_occurrence FROM %s WHERE " ^^ 
+    "h_occurrence LIKE '%s%%' ESCAPE \"\\\" ")
+    obj_tbl buri
+    *)
+   end
+ in
+ try 
+  let rc = HSql.exec (LibraryDb.instance ()) query in
+  let l = ref [] in
+  HSql.iter rc (
+    fun row -> 
+      match row.(0) with 
+      | Some uri when Filename.dirname uri = buri -> 
+          l := uri :: !l
+      | _ -> ());
+  let l = List.sort Pervasives.compare !l in
+  HExtlib.list_uniq l
+ with
+  exn -> raise exn (* no errors should be accepted *)
+;;
+
 let close_uri_list uri_to_remove =
   (* to remove an uri you have to remove the whole script *)
   let buri_to_remove = 
@@ -121,6 +160,14 @@ let close_uri_list uri_to_remove =
       HLog.error ("We were listing an invalid buri: " ^ u);
       exit 1
   in
+  let uri_to_remove_from_db =
+   List.fold_left 
+     (fun acc buri -> db_uris_of_baseuri buri @ acc
+     ) [] buri_to_remove 
+  in
+  let uri_to_remove = uri_to_remove @ uri_to_remove_from_db in
+  let uri_to_remove =
+   HExtlib.list_uniq (List.sort Pervasives.compare uri_to_remove) in
   (* now we want the list of all uri that depend on them *) 
   let depend = 
     List.fold_left