Index: common.scm
==================================================================
--- common.scm
+++ common.scm
@@ -1907,10 +1907,86 @@
 	       (set! bestsize freespc)))))
      (map car disks))
     (if (and best (> bestsize minsize))
 	best
 	#f))) ;; #f means no disk candidate found
+
+;; convert a spec string to a list of vectors #( rx  action rx-string )
+(define (common:spec-string->list-of-specs spec-string actions)
+  (let ((spec-strings  (string-split-fields "\\s*;\\s*" spec-string #:infix))
+	(actions-regex (regexp (conc "^(.*)\\s+(" (string-intersperse (map conc actions) "|") ")"))))
+    (filter
+     (lambda (x) x)
+     (map (lambda (s)
+	    (let ((m (string-match actions-regex s)))
+	      (if m
+		  (vector (regexp (cadr m))(string->symbol (caddr m))(cadr m))
+		  (begin
+		    (debug:print 0 *default-log-port* "WARNING: Unrecognised rule \"" s "\" in clean-up specification.")
+		    #f))))
+	  spec-strings))))
+  
+;; given a list of specs rx . rule and a file return the first matching rule
+;; 
+(define (common:file-find-rule fname rules) ;; rule is vector #( rx action rx-string)
+  (let loop ((rule   (car rules))
+	     (tail   (cdr rules)))
+    (let ((rx (vector-ref rule 0))
+	  (rn (vector-ref rule 1))) ;; rule name
+      (if (string-match rx fname)
+	  rule ;; return the whole rule so regex can be printed etc.
+	  (if (null? tail)
+	      #f
+	      (loop (car tail)(cdr tail)))))))
+
+;; given a spec apply some rules to a directory
+;;
+;;  WARNING: This function will REMOVE files - be sure your spec and path is correct!
+;;
+;; spec format:
+;;   file-regex1 action; file-regex2 action; ...
+;; e.g.
+;;   .*\.log$ keep; .* remove
+;;   --> keep all .log files, remove everything else
+;; limitations:
+;;   cannot have a rule with ; as part of the spec
+;;   not very flexible, would be nice to return binned file names?
+;; supported rules:
+;;   keep     - keep this file
+;;   remove   - remove this file
+;;   compress - compress this file
+;;
+(define (common:dir-clean-up path spec-string #!key (compress "gzip")(actions '(keep remove compress))(remove-empty #f))
+  (let* ((specs         (common:spec-string->list-of-specs spec-string actions))
+	 (keepers       (make-hash-table))
+	 (directories   (make-hash-table)))
+    (find-files 
+     path
+     action: (lambda (p res)
+	       (let ((rule  (common:file-find-rule p specs)))
+		 (cond
+		  ((directory? p)(hash-table-set! directories p #t))
+		  (else
+		   (case (vector-ref rule 1)
+		     ((keep)(hash-table-set! keepers p rule))
+		     ((remove)
+		      (print "Removing file " p)
+		      (delete-file p))
+		     ((compress)
+		      (print "Compressing file " p)
+		      (system (conc compress " " p)))
+		     (else
+		      (print "No match for file " p))))))))
+    (if remove-empty
+	(for-each
+	 (lambda (d)
+	   (if (null? (glob (conc d "/.*")(conc d "/*")))
+	       (begin
+		 (print "Removing empty directory " d)
+		 (delete-directory d))))
+	 (sort (hash-table-keys directories) (lambda (a b)(> (string-length a)(string-length b))))))
+    ))
 
 ;;======================================================================
 ;; E N V I R O N M E N T   V A R S
 ;;======================================================================
 (define (bb-check-path #!key (msg "check-path: "))