[Cl-darcs-cvs] r66 - cl-darcs/trunk

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Wed Nov 22 13:46:37 2006
New Revision: 66

Modified:
   cl-darcs/trunk/util.lisp
Log:
Add *scanner-cache*, matches-one-of, file-binary-p and file-boring-p.


Modified: cl-darcs/trunk/util.lisp
==============================================================================
--- cl-darcs/trunk/util.lisp	(original)
+++ cl-darcs/trunk/util.lisp	Wed Nov 22 13:46:37 2006
@@ -274,3 +274,30 @@
 	   (copy-directory source-file target-file :excluding excluding))
 	  (t
 	   (fad:copy-file source-file target-file)))))))
+
+(defvar *scanner-cache* (make-hash-table :test 'equal)
+  "Hash table for scanners created for filename regexp tests.
+Creating a scanner is slow, but using it is fast.")
+
+(defun matches-one-of (regexps string)
+  "Return true if some of REGEXPS match STRING.
+Cache scanners for faster execution beyond first time."
+  (dolist (regexp regexps)
+    (let ((scanner (or
+		    (gethash regexp *scanner-cache*)
+		    (setf (gethash regexp *scanner-cache*)
+			  (cl-ppcre:create-scanner regexp)))))
+      (when (cl-ppcre:scan scanner string)
+	(return t)))))
+
+(defun file-binary-p (repo filename)
+  "Return true if FILENAME names a binary file.
+Uses the regexps specified in REPO."
+  (let ((binary-regexps (get-preflist repo "binaries")))
+    (matches-one-of binary-regexps filename)))
+
+(defun file-boring-p (repo filename)
+  "Return true if FILENAME names a boring file.
+Uses the regexps specified in REPO."
+  (let ((binary-regexps (get-preflist repo "boring")))
+    (matches-one-of binary-regexps filename)))