Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 125 lines (109 sloc) 4.685 kb
6f8fdec @gihnius add to github
authored
1 (in-package :cl-common-blog)
2
3 (defun slice (list start end)
6ebb1be @gihnius publish as version 0.2
authored
4 "get a piece of sequence, ignore wild input when do subseq"
6f8fdec @gihnius add to github
authored
5 (let ((len (length list)))
eae9a01 @gihnius update code style, little fix
authored
6 (when (< start 1) (setf start 1))
7 (when (plusp len)
6ebb1be @gihnius publish as version 0.2
authored
8 (subseq list
9 (min (1- start) len)
10 (min end len)))))
11
12 (defun slice-html (str start end)
13 "slice a part of html"
14 (slice str start end))
15
6f8fdec @gihnius add to github
authored
16
17 ;;;; => (nil b) from f('a '(a b c d e))
18 ;;;; => (b d) from f('c '(a b c d e))
19 ;;;; => (d nil) from f('e '(a b c d e))
2ae7ed3 @gihnius update
authored
20 (defun cons-prev-next (mid lst)
21 "Return a list of the previous and next elements."
6ebb1be @gihnius publish as version 0.2
authored
22 (if (equal mid (car lst))
46ca73d @gihnius update cons-prev-next
authored
23 (list nil (cadr lst))
e673d9e @gihnius update cons-prev-next
authored
24 (loop for xx on lst
25 do
26 (when (equal mid (cadr xx))
27 (return (list (car xx) (caddr xx)))))))
6f8fdec @gihnius add to github
authored
28
0965859 @gihnius update render page
authored
29 (defmacro aif (test-form then-form &optional else-form)
30 `(let ((it ,test-form))
31 (if it ,then-form ,else-form)))
32
6f8fdec @gihnius add to github
authored
33 ;;;; a simple validate method for post blog data
34 ;;;; return T for valid data Or Nil
35 (defmethod validate (symbol (type (eql 'list)) &key (size nil))
36 "(validate s 'list) size is not important
37 (validate s 'list :size 5) length of list equal size"
38 (and symbol (listp symbol)
39 (if size (eql (length symbol) size) t)))
40 (defmethod validate (symbol (type (eql 'number)) &key (min nil) (max nil))
41 (and symbol (numberp symbol)
42 (if min (> symbol min) t)
43 (if max (< symbol max) t)))
44 (defmethod validate (symbol (type (eql 'string)) &key (len nil) (min nil) (max nil))
45 (and symbol (stringp symbol)
46 (if len (eql len (length symbol)) t)
47 (if min (> (length symbol) min) t)
48 (if max (< (length symbol) max) t)))
49 (defmethod validate (symbol (type (eql 'bool)) &rest rest)
50 (declare (ignore rest))
51 (or (string-equal "yes" symbol) (string-equal "no" symbol)
52 (string-equal "true" symbol) (string-equal "false" symbol)))
53 (defmethod validate (symbol (type (eql 'timestamp)) &rest rest)
54 "timestamp form 20110101000000"
55 (declare (ignore rest))
56 (and (validate symbol 'number :min 3502800000)))
57 (defmethod validate (symbol (type (eql 'http-url)) &rest rest)
58 "http://xxxx"
59 (declare (ignore rest))
60 (and (validate symbol 'string :min 10) (string-equal "http://" (slice symbol 1 7))))
61 (defmethod validate (symbol (type (eql 'email)) &rest rest)
62 "full perl regex: http://ex-parrot.com/~pdw/Mail-RFC822-Address.html.
63 here just a simple validate"
64 (declare (ignore rest))
6ebb1be @gihnius publish as version 0.2
authored
65 (and symbol (validate symbol 'string :min 5) (cl-ppcre:scan "\\w+@\\w+\\.\\w+" symbol) t))
6f8fdec @gihnius add to github
authored
66 (defmethod validate (symbol (type (eql 'ip)) &rest rest)
67 (declare (ignore rest))
6ebb1be @gihnius publish as version 0.2
authored
68 (and symbol (cl-ppcre:scan "^(\\d{1,3}\\.){3}\\d{1,3}$" symbol) t))
6f8fdec @gihnius add to github
authored
69
eae9a01 @gihnius update code style, little fix
authored
70 (defun timestamp-to-datetime (ts)
71 "timestamp to yyyymmddHHMMSS format"
72 (multiple-value-bind (sec min hour date month year dow dst-p tz)
73 (decode-universal-time ts)
74 (declare (ignore dow tz dst-p))
75 (format nil "~&~4D~2,'0D~2,'0D~2,'0D~2,'0D~2,'0D" year month date hour min sec)))
76
77 (defun datetime-to-timestamp (dt)
78 "yyyymmddHHMMSS to timestamp"
6ebb1be @gihnius publish as version 0.2
authored
79 (cl-ppcre:register-groups-bind ((#'parse-integer year month date hour min sec))
eae9a01 @gihnius update code style, little fix
authored
80 ("(\\d{4})(\\d{2})(\\d{2})(\\d{2})(\\d{2})(\\d{2})"
81 dt)
82 (encode-universal-time sec min hour date month year)))
83
6f8fdec @gihnius add to github
authored
84 (defun esc-str (str)
85 (cl-who:escape-string str :test #'(lambda (char)
48b9d31 @gihnius update , do not escape \'
authored
86 (find char "<>&\""))))
6f8fdec @gihnius add to github
authored
87
6ebb1be @gihnius publish as version 0.2
authored
88 (defun unesc-links (str)
89 (cl-ppcre:regex-replace-all
90 (cl-ppcre:create-scanner "(\\s|^)(https?://\\S+?)(\\s|<|$)" :multi-line-mode t)
91 (cl-ppcre:regex-replace-all
92 (cl-ppcre:create-scanner "(\\s|^)(\\S+@\\S+?\\.\\S+?)(\\s|<|$)" :multi-line-mode t)
93 str
94 "\\1<a href='mailto:\\2'>\\2</a>\\3")
95 "\\1<a href='\\2' target='_blank'>\\2</a>\\3"))
96
6f8fdec @gihnius add to github
authored
97 (defun replace-space (str)
98 (delete-if #'(lambda (x) (not (or (alphanumericp x) (char= #\- x))))
99 (substitute #\- #\Space str)))
100
101 (defun flatten (tree)
102 (let ((result '()))
103 (labels ((scan (item)
104 (if (listp item)
105 (map nil #'scan item)
106 (push item result))))
107 (scan tree))
108 (nreverse result)))
109
110 ;; (defun html-text (text)
111 ;; (delete 'nil (loop for str in (flatten (html-parse:parse-html text))
112 ;; collect (and (stringp str) str))))
113
114 (defun octets->letters (octet-vector)
115 (with-output-to-string (stream)
116 (loop for i across octet-vector
117 do (flet ((foo (x) (aref "0123456789abcdef" (ldb (byte x (- x 4)) i))))
118 (princ (foo 8) stream)
119 (princ (foo 4) stream)))))
120
121 (defun md5sum (string)
6ebb1be @gihnius publish as version 0.2
authored
122 (unless string (setf string ""))
6f8fdec @gihnius add to github
authored
123 (octets->letters (with-input-from-string (stream string)
124 (md5:md5sum-stream stream))))
Something went wrong with that request. Please try again.