mirror of
https://github.com/vale981/myway
synced 2025-03-04 17:31:41 -05:00
Add url-for. Replace do-urlencode by quri.
This commit is contained in:
parent
2a6634c5b4
commit
ad4b452a3f
5 changed files with 46 additions and 9 deletions
|
@ -19,7 +19,7 @@
|
||||||
:author "Eitaro Fukamachi"
|
:author "Eitaro Fukamachi"
|
||||||
:license "LLGPL"
|
:license "LLGPL"
|
||||||
:depends-on (:cl-ppcre
|
:depends-on (:cl-ppcre
|
||||||
:do-urlencode
|
:quri
|
||||||
:map-set
|
:map-set
|
||||||
:alexandria
|
:alexandria
|
||||||
:cl-utilities)
|
:cl-utilities)
|
||||||
|
|
|
@ -13,7 +13,8 @@
|
||||||
:route-name
|
:route-name
|
||||||
:route-handler
|
:route-handler
|
||||||
:equal-route
|
:equal-route
|
||||||
:match-route)
|
:match-route
|
||||||
|
:url-for)
|
||||||
(:import-from :alexandria
|
(:import-from :alexandria
|
||||||
:delete-from-plist)
|
:delete-from-plist)
|
||||||
(:export :make-mapper
|
(:export :make-mapper
|
||||||
|
@ -32,7 +33,8 @@
|
||||||
:route-name
|
:route-name
|
||||||
:route-handler
|
:route-handler
|
||||||
:equal-route
|
:equal-route
|
||||||
:match-route))
|
:match-route
|
||||||
|
:url-for))
|
||||||
(in-package :myway)
|
(in-package :myway)
|
||||||
|
|
||||||
(defun connect (mapper url fn &key (method '(:GET)) regexp name)
|
(defun connect (mapper url fn &key (method '(:GET)) regexp name)
|
||||||
|
|
|
@ -4,13 +4,15 @@
|
||||||
(:import-from :myway.rule
|
(:import-from :myway.rule
|
||||||
:make-rule
|
:make-rule
|
||||||
:match-rule
|
:match-rule
|
||||||
:equal-rule)
|
:equal-rule
|
||||||
|
:rule-url-for)
|
||||||
(:export :route
|
(:export :route
|
||||||
:route-name
|
:route-name
|
||||||
:route-rule
|
:route-rule
|
||||||
:route-handler
|
:route-handler
|
||||||
:match-route
|
:match-route
|
||||||
:equal-route))
|
:equal-route
|
||||||
|
:url-for))
|
||||||
(in-package :myway.route)
|
(in-package :myway.route)
|
||||||
|
|
||||||
(defclass route ()
|
(defclass route ()
|
||||||
|
@ -34,3 +36,6 @@
|
||||||
(defgeneric match-route (route method url-string &key allow-head)
|
(defgeneric match-route (route method url-string &key allow-head)
|
||||||
(:method ((route route) method url-string &key allow-head)
|
(:method ((route route) method url-string &key allow-head)
|
||||||
(match-rule (route-rule route) method url-string :allow-head allow-head)))
|
(match-rule (route-rule route) method url-string :allow-head allow-head)))
|
||||||
|
|
||||||
|
(defun url-for (route params)
|
||||||
|
(rule-url-for (route-rule route) params))
|
||||||
|
|
|
@ -1,8 +1,8 @@
|
||||||
(in-package :cl-user)
|
(in-package :cl-user)
|
||||||
(defpackage myway.rule
|
(defpackage myway.rule
|
||||||
(:use :cl)
|
(:use :cl)
|
||||||
(:import-from :do-urlencode
|
(:import-from :quri
|
||||||
:urlencode)
|
:url-encode)
|
||||||
(:import-from :map-set
|
(:import-from :map-set
|
||||||
:map-set
|
:map-set
|
||||||
:make-map-set
|
:make-map-set
|
||||||
|
@ -15,7 +15,8 @@
|
||||||
:regex-rule
|
:regex-rule
|
||||||
:make-rule
|
:make-rule
|
||||||
:match-rule
|
:match-rule
|
||||||
:equal-rule))
|
:equal-rule
|
||||||
|
:rule-url-for))
|
||||||
(in-package :myway.rule)
|
(in-package :myway.rule)
|
||||||
|
|
||||||
(defun list-to-map-set (elements)
|
(defun list-to-map-set (elements)
|
||||||
|
@ -71,7 +72,7 @@
|
||||||
(rule-param-keys rule) names)))
|
(rule-param-keys rule) names)))
|
||||||
|
|
||||||
(defun escape-special-char (char)
|
(defun escape-special-char (char)
|
||||||
(let ((enc (urlencode (string char))))
|
(let ((enc (url-encode (string char))))
|
||||||
(cond
|
(cond
|
||||||
((string= char " ") (format nil "(?:~A|~A)" enc (escape-special-char #\+)))
|
((string= char " ") (format nil "(?:~A|~A)" enc (escape-special-char #\+)))
|
||||||
((string= enc char) (ppcre:quote-meta-chars enc))
|
((string= enc char) (ppcre:quote-meta-chars enc))
|
||||||
|
@ -116,3 +117,24 @@
|
||||||
(ms-member-p rule2-methods rule))
|
(ms-member-p rule2-methods rule))
|
||||||
(map-set-index (rule-methods rule1))))
|
(map-set-index (rule-methods rule1))))
|
||||||
(string= (rule-url rule1) (rule-url rule2))))
|
(string= (rule-url rule1) (rule-url rule2))))
|
||||||
|
|
||||||
|
(defgeneric rule-url-for (rule params)
|
||||||
|
(:method ((rule rule) params)
|
||||||
|
(let ((url (apply #'format nil (rule-format-string rule)
|
||||||
|
(loop for key in (rule-param-keys rule)
|
||||||
|
if (eq key :splat)
|
||||||
|
collect (pop (getf params key))
|
||||||
|
else if (getf params key)
|
||||||
|
collect (url-encode (getf params key))
|
||||||
|
and do (remf params key)
|
||||||
|
else
|
||||||
|
collect ""))))
|
||||||
|
(values
|
||||||
|
(ppcre:regex-replace-all
|
||||||
|
"\\?"
|
||||||
|
(ppcre:regex-replace-all "(.\\?)+$" url "") "")
|
||||||
|
params)))
|
||||||
|
(:method ((rule regex-rule) params)
|
||||||
|
(values (apply #'format (rule-format-string rule)
|
||||||
|
(getf params :captures))
|
||||||
|
(and (remf params :captures) params))))
|
||||||
|
|
|
@ -128,4 +128,12 @@
|
||||||
'("/test%28bar%29/" nil)
|
'("/test%28bar%29/" nil)
|
||||||
"escape ()"))
|
"escape ()"))
|
||||||
|
|
||||||
|
(subtest "url-for"
|
||||||
|
(is (rule-url-for (make-rule "/hello/?:name?") '(:name "Eitaro"))
|
||||||
|
"/hello/Eitaro")
|
||||||
|
(is (rule-url-for (make-rule "/hello/?:name?") nil)
|
||||||
|
"/hello")
|
||||||
|
(is (rule-url-for (make-rule "/hello/?:name?") '(:name "Eitaro Fukamachi"))
|
||||||
|
"/hello/Eitaro%20Fukamachi"))
|
||||||
|
|
||||||
(finalize)
|
(finalize)
|
||||||
|
|
Loading…
Add table
Reference in a new issue