Common lispでURLエンコード、デコード

URLエンコード、デコードする関数。
sb-extを使ってるのでsbcl限定。

(make-array 0 :element-type '(unsigned-byte 8) :adjustable t :fill-pointer 0)
可変長の配列

(vector-push-extend (read-octet strm) vec)
配列を拡張して追加

(peek-char t strm nil 'EOF)
一文字先読み

(read-from-string (format nil "#x~A~A" 
(read-char strm t)
(read-char strm t))))
文字列を数値に変換

(defun concate-char(str c)
  (concatenate 'string str (format nil "~A" c)))

(defun concate(str1 str2)
  (concatenate 'string str1 str2))

(defun urlencode(str encoding)
  (reduce #'(lambda (enc c)
          (cond ((char= #\  c)
             (concate-char enc #\+))
             ((or (and (char< #\A c)
                   (char> #\z c))
              (char= #\. c)
              (char= #\_ c)
              (char= #\- c))
              (concate-char enc c))
             (t
              (concate enc (encoding c encoding)))))
      str
      :initial-value ""))

(defun encoding(char encoding)
  (let* ((s (format nil "~A" char))
     (vec (sb-ext:string-to-octets s :external-format encoding :null-terminate nil)))
    (reduce #'(lambda (enc c)
        (concate enc (format nil "%~X" c)))
        vec
        :initial-value "")))

(defun urldecode(str encoding)
  (with-input-from-string (strm str)
              (let ((dec-str ""))
                (do ((c (peek-char t strm nil 'EOF)
                    (peek-char t strm nil 'EOF)))
                ((eql c 'EOF) dec-str)
                  (cond ((char= c #\+)
                     (read-char strm nil 'EOF)
                     (setf dec-str (concate-char dec-str #\ )))
                    ((char= c #\%)
                     (setf dec-str (concate dec-str (sb-ext:octets-to-string (read-octets strm) :external-format encoding))))
                    (t
                     (read-char strm nil 'EOF)
                     (setf dec-str (concate-char dec-str c))))))))
(defun read-octets(strm)
  (let ((vec (make-array 0 :element-type '(unsigned-byte 8) :adjustable t :fill-pointer 0)))
    (do ((c (peek-char t strm nil 'EOF)
        (peek-char t strm nil 'EOF)))
    ((or (eql c 'EOF)
         (not (char= c #\%))) vec)
      (read-char strm nil 'EOF)
      (vector-push-extend (read-octet strm) vec))))
    
(defun read-octet(strm)
  (read-from-string (format nil "#x~A~A" 
                (read-char strm t)
                (read-char strm t))))

;; (defun urldecode(srcstr)
;;   (let ((decstr "")
;;     (vec nil))
;;     (with-input-from-string (strm srcstr)
;;                 (do ((c (peek-char strm nil 'EOF)
;;                     (peek-char strm nil 'EOF)))
;;                 ((eql c 'EOF) decstr)
;;                   (cond ((char= #\+ c)
;;                      (setf c (read-char strm nil 'EOF))
;;                      (setf decstr (concate-char decstr #\ )))
;;                     ((not (char= #\% c))
;;                      (setf c (read-char strm nil 'EOF))
;;                      (setf decstr (concate-char decstr c)))
;;                     (t
;;                      (setf c (read-char strm nil 'EOF))
;;                      (setf decstr (concate decstr "..."))))))))
                  

;; (defun read-encode-str(strm)
;;   (let ((fst (read-char strm nil 'EOF)))
;;     (if (eql fst 'EOF)
;;     ""
;;       (let ((scd (read-char strm nil 'EOF)))
;;     (if(eql scd 'EOF)
;;         ""
;;       (concatenate 'string (format nil "~A" fst) (format nil "~A" scd)))))))

;; (defun decode-string(strm encoding)
;;   (let ((vec (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t)))
;;     (do ((c (peek-char t strm nil 'EOF)))
;;     ((eql 'EOF c) 
;;      (sb-ext:octets-to-string vec :external-format encoding))
;;       (cond ((char= 
       
;;                 (do ((c (read-char strm nil 'EOF)
;;                     (read-char strm nil 'EOF)))
;;                 ((eql c 'EOF) decstr)
;;                   (cond ((char= #\+ c)
;;                      (setf decstr (concate-char decstr #\ )))
;;                     ((not (char= #\% c))
;;                      (setf decstr (concate-char decstr c)))
;;                     (t
;;                      (setf decstr (concate decstr "..."))))))))


;; (defun urlencode(str encoding)
;;   (reduce #'(lambda (vec c)
;;           (cond ((char= #\  c)
;;              (vector-push-extend #\+ vec)
;;              vec)
;;              ((or (and (char< #\A c)
;;                    (char> #\z c))
;;               (char= #\. c)
;;               (char= #\_ c)
;;               (char= #\- c))
;;               (vector-push-extend c vec)
;;               vec)
;;              (t
;;               (concatenate 'string vec (encoding c encoding)))))
;;       str
;;       :initial-value (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t)))

;; (defun encoding(char encoding)
;;   (let* ((s (format nil "~A" char))
;;      (vec (sb-ext:string-to-octets s :external-format encoding :null-terminate nil)))
;;     (reduce #'(lambda (vec c)
;;         (concatenate 'string vec (format nil "%~X" c)))
;;         vec
;;         :initial-value (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t))))

;; (defun urldecode(srcstr)
;;   (with-input-from-string (strm srcstr)
;;               (pprint strm)))

;; (defun urldecode(srcstr)
;;   (let ((decstr ""))
;;     (do*  ((i 0 (1+ i))
;;        (s (subseq srcstr i (1+ i))))
;;     ((> i (length srcstr)))
;;       (cond ((or (and (string< "A" s)
;;               (string> "z" s))
;;          (string= "." s)
;;          (string= "_" s)
;;          (string= "-" s))
;;          (concatenate 'string s decstr))
;;         ((string= "+" s)
;;          (concatenate 'string " " decstr))
;;         ((string= "%" s)
;;          (setf i
;;            (do* ((j i (+ 2 j))
;;              (lst nil (cons (subseq srcstr j (+ 2 j)))))
;;                ((or (> (+ j 2) (length srcstr))
;;                 (not (string= "%" (subseq srcstr j (1+ j))))) j)))         

;; (defun convert-to-vec(lst)
;;   (make-array (length lst)


;;   (let ((lst nil))
;;     (do ((i 0 (1+ i)))
;;     ((<= (length str) i) lst)
;;       (let ((s (subseq str i (1+ i))))
;;     (cond ((or (and (string< "A" s)
;;             (string> "z" s))
;;            (string= "." s)
;;            (string= "_" s)
;;            (string= "-" s))
;;            (cons s lst))
;;           ((string= "+" s)
;;            (cons s lst))
;;           ((string= "%" s)
;;            (do ((j 0 (1+ j)))
;;            ((<= (length str) (+ j i)