commit 6786757

install directories

  1@@ -22,29 +22,61 @@
  2   (msg (format #f "installing package ~a~a~a" "\x1b[33m" pkg "\x1b[m") "->")
  3 
  4   ;; determine pkg dir
  5+  ;; shpuld probably seperate manifest creation
  6   (let (
  7 	(dp (format #f "~a/pkg-~a-~a" DULL_DIR pkg (ver-pkg pkg)))
  8 	(dm (format #f "~a/~a" DULL_DB pkg))
  9+	(df '())
 10 	)
 11+    
 12     (if (file-exists? dp)
 13 	(begin
 14 	  (mkdir-p dm)
 15-	  
 16+
 17+	  ;; while writing manifest, if the walked file is a directory, append a /
 18+	  ;; this will be useful to avoid creating files as directory during actual installation
 19 	  (call-with-output-file (format #f "~a/lock" dm)
 20 	    (lambda (f)
 21 	      (ftw (format #f "~a/" dp)
 22 		   (lambda (g s l)
 23-		     (display (substring (format #f "~a~&" g) (string-length dp)) f)
 24+		     (display 
 25+		     (format #f "~a~a~%"
 26+			     (substring (format #f "~a" g) (string-length dp))
 27+			     (if (eq? (stat:type s) 'directory) "/" "")
 28+			     )
 29+		     f)
 30 		     #t)
 31 		   ))
 32 	    )
 33+	    )
 34 	  )
 35 	
 36 	(begin
 37 	  (die (format #f "pkg dir for package ~a~a~a not found (~a)" "\x1b[33m" pkg "\x1b[0m" dp) 1)
 38 	  )
 39 	)
 40+    (set! df
 41+	  (remove string-null? (call-with-input-file (format #f "~a/lock" dm)
 42+				 (lambda (f)
 43+				   (string-split (read-string f) #\newline)
 44+				   )
 45+				 )))
 46+
 47+    ;; actually install
 48+    (let dc ((n 0))
 49+      (unless (= n (length df))
 50+	(when (string-suffix? (list-ref df n) "/")
 51+	  (mkdir-p (list-ref df n)))
 52+	(dc (+ n 1))))
 53+    
 54+    (let fc ((n 0))
 55+      (unless (= n (length df))
 56+	(unless (string-suffix? (list-ref df n) "/")
 57+	  (+ 0 67)
 58+	  ;;(copy-file  (list-ref df n)))
 59+	(fc (+ n 1))))
 60     )
 61+  
 62   (msg (format #f "package ~a~a~a successfully installed" "\x1b[33m" pkg "\x1b[m") "-->")
 63   )
 64 
 65@@ -65,9 +97,9 @@
 66     (let fp ((n 0))
 67       (unless (= n (length pf))
 68 	(when (eq? (stat:type (stat (list-ref pf n))) 'regular)
 69-;;	  (format #t "~a file " (list-ref pf n))
 70+	  ;;	  (format #t "~a file " (list-ref pf n))
 71 	  (delete-file (list-ref pf n))
 72-;;	  (format #t "rm~%")
 73+	  ;;	  (format #t "rm~%")
 74 
 75 	  ;; add to deleted list
 76 	  (set! rl
 77@@ -80,17 +112,17 @@
 78       (unless (= n (length pf))
 79 	;; remove directories not in deleted list
 80 	(unless (member (list-ref pf n) rl)
 81-	(when (eq? (stat:type (stat (list-ref pf n))) 'directory)
 82-	  
 83-	  (catch 'system-error
 84-		 (lambda ()
 85-		   (rmdir (list-ref pf n))
 86-		   )
 87-		 (lambda (key . args)
 88-		   (+ 60 7)
 89+	  (when (eq? (stat:type (stat (list-ref pf n))) 'directory)
 90+	    
 91+	    (catch 'system-error
 92+		   (lambda ()
 93+		     (rmdir (list-ref pf n))
 94+		     )
 95+		   (lambda (key . args)
 96+		     (+ 60 7)
 97+		     )
 98 		   )
 99-		 )
100-	  ))
101+	    ))
102 	(dp (+ n 1))))
103     )
104   (msg (format #f "package ~a~a~a successfully removed" "\x1b[33m" pkg "\x1b[m") "-->")