On Thu, Feb 20, 2014 at 04:34:51PM +0100, Pino Toscano wrote:
Much similar to unlink_on_exit, but recursively cleaning
directories.
---
mllib/common_utils.ml | 23 +++++++++++++++++++++++
1 file changed, 23 insertions(+)
diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index 3943417..de3bd40 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -386,6 +386,29 @@ let unlink_on_exit =
registered_handlers := true
)
+(* Remove a temporary directory on exit. *)
+let rmdir_on_exit =
+ let dirs = ref [] in
+ let registered_handlers = ref false in
+
+ let rec rmdirs () =
+ List.iter (
+ fun dir ->
+ let cmd = sprintf "rm -rf %s" (Filename.quote dir) in
+ ignore (Sys.command cmd)
+ ) !dirs
+ and register_handlers () =
+ (* Remove on exit. *)
+ at_exit rmdirs
+ in
+
+ fun dir ->
+ dirs := dir :: !dirs;
+ if not !registered_handlers then (
+ register_handlers ();
+ registered_handlers := true
+ )
+
(* Using the libguestfs API, recursively remove only files from the
* given directory. Useful for cleaning /var/cache etc in sysprep
* without removing the actual directory structure. Also if 'dir' is
--
1.8.3.1
I think this is better, so: ACK.
Thanks, Rich.
--
Richard Jones, Virtualization Group, Red Hat
http://people.redhat.com/~rjones
Fedora Windows cross-compiler. Compile Windows programs, test, and
build Windows installers. Over 100 libraries supported.
http://fedoraproject.org/wiki/MinGW