scsh-make/templates.scm

(define digest-extensions (list ".md5" ".fp" ".digest"))

(define (same-mtime? target prereqs)
  (if (file-not-exists? target)
      #t
      (if (null? prereqs)
	  #f
	  (let ((target-mtime (file-last-mod target)))
	    (let for-each-prereq ((prereq (car prereqs))
				  (todo (cdr prereqs)))
	      (cond
	       ((file-not-exists? prereq) 
		(error "nonexistent prerequisite" prereq))
	       ((> (file-last-mod prereq) target-mtime) #t)
	       ((null? todo) #f)
	       (else (for-each-prereq (car todo) (cdr todo)))))))))

(define (all-same-mtime? target prereqs)
  (if (file-not-exists? target)
      #t
      (if (null? prereqs)
	  #f
	  (let ((target-mtime (file-last-mod target)))
	    (let for-each-prereq ((prereq (car prereqs))
				  (todo (cdr prereqs)))
	      (cond
	       ((file-not-exists? prereq) 
		(error "nonexistent prerequisite" prereq))
	       ((and (null? todo)
		     (> (file-last-mod prereq) target-mtime)) #t)
	       (else (and (> (file-last-mod prereq) target-mtime)
			  (for-each-prereq (car todo) (cdr todo))))))))))

(define (same-perms? target prereqs)
  (if (file-not-exists? target)
      #t
      (if (null? prereqs)
	  (error "no prerequisite in perms clause")
	  (cond
	   ((file-not-exists? (car prereqs))
	    (error "nonexistent prerequisite" (car prereqs)))
	   (else (= (file-mode target) (file-mode (car prereqs))))))))

(define (checksum-from-file basename extension)
  (let* ((bname (string-append basename extension))
	 (file (expand-file-name bname (cwd))))
    (if (file-exists? file)
	(let* ((outport (open-input-file file))
	       (strls (port->string-list outport)))
	  ;; (display ";;; using     : ") (display bname) (newline)
	  (if (null? strls) 
	      #f 
	      (string->number (car strls))))
	#f)))

(define (checksum-into-file basename extension checksum)
  (let* ((bname (string-append basename extension))
	 (file (expand-file-name bname (cwd)))
	 (outport (open-output-file file))
	 (str (number->string checksum)))
    ;; (display ";;; update    : ") (display bname) (newline)
    (with-current-output-port outport (begin (display str) (newline)))
    (close outport)))

(define (checksum-for-file fname)
  (let ((file (expand-file-name fname (cwd))))
    (if (file-exists? file)
	(md5-digest->number (md5-digest-for-port (open-input-file file)))
	(error "checksum-for-file: file does not exist" file))))

;;; optimizations possible: global variable with known checksums
(define (get-file-checksum fname)
  (checksum-for-file fname))

(define (same-checksum? target extensions prereqs)
  (if (null? prereqs)
      (error "same-checksum?: target has no prerequisites" target)
      (let for-each-prereq ((current-prereq (car prereqs))
			    (previous-total 0)
			    (todo-prereqs (cdr prereqs)))
	(let* ((current-file-sum (get-file-checksum current-prereq))
	       (current-total (if current-file-sum
				  (+ current-file-sum previous-total)
				  previous-total)))
	  (cond 
	   ((and (not (null? todo-prereqs)))
	    (for-each-prereq (car todo-prereqs) 
			     current-total 
			     (cdr todo-prereqs)))
	   ((and (null? todo-prereqs) (not (null? extensions)))
	    (let for-each-ext ((ext (car extensions))
			       (todo-exts (cdr extensions)))
		(let ((known-sum (checksum-from-file target ext)))
		  (cond 
		   ((and (file-not-exists? target) known-sum)
		    (begin 
		      (checksum-into-file target ext current-total)
		      #f))
		   ((and (file-not-exists? target) (null? todo-exts))
		    (begin 
		      (checksum-into-file target 
					  (last (reverse extensions)) 
					  current-total)
		      #f))
		   ((and known-sum (= current-total known-sum)) #t)
		   ((and known-sum (not (= current-total known-sum)))
		    (begin
		      (checksum-into-file target ext current-total)
		      #f))
		   ((and (not known-sum) (not (null? todo-exts)))
		    (for-each-ext (car todo-exts) (cdr todo-exts)))
		   ((and (not known-sum) (null? todo-exts))
		    (begin 
		      (checksum-into-file target ext current-total)
		      #f))
		   (else (error "no match in same-checksum?"))))))
	   (else (error "no match in same-checksum?")))))))

(define (always target prereqs) #t)

(define (once target prereqs)
  (file-not-exists? target))

(define (file target prereqs)
  (same-mtime? target prereqs))

(define (all target prereqs)
  (all-same-mtime? target prereqs))

(define (md5 target prereqs)
  (not (same-checksum? target digest-extensions prereqs)))

(define (perms target prereqs)
  (not (same-perms? target prereqs)))

(define (md5-perms target prereqs)
  (and (not (same-checksum? target digest-extensions prereqs))
       (not (same-perms? target prereqs))
       (not (same-mtime? target prereqs))))

(define (paranoid target prereqs)
  (not (same-checksum? target digest-extensions prereqs)))