added is_writabledir to extlib

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

diff --git a/components/library/libraryClean.ml b/components/library/libraryClean.ml
index 6f72ff495b77edf2389397863bf56bd7de3778b3..f61fc89c27f0ada471af7926b734f470a5570e28 100644 (file)
--- a/components/library/libraryClean.ml
+++ b/components/library/libraryClean.ml
@@ -49,17 +49,24 @@ 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
+          HLog.debug "Warning SELECT without REGEXP";
+         sprintf
+          ("SELECT source, h_occurrence FROM %s WHERE " ^^ 
+          "h_occurrence LIKE '%s%%'")
+         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 -> 
@@ -147,7 +154,7 @@ let moo_root_dir = lazy (
   String.sub url 7 (String.length url - 7)  (* remove heading "file:///" *)
 )
 
-let close_nodb ~basedir buris =
+let close_nodb buris =
   let rev_deps = Hashtbl.create 97 in
   let all_metadata =
     HExtlib.find ~test:(fun name -> Filename.check_suffix name ".metadata")
@@ -157,6 +164,8 @@ let close_nodb ~basedir buris =
     (fun path -> 
       let metadata = LibraryNoDb.load_metadata ~fname:path in
       let baseuri_of_current_metadata =
+       prerr_endline "ERROR, add to the getter reverse lookup";
+       let basedir = "/fake" in
        let dirname = Filename.dirname path in
        let basedirlen = String.length basedir in
         assert (String.sub dirname 0 basedirlen = basedir);
@@ -190,7 +199,7 @@ let close_nodb ~basedir buris =
   in
   objects_to_remove
 
-let clean_baseuris ?(verbose=true) ~basedir buris =
+let clean_baseuris ?(verbose=true) buris =
   Hashtbl.clear cache_of_processed_baseuri;
   let buris = List.map Http_getter_misc.strip_trailing_slash buris in
   debug_prerr "clean_baseuris called on:";
@@ -198,7 +207,7 @@ let clean_baseuris ?(verbose=true) ~basedir buris =
     List.iter debug_prerr buris; 
   let l = 
     if Helm_registry.get_bool "db.nodb" then
-      close_nodb ~basedir buris
+      close_nodb buris
     else
       close_db [] buris 
   in
@@ -208,31 +217,47 @@ let clean_baseuris ?(verbose=true) ~basedir buris =
   if debug then
     List.iter (fun u -> debug_prerr (UriManager.string_of_uri u)) l; 
   List.iter
-   (fun buri ->
-     HExtlib.safe_remove (LibraryMisc.obj_file_of_baseuri basedir buri);
-     HExtlib.safe_remove (LibraryMisc.metadata_file_of_baseuri basedir buri);
-     HExtlib.safe_remove (LibraryMisc.lexicon_file_of_baseuri basedir buri))
+   (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.metadata_file_of_baseuri 
+           ~must_exist:false ~writable:true ~baseuri) ;
+       HExtlib.safe_remove 
+         (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 ->
      let buri = UriManager.buri_of_uri uri in
      if buri <> !last_baseuri then
       begin
-       HLog.message ("Removing: " ^ buri ^ "/*");
+        if Helm_registry.get_bool "matita.bench" then
+            (print_endline ("matitaclean " ^ buri ^ "/");flush stdout)
+          else 
+            HLog.message ("Removing: " ^ buri ^ "/*");
        last_baseuri := buri
       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