From 181a4133f334e38966b58afa5c79f2840637c98f Mon Sep 17 00:00:00 2001
From: Sergey Poznyakoff <gray@gnu.org.ua>
Date: Tue, 9 Mar 2010 13:46:45 +0200
Subject: Improve bootstrapping.

* README-hacking: Update.
* scripts/bootstrap: New command line option -p (--parents).
(mkdir-p, with-output-to-file-p): New functions.
(write-modconfig, write-makefile): Use with-output-to-file-p.
---
 README-hacking    |  2 +-
 scripts/bootstrap | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++----
 2 files changed, 60 insertions(+), 5 deletions(-)

diff --git a/README-hacking b/README-hacking
index 47fc61a..c8a633f 100644
--- a/README-hacking
+++ b/README-hacking
@@ -31,7 +31,7 @@ You do this as follows:
 
 2. Run
 
-   scripts/bootstrap --moddir modules
+   scripts/bootstrap --moddir modules --parents
 
 Once done, proceed as described in the file README (section
 INSTALLATION).
diff --git a/scripts/bootstrap b/scripts/bootstrap
index be7cef0..23fe96c 100755
--- a/scripts/bootstrap
+++ b/scripts/bootstrap
@@ -39,7 +39,8 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))"
 	"DO NOT EDIT! GENERATED AUTOMATICALLY!"))
 (define reconfig-command "autoreconf -f -i -s")
 (define files-from #f)
-
+(define create-parents #f)
+  
 (define grammar
   `((topdir (single-char #\C) (value #t))
     (moddir (value #t))
@@ -49,6 +50,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))"
     (modconfig-defun (value #t))
     (reconfigure (value #t))
     (files-from (single-char #\T) (value #t))
+    (parents (single-char #\p (value #t)))
     (help)))
 
 (define (usage)
@@ -62,7 +64,8 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))"
   (format #t "  --modconfig-file FILE  module configuration file [~A]~%" modconfig-file)
   (format #t "  --modconfig-defun FUNC name of the module configuration defun [~A]~%" modconfig-defun)
   (format #t "  --reconfigure CMD      reconfigure command [~A]~%" reconfig-command)
-  (display   "  -T, --files-from FILE  read files from FILE\n"))
+  (display   "  -T, --files-from FILE  read files from FILE\n")
+  (display   "  -p, --parents          create parent directories as needed\n"))
 
 (define progname #f)
 
@@ -75,6 +78,56 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))"
       (apply format (cons #t (cons fmt args)))
       (newline))))
 
+(define (mkdir-p dir . rest)
+  (let ((mode (if (null? rest) #o777 (car rest)))
+	(path #f))
+    (for-each
+     (lambda (subdir)
+       (let ((full-name
+	      (if path
+		  (string-append path (if (string-suffix? "/" path)
+					  "" "/")
+				 subdir)
+		  subdir)))
+	 (if (not (file-exists? full-name))
+	     (catch 'system-error
+		    (lambda ()
+		      (mkdir full-name mode))
+		    (lambda args
+		      (format #t "ARGS: ~A~%" args)
+		      (apply throw (append (list-head args 2)
+					   (list
+					    (string-append
+					     "~A: "
+					     (list-ref args 2)))
+					   (list
+					    (cons
+					     full-name
+					     (list-ref args 3)))
+					   (list-tail args 4))))))
+	 (set! path full-name)))
+     (string-split dir #\/))))
+
+(define (with-output-to-file-p file thunk)
+  (if create-parents
+      (mkdir-p (dirname file)))
+  (catch 'system-error
+	 (lambda ()
+	   (with-output-to-file file thunk))
+	 (lambda args
+	   (let ((errno (car (list-ref args 4))))
+	     (cond
+	      ((and (not create-parents) (= errno 2))
+	       (with-output-to-port
+		   (current-error-port)
+		 (lambda ()
+		   (apply format (append (list #t (list-ref args 2))
+					 (list-ref args 3)))
+		   (format #t ": try using --parents~%")
+		   (exit 1))))
+	      (else
+	       (apply throw args)))))))
+
 (define section-header-rx (make-regexp "^(.*):[ \t]*$"))
 
 (define (read-module-file file)
@@ -274,7 +327,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))"
 (define (write-modconfig modules)
   (format #t "~A: writing module configuration file ~A~%"
 	  progname modconfig-file)
-  (with-output-to-file
+  (with-output-to-file-p
       modconfig-file
     (lambda ()
       (write-autogenerated-header "# " #f)
@@ -329,7 +382,7 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))"
 (define (write-makefile modules)
   (format #t "~A: writing makefile ~A~%"
 	  progname makefile)
-  (with-output-to-file
+  (with-output-to-file-p
       makefile
     (lambda ()
       (write-autogenerated-header "# " #f)
@@ -449,6 +502,8 @@ exec ${GUILE-guile} -l $0 -c "(apply $main (cons \"$0\" (cdr (command-line))))"
 	  (set! reconfig-command (cdr x)))
 	 ((files-from)
 	  (set! files-from (cdr x)))
+	 ((parents)
+	  (set! create-parents (cdr x)))
 	 (else
 	  (error "unhandled option: ~A" x))))
      (getopt-long args grammar))
-- 
cgit v1.2.1