Yet another patch to LibraryClean.

Now we look for URIs to remove both in the filesystem and in the objectName
table of the DB.

diff --git a/components/grafite_engine/grafiteEngine.ml b/components/grafite_engine/grafiteEngine.ml
index c961c58ae611903b2d518dfbf57b2b23ca5a1202..2d478673f94670e67c24b0da585ea9740105d809 100644 (file)
--- a/components/grafite_engine/grafiteEngine.ml
+++ b/components/grafite_engine/grafiteEngine.ml
@@ -725,8 +725,9 @@ let rec eval_command = {ec_go = fun ~disambiguate_command opts status
           HLog.error (Printf.sprintf "uri %s belongs to a read-only repository" value);
           raise (ReadOnlyUri value)
         end;
-        if not (Http_getter_storage.is_empty value) && 
-           opts.clean_baseuri 
+        if (not (Http_getter_storage.is_empty value) ||
+            LibraryClean.db_uris_of_baseuri value <> [])
+           && opts.clean_baseuri 
           then begin
           HLog.message ("baseuri " ^ value ^ " is not empty");
           HLog.message ("cleaning baseuri " ^ value);

diff --git a/components/library/libraryClean.ml b/components/library/libraryClean.ml
index f61fc89c27f0ada471af7926b734f470a5570e28..54aa860c9b290acb5b72bd86d7ca31983e0fd1d8 100644 (file)
--- a/components/library/libraryClean.ml
+++ b/components/library/libraryClean.ml
@@ -84,6 +84,38 @@ 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
+    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 = 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 +153,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

diff --git a/components/library/libraryClean.mli b/components/library/libraryClean.mli
index f4ce6de570925ddfd7d28542fbed46b91709b772..4d65cfe38daa87a7bc9f5d8de0f653e5b23b3a0f 100644 (file)
--- a/components/library/libraryClean.mli
+++ b/components/library/libraryClean.mli
@@ -23,4 +23,5 @@
  * http://helm.cs.unibo.it/
  *)
 
+val db_uris_of_baseuri : string -> string list
 val clean_baseuris : ?verbose:bool -> string list -> unit