| ... |
... |
@@ -632,30 +632,31 @@ |
|
632
|
632
|
(unless (alien:null-alien path)
|
|
633
|
633
|
(alien:free-alien path)))))
|
|
634
|
634
|
|
|
635
|
|
-;; Create a template suitable for mkstemp and mkdtemp. PREFIX is
|
|
636
|
|
-;; string (or NIL) provided by the macros and is used as is as the
|
|
637
|
|
-;; template prefix. If PREFIX is NIL, the prefix is obtained by
|
|
638
|
|
-;; appending DEFAULT-NAME to the OS-dependent temporary path. In all
|
|
639
|
|
-;; cases, we append exactly 6 X's to create the finale template.
|
|
640
|
|
-(defun create-template (prefix default-name)
|
|
|
635
|
+;; Create a template suitable for mkstemp and mkdtemp. DIRECTORY is
|
|
|
636
|
+;; the directory for the template. If DIRECTORY is NIL, an
|
|
|
637
|
+;; OS-dependent location is used. PREFIX is string that is the prefix
|
|
|
638
|
+;; for the filename for the template. In all cases, we append exactly
|
|
|
639
|
+;; 6 X's to create the finale template.
|
|
|
640
|
+(defun create-template (directory prefix)
|
|
641
|
641
|
(concatenate 'string
|
|
642
|
|
- (or prefix
|
|
643
|
|
- (concatenate 'string
|
|
644
|
|
- (get-os-temp-path)
|
|
645
|
|
- default-name))
|
|
|
642
|
+ (or directory
|
|
|
643
|
+ (get-os-temp-path))
|
|
|
644
|
+ "/"
|
|
|
645
|
+ prefix
|
|
646
|
646
|
"XXXXXX"))
|
|
647
|
647
|
|
|
648
|
648
|
;;; WITH-TEMPORARY-FILE -- Public
|
|
649
|
|
-(defmacro with-temporary-file ((filename &key prefix)
|
|
|
649
|
+(defmacro with-temporary-file ((filename &key directory (prefix "cmucl-temp-file-"))
|
|
650
|
650
|
&parse-body (forms decls))
|
|
651
|
651
|
_N"Creates a temporary file with a name bound to Filename which a
|
|
652
|
|
- namestring. If Prefix is not provided, the temporary file is created
|
|
653
|
|
- in a OS-dependent location. Otherwise the prefix is used as a prefix
|
|
654
|
|
- for the name. On completion, the file is automatically removed."
|
|
|
652
|
+ namestring. If Directory is not provided, the temporary file is created
|
|
|
653
|
+ in a OS-dependent location. The Prefix is a prefix to the file name
|
|
|
654
|
+ to be created. If not provided a default prefix is used.
|
|
|
655
|
+ On completion, the file is automatically removed."
|
|
655
|
656
|
(let ((fd (gensym "FD-"))
|
|
656
|
657
|
(file-template (gensym "TEMP-PATH-"))
|
|
657
|
658
|
(unique-filename (gensym "UNIQUE-FILENAME-")))
|
|
658
|
|
- `(let ((,file-template (create-template ,prefix "cmucl-temp-file-"))
|
|
|
659
|
+ `(let ((,file-template (create-template ,directory ,prefix))
|
|
659
|
660
|
,unique-filename)
|
|
660
|
661
|
(unwind-protect
|
|
661
|
662
|
(let (,fd)
|
| ... |
... |
@@ -673,17 +674,34 @@ |
|
673
|
674
|
(when (pathnamep ,filename)
|
|
674
|
675
|
(delete-file ,filename))))))
|
|
675
|
676
|
|
|
|
677
|
+(defun recursive-delete-directory (dir)
|
|
|
678
|
+ _N"Recursively delete the directory DIR. All files and subdirectories of
|
|
|
679
|
+ DIR are removed. DIR must be a pathname to a directory. Any NAME
|
|
|
680
|
+ or TYPE components in DIR are ignored."
|
|
|
681
|
+ (declare (type pathname dir))
|
|
|
682
|
+ ;; Find all the files or directories in DIR.
|
|
|
683
|
+ (dolist (path (directory (merge-pathnames "*.*" dir)))
|
|
|
684
|
+ ;; If the path is a directory, recursively delete the directory.
|
|
|
685
|
+ ;; Otherwise delete the file. We do not follow any symlinks.
|
|
|
686
|
+ (if (eq (unix:unix-file-kind (namestring path)) :directory)
|
|
|
687
|
+ (recursive-delete-directory path)
|
|
|
688
|
+ (delete-file path)))
|
|
|
689
|
+ ;; Finally delete the directory.
|
|
|
690
|
+ (unix:unix-rmdir (namestring dir))
|
|
|
691
|
+ (values))
|
|
|
692
|
+
|
|
676
|
693
|
;;; WITH-TEMPORARY-DIRECTORY -- Public
|
|
677
|
|
-(defmacro with-temporary-directory ((dirname &key prefix)
|
|
|
694
|
+(defmacro with-temporary-directory ((dirname &key directory (prefix "cmucl-temp-dir-"))
|
|
678
|
695
|
&parse-body (forms decls))
|
|
679
|
|
- _N"Return a namestring to a temporary directory. If Prefix is not
|
|
680
|
|
- provided, the directory is created in an OS-dependent location.
|
|
681
|
|
- Otherwise, the Prefix is a string that is used as a prefix for the
|
|
682
|
|
- name of the temporary directory. The directory and all its contents
|
|
683
|
|
- are automatically removed afterward."
|
|
|
696
|
+ _N"Return a namestring to a temporary directory. If Directory is not
|
|
|
697
|
+ provided, the directory is created in an OS-dependent location. The
|
|
|
698
|
+ Prefix is a string that is used as a prefix for the name of the
|
|
|
699
|
+ temporary directory. If Prefix is not given, a default prefix is
|
|
|
700
|
+ used. The directory and all its contents are automatically removed
|
|
|
701
|
+ afterward."
|
|
684
|
702
|
(let ((err (gensym "ERR-"))
|
|
685
|
703
|
(dir-template (gensym "DIR-TEMPLATE-")))
|
|
686
|
|
- `(let ((,dir-template (create-template ,prefix "cmucl-temp-dir-"))
|
|
|
704
|
+ `(let ((,dir-template (create-template ,directory ,prefix))
|
|
687
|
705
|
,dirname ,err)
|
|
688
|
706
|
(unwind-protect
|
|
689
|
707
|
(progn
|
| ... |
... |
@@ -699,4 +717,4 @@ |
|
699
|
717
|
;; If a temp directory was created, remove it and all its
|
|
700
|
718
|
;; contents. Is there a better way?
|
|
701
|
719
|
(when ,dirname
|
|
702
|
|
- (ext:run-program "/bin/rm" (list "-rf" (namestring ,dirname)))))))) |
|
|
720
|
+ (recursive-delete-directory (namestring ,dirname))))))) |