Преглед изворни кода

Convert functions to use more standard CL libs

Lily Carpenter пре 9 година
родитељ
комит
7ac45e5ec6
2 измењених фајлова са 16 додато и 30 уклоњено
  1. 2 1
      mailfilter-parse.asd
  2. 14 29
      mailfilter-parse.lisp

+ 2 - 1
mailfilter-parse.asd

6
   :license "BSD 3-clause"
6
   :license "BSD 3-clause"
7
   :depends-on (#:cl-ppcre
7
   :depends-on (#:cl-ppcre
8
                #:alexandria
8
                #:alexandria
9
-               #:mel-base)
9
+               #:mel-base
10
+               #:split-sequence)
10
   :serial t
11
   :serial t
11
   :components ((:file "package")
12
   :components ((:file "package")
12
                (:file "mailfilter-parse")))
13
                (:file "mailfilter-parse")))

+ 14 - 29
mailfilter-parse.lisp

29
 (defvar *commands* '("to"))
29
 (defvar *commands* '("to"))
30
 (defvar *maildir* nil)
30
 (defvar *maildir* nil)
31
 
31
 
32
-; Thanks to http://cl-cookbook.sourceforge.net/strings.html#manip
33
-(defun replace-all (string part replacement &key (test #'char=))
34
-  "Returns a new string in which all the occurences of the part
35
-   is replaced with replacement."
36
-  (with-output-to-string (out)
37
-    (loop with part-length = (length part)
38
-       for old-pos = 0 then (+ pos part-length)
39
-       for pos = (search part string
40
-                         :start2 old-pos
41
-                         :test test)
42
-       do (write-string string out
43
-                        :start old-pos
44
-                        :end (or pos (length string)))
45
-       when pos do (write-string replacement out)
46
-       while pos)))
47
-
48
-; This function is pretty ugly but I was tired when I wrote it and just wanted it to work.
49
-; TODO: Clean this up
32
+;; This function is pretty ugly but I was tired when I wrote it and just wanted it to work.
33
+;; TODO: Clean this up
50
 (defun split-quoted (str)
34
 (defun split-quoted (str)
51
   (let ((my-list nil)
35
   (let ((my-list nil)
52
         (my-string (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t))
36
         (my-string (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t))
66
 (defun check-start (line expected seperator)
50
 (defun check-start (line expected seperator)
67
   (if (or (empty-string? line) (empty-string? seperator))
51
   (if (or (empty-string? line) (empty-string? seperator))
68
       nil
52
       nil
69
-      (string= expected (first (split line seperator)))))
53
+      (string= expected (first (split-sequence:split-sequence seperator line)))))
70
 
54
 
71
 (defun test-for-maildir (line)
55
 (defun test-for-maildir (line)
72
   (check-start line "MAILDIR" "="))
56
   (check-start line "MAILDIR" "="))
85
      until (or (eq line 'eof) (funcall test-func line))))
69
      until (or (eq line 'eof) (funcall test-func line))))
86
 
70
 
87
 (defun convert-maildir-value (value)
71
 (defun convert-maildir-value (value)
88
-  (remove #\" (replace-all value "${HOME}" (to-string (user-homedir-pathname)))))
72
+  (remove #\" (cl-ppcre:regex-replace-all "${HOME}" value (user-homedir-pathname))))
89
 
73
 
90
 (defun set-maildir (line hash)
74
 (defun set-maildir (line hash)
91
-  (let ((maildir (convert-maildir-value (car (last (split line "="))))))
92
-    (sethash "maildir" hash maildir)
75
+  (let ((maildir (convert-maildir-value (car (last (split-sequence:split-sequence "=" line))))))
76
+    (setf (gethash "maildir" hash) maildir)
93
     (setf *maildir* maildir)))
77
     (setf *maildir* maildir)))
94
 
78
 
95
 (defun parse-line (s line hash)
79
 (defun parse-line (s line hash)
103
 
87
 
104
 (defun clean-line (line)
88
 (defun clean-line (line)
105
   (let ((cleaned-line (string-trim '(#\Space #\Tab) line)))
89
   (let ((cleaned-line (string-trim '(#\Space #\Tab) line)))
106
-    (replace-all cleaned-line "${MAILDIR}" *maildir*)))
90
+    (cl-ppcre:regex-replace-all "${MAILDIR}" cleaned-line *maildir*)))
107
 
91
 
108
 (defun hash-add-command (line hash)
92
 (defun hash-add-command (line hash)
109
   (let* ((cleaned-line (clean-line line))
93
   (let* ((cleaned-line (clean-line line))
110
          (line-list (split-quoted cleaned-line)))
94
          (line-list (split-quoted cleaned-line)))
111
-    (sethash "command" hash (first line-list))
112
-    (sethash "args" hash (subseq line-list 1))
95
+    (setf (gethash "command" hash) (first line-list))
96
+    (setf (gethash "args" hash) (subseq line-list 1))
113
     hash))
97
     hash))
114
 
98
 
115
 (defun get-regex (line)
99
 (defun get-regex (line)
116
-  (second (split line "/")))
100
+  (second (split-sequence:split-sequence "/" line)))
117
 
101
 
118
 (defun make-regex-hash (regex)
102
 (defun make-regex-hash (regex)
119
   (let ((regex-hash (make-hash-table :test 'equal)))
103
   (let ((regex-hash (make-hash-table :test 'equal)))
120
-    (sethash "regex" regex-hash regex)
104
+    (setf (gethash "regex" regex-hash) regex)
121
     regex-hash))
105
     regex-hash))
122
 
106
 
123
 (defun parse-if-line (line hash)
107
 (defun parse-if-line (line hash)
124
   (if (test-for-if line)
108
   (if (test-for-if line)
125
       (let* ((regex (get-regex line))
109
       (let* ((regex (get-regex line))
126
              (regex-hash (make-regex-hash regex)))
110
              (regex-hash (make-regex-hash regex)))
127
-        (sethash "patterns" hash (append (gethash "patterns" hash) (list regex-hash)))
111
+        (setf (gethash "patterns" hash) (append (gethash "patterns" hash) (list regex-hash)))
128
         regex-hash)))
112
         regex-hash)))
129
 
113
 
130
 (defun parse-inner-if-line (s line hash)
114
 (defun parse-inner-if-line (s line hash)
115
+  (declare (ignore s) )
131
   (if (test-for-command line)
116
   (if (test-for-command line)
132
       (hash-add-command line hash)))
117
       (hash-add-command line hash)))
133
 
118
 
138
 (defun read-mailfilter-file (file)
123
 (defun read-mailfilter-file (file)
139
   (let ((hash (make-hash-table :test 'equal)))
124
   (let ((hash (make-hash-table :test 'equal)))
140
     (with-open-file (s file)
125
     (with-open-file (s file)
141
-      (loop-file-until s (lambda (x) nil)  #'parse-line hash))
126
+      (loop-file-until s (lambda (x) (declare (ignore x)))  #'parse-line hash))
142
     hash))
127
     hash))