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)))