uri.lisp (2153B)
1 (defpackage :rw.uri 2 (:use :cl) 3 (:export :parse 4 :parse-query-string)) 5 6 (in-package :rw.uri) 7 8 ;; TODO http://www.w3.org/Addressing/URL/url-spec.txt 9 (defun parse (x) 10 (flet ((str (y) 11 (when y 12 (coerce y 'string)))) 13 (let ((r (rw:peek-reader (rw:reader x)))) 14 ;;scheme://host:port/path?query-string#fragment 15 (list :scheme (str (prog1 (rw:till r '(#\:)) 16 (assert (eql #\: (rw:next r))) 17 (assert (eql #\/ (rw:next r))) 18 (assert (eql #\/ (rw:next r))))) 19 :host (str (rw:till r '(#\: #\/))) 20 :port (when (eql #\: (rw:peek r)) 21 (rw:next r) 22 (rw:next-z0 r)) 23 :path (str (rw:till r '(#\?))) 24 :query-string (when (eql #\? (rw:peek r)) 25 (rw:next r) 26 (str (rw:till r '(#\#)))) 27 :fragment (when (eql #\# (rw:peek r)) 28 (rw:next r) 29 (str (rw:till r))))))) 30 31 ;;(parse "https://en.wikipedia.org/wiki/Uniform_Resource_Locator") 32 ;;(parse "http://panda:1234/?s=24rb7pccnd&a=0&c=#hello#there") 33 34 (defun query-string-pair-reader (reader) 35 (let ((r (rw:peek-reader reader))) 36 (lambda () 37 (when (eql #\& (rw:peek r)) 38 (rw:next r)) 39 (let ((k (rw:till r '(#\= #\&)))) 40 (when k 41 (flet ((str (y) ;; TODO better 42 (when y 43 (coerce y 'string)))) 44 (cons (str k) 45 (when (eql #\= (rw:next r)) 46 (str (rw:till r '(#\&))))))))))) 47 48 (defun parse-query-string (x) 49 (let ((r (rw:peek-reader (rw:reader x)))) 50 (values (rw:till r '(#\?)) 51 (when (eql #\? (rw:peek r)) 52 (rw:next r) 53 (rw:till (rw:peek-reader (query-string-pair-reader (rw:reader (rw:till r '(#\#))))))) 54 (when (eql #\# (rw:peek r)) 55 (rw:next r) 56 (rw:till r))))) 57 58 ;;(parse-query-string "?s=24rb7pccnd&a=0&c=") 59 ;;(parse-query-string "/foo?s=24rb7pccnd&a=0&c=") 60 ;;(parse-query-string "/foo?s=24rb7pccnd&a=0&c=#123")