[cl-irc-cvs] r183 - trunk

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Thu Apr 19 17:50:36 2007
New Revision: 183

Modified:
   trunk/package.lisp
   trunk/utility.lisp
Log:
No idea why I wrote this, but I think it's generally usefull: hostmask matching.

Modified: trunk/package.lisp
==============================================================================
--- trunk/package.lisp	(original)
+++ trunk/package.lisp	Thu Apr 19 17:50:36 2007
@@ -86,6 +86,7 @@
              :remove-user
              :self-message-p
              :user-eq-me-p
+             :mask-matches-p
              :pass
              :nick
              :user-

Modified: trunk/utility.lisp
==============================================================================
--- trunk/utility.lisp	(original)
+++ trunk/utility.lisp	Thu Apr 19 17:50:36 2007
@@ -473,3 +473,44 @@
                                      (find-user connection (pop arguments))
                                      (pop arguments)))) ops)))))))))))
 
+
+;;;
+;;; Hostmask matcher
+;;;
+
+(defun do-mask-match (mask hostname mask-consumed host-consumed)
+  (if (= (length mask) (1+ mask-consumed))
+      ;; we're out of mask to match, hopefully, we're out of hostname too
+      (= (length hostname) (1+ host-consumed))
+    (let ((mask-char (char mask (1+ mask-consumed))))
+      (cond
+       ((eq mask-char #\?)
+        ;; match any character, if there is one
+        (do-mask-match mask hostname (1+ mask-consumed) (1+ host-consumed)))
+       ((eq mask-char #\*)
+        ;; match any number of characters (including zero)
+        (do ((match (do-mask-match mask hostname
+                                   (incf mask-consumed)
+                                   host-consumed)
+                    (do-mask-match mask hostname
+                                   mask-consumed
+                                   (incf host-consumed))))
+            ((or (= (length hostname) (1+ host-consumed))
+                 match)
+             match)))
+       ((= (1+ host-consumed) (length hostname))
+        ;; we're out of hostname...
+        nil)
+       (t
+        ;; match other characters by exact matches
+        (when (eq mask-char (char hostname (1+ host-consumed)))
+          (do-mask-match mask hostname
+                         (1+ mask-consumed) (1+ host-consumed))))))))
+
+  (defun mask-matches-p (mask hostname)
+    "Wildcard matching.
+
+Uses `*' to match any number of characters and `?' to match exactly any
+one character.  The routine does not enforce hostmask matching patterns,
+but can be used for the purpose."
+    (do-mask-match mask hostname -1 -1))