1;; note #f, its for expressions
  2;; everything will be stubbed todat because i need to implement
  3;; package finding and shit
  4
  5(define (installed? pkg)
  6  (file-exists? (format #f "~a/~a/lock" DULL_DB pkg)))
  7
  8(define (_find-pkg pkg)
  9  (let pp (
 10	   (p (string-split DULL_PATH #\:))
 11	   (n 0)
 12	   )
 13    (if (= n (length p))
 14	#f
 15	(let (
 16	      (d (list-ref p n))
 17	      (r #f)
 18	      )
 19	  (ftw d
 20	       (lambda (f s l)
 21		 (when (and (eq? (stat:type s) 'directory)
 22			    (string=? (basename f) pkg))
 23		   (set! r f))
 24		 #t))
 25	  (if r r
 26	      (pp p (+ n 1)))	  
 27	  ))
 28    )
 29  )
 30
 31(define (find-pkg pkg)
 32  (if (_find-pkg pkg)
 33      (_find-pkg pkg)
 34      (die (format #f "package ~a not found" pkg) 1)
 35      )
 36  )
 37
 38(define (ver-pkg pkg)
 39  (let i (
 40	  (e
 41	   (call-with-input-file (format #f "~a/ndmake.sh" (find-pkg pkg))
 42	     (lambda (f) (string-split (read-string f) #\newline))
 43	     )
 44	   ))
 45
 46    ;;(string-trim (cadr (string-split (caddr (string-split e #\newline)) #\=)))
 47    (string-trim (cadr (string-split
 48			(list-ref e (list-index (lambda (s) (string-contains s "VERSION")) e)) #\=)))
 49    )
 50  )
 51
 52(define (inst-pkg pkg)
 53  (msg (format #f "~ainstalling package ~a~a~a"
 54	       (if (installed? pkg)
 55		   "re" "")
 56	       "\x1b[33m" pkg "\x1b[m") "->")
 57
 58  ;; determine pkg dir
 59  ;; shpuld probably seperate manifest creation
 60  (let (
 61	(dp (format #f "~a/pkg-~a-~a" DULL_DIR pkg (ver-pkg pkg)))
 62	(dm (format #f "~a/~a" DULL_DB pkg))
 63	(df '())
 64	)
 65    
 66    (if (file-exists? dp)
 67	(begin
 68	  (mkdir-p dm)
 69
 70	  ;; while writing manifest, if the walked file is a directory, append a /
 71	  ;; this will be useful to avoid creating files as directory during actual installation
 72	  (call-with-output-file (format #f "~a/lock" dm)
 73	    (lambda (f)
 74	      (ftw (format #f "~a/" dp)
 75		   (lambda (g s l)
 76		     (display 
 77		      (format #f "~a~a~%"
 78			      (substring (format #f "~a" g) (string-length dp))
 79			      (if (and (eq? (stat:type s) 'directory)
 80				       (not (string-null? g))) "/" "")
 81			      )
 82		      f)
 83		     #t)
 84		   ))
 85	    )
 86	  )
 87	
 88	(begin
 89	  (die (format #f "pkg dir for package ~a~a~a not found (~a)" "\x1b[33m" pkg "\x1b[0m" dp) 1)
 90	  )
 91	)
 92    (set! df
 93	  (remove string-null? (call-with-input-file (format #f "~a/lock" dm)
 94				 (lambda (f)
 95				   (string-split (read-string f) #\newline)
 96				   )
 97				 )))
 98    
 99    (when (and (or (string=? (car df) "/") (string-null? (car df)))
100		   (= (length df) 1))
101      (_warn (format #f "lock for ~a is empty" pkg))
102      )
103
104    ;; actually install
105    (let dc ((n 0))
106      (unless (= n (length df))
107	(when (string-suffix? "/" (list-ref df n))
108	  (mkdir-p (list-ref df n)))
109	(dc (+ n 1))))
110    
111    (let fc ((n 0))
112      (unless (= n (length df))
113	(unless (string-suffix? "/" (list-ref df n))
114	  (when (file-exists? (list-ref df n))
115	    (delete-file (list-ref df n)))
116	  (copy-file (string-append dp (list-ref df n)) (list-ref df n))
117	  )
118	(fc (+ n 1))))
119    
120    (msg (format #f "package ~a~a~a successfully ~ainstalled" "\x1b[33m" pkg "\x1b[m"
121		 (if (installed? pkg)
122		     "re" "")
123		 ) "-->")
124    ))
125
126(define (del-pkg pkg)
127  (msg (format #f "removing package ~a~a~a" "\x1b[33m" pkg "\x1b[m") "->")
128
129  (let* (
130	 (pl (format #f "~a/~a/lock" DULL_DB pkg))
131	 (pf (remove string-null? (call-with-input-file pl
132				    (lambda (f)
133				      (string-split (read-string f) #\newline)
134				      )
135				    )))
136	 (rl '())
137	 )
138    (unless (installed? pkg)
139      (die (format #f "package ~a~a~a does not have a lock (not installed?)" "\x1b[33m" pkg "\x1b[0m") 2))
140
141    (let fp ((n 0))
142      (unless (= n (length pf))
143	(when (eq? (stat:type (stat (list-ref pf n))) 'regular)
144	  (delete-file (list-ref pf n))
145
146	  ;; add to deleted list
147	  (set! rl
148		(cons (list-ref pf n) rl)
149		)
150	  )
151	(fp (+ n 1))))
152    
153    (let dp ((n 0))
154      (unless (= n (length pf))
155	;; remove directories not in deleted list
156	(unless (member (list-ref pf n) rl)
157	  (when (eq? (stat:type (stat (list-ref pf n))) 'directory)
158	    
159	    (catch 'system-error
160		   (lambda ()
161		     (rmdir (list-ref pf n))
162		     )
163		   (lambda (key . args)
164		     (+ 60 7)
165		     )
166		   )
167	    ))
168	(dp (+ n 1))))
169
170    (delete-file pl)
171    )
172  (msg (format #f "package ~a~a~a successfully removed" "\x1b[33m" pkg "\x1b[m") "-->")
173  )
174
175(define (pm-pkg pkg)
176  (format #t "~a"
177	  (call-with-input-file (format #f "~a/~a/lock" DULL_DB pkg)
178	    (lambda (f) (read-string f))
179	    )
180	  )
181  )
182
183(define (build-pkg pkg)
184  (pmsg pkg "beginning build")
185
186  ;; anything except overlay
187  ;; dirname until its a member of split DULL_PATH
188  (define op "")
189  (let dp
190      ((m (find-pkg pkg)))
191    (if (member m (string-split DULL_PATH #\:))
192	(set! op m)
193	(begin
194	  (dp (dirname m))
195	  (when (string=? m "/") (die (format #f "could not find parent of ~a" pkg)1)))
196	)
197    )
198
199  ;; so it can source libdmake
200  (unless (and (string=? op (last (string-split DULL_PATH #\:)))
201	       (file-exists? (format #f "~a/libsh/libdmake.sh" op))
202	       (file-exists? (format #f "~a/libsh" op))
203	       )
204    (mkdir (format #f "~a/libsh" op))
205    (copy-file (format #f "~a/libsh/libdmake.sh" (last (string-split DULL_PATH #\:)))
206	       (format #f "~a/libsh/libdmake.sh" op))
207    )
208  
209  (system*
210   "sh" (format #f "~a/ndmake.sh" (find-pkg pkg))
211   "make"
212   )
213
214
215  (unless (string=? op (last (string-split DULL_PATH #\:)))
216    (delete-file (format #f "~a/libsh/libdmake.sh" op))
217    (rmdir (format #f "~a/libsh" op))
218    )
219  )