is_top_down was not propageted correctly under a bottom-up conversion.

[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 04333fc9a66724230fea843153a4d36d22d42e3b..1b378e6c2a72f235ac9cdb62a0955ae7f6ba2334 100644 (file)
--- a/helm/software/components/library/libraryClean.ml
+++ b/helm/software/components/library/libraryClean.ml
@@ -49,17 +49,27 @@ let one_step_depend suri =
       Hashtbl.add cache_of_processed_baseuri buri true;
       let query = 
         let buri = buri ^ "/" in 
-        let buri = HMysql.escape buri in
+        let buri = HSql.escape buri in
         let obj_tbl = MetadataTypes.obj_tbl () in
-        sprintf 
-        ("SELECT source, h_occurrence FROM %s WHERE " ^^ 
-         "h_occurrence REGEXP '^%s[^/]*$'")
-            obj_tbl buri
+        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%%' " ^^ HSql.escape_string_for_like)
+                 obj_tbl buri*)
+               end
       in
       try 
-        let rc = HMysql.exec (LibraryDb.instance ()) query in
+        let rc = HSql.exec (LibraryDb.instance ()) query in
         let l = ref [] in
-        HMysql.iter rc (
+        HSql.iter rc (
           fun row -> 
             match row.(0), row.(1) with 
             | Some uri, Some occ when Filename.dirname occ = buri -> 
@@ -77,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%%' " ^^ HSql.escape_string_for_like)
+    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 = 
@@ -114,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
@@ -212,15 +266,20 @@ let clean_baseuris ?(verbose=true) buris =
   List.iter
    (fun baseuri ->
      try 
+      let obj_file =
+       LibraryMisc.obj_file_of_baseuri ~must_exist:false ~writable:true ~baseuri
+      in
+       HExtlib.safe_remove obj_file ;
        HExtlib.safe_remove 
-         (LibraryMisc.obj_file_of_baseuri ~writable:true ~baseuri);
-       HExtlib.safe_remove 
-         (LibraryMisc.metadata_file_of_baseuri ~writable:true ~baseuri);
+         (LibraryMisc.metadata_file_of_baseuri 
+           ~must_exist:false ~writable:true ~baseuri) ;
        HExtlib.safe_remove 
-         (LibraryMisc.lexicon_file_of_baseuri ~writable:true ~baseuri)
+         (LibraryMisc.lexicon_file_of_baseuri 
+           ~must_exist:false ~writable:true ~baseuri) ;
+       HExtlib.rmdir_descend (Filename.chop_extension obj_file)
      with Http_getter_types.Key_not_found _ -> ())
    (HExtlib.list_uniq (List.fast_sort Pervasives.compare
-     (List.map (UriManager.buri_of_uri) l)));
+     (List.map (UriManager.buri_of_uri) l @ buris)));
   List.iter
    (let last_baseuri = ref "" in
     fun uri ->
@@ -235,14 +294,17 @@ let clean_baseuris ?(verbose=true) buris =
       end;
      LibrarySync.remove_obj uri
    ) l;
-  cleaned_no := !cleaned_no + List.length l;
-  if !cleaned_no > 30 then
+  if HSql.isMysql then
    begin
-    cleaned_no := 0;
-    List.iter
-     (function table ->
-       ignore (HMysql.exec (LibraryDb.instance ()) ("OPTIMIZE TABLE " ^ table)))
-     [MetadataTypes.name_tbl (); MetadataTypes.rel_tbl ();
-      MetadataTypes.sort_tbl (); MetadataTypes.obj_tbl();
-      MetadataTypes.count_tbl()]
+   cleaned_no := !cleaned_no + List.length l;
+   if !cleaned_no > 30 then
+    begin
+     cleaned_no := 0;
+     List.iter
+      (function table ->
+        ignore (HSql.exec (LibraryDb.instance ()) ("OPTIMIZE TABLE " ^ table)))
+      [MetadataTypes.name_tbl (); MetadataTypes.rel_tbl ();
+       MetadataTypes.sort_tbl (); MetadataTypes.obj_tbl();
+       MetadataTypes.count_tbl()]
+    end
    end