Changed templates to be delimited with double quotes

This avoids problems with maintaining the set of characters that
delimited the end of the template.
parent dbd7401c
2019-08-17 Vladimir Sedach <vas@oneofus.la>
* uri-template.lisp (uri-encode): Avoid copying strings.
(uri-template-to-string): Renamed uri-template to
(uri-template): Renamed uri-template to
uri-template-to-string, so that the internal function would
not be exported along with the template name.
(read-uri-template): Changed templates to be delimited with
double quotes. This avoids problems with maintaining the set
of characters that delimited the end of the template.
2019-08-16 Vladimir Sedach <vas@oneofus.la>
......
......@@ -30,27 +30,27 @@
(test interpolation3
(let ((bar "bar")
(baz 1))
(is (string= #Uhttp://www.foo.com/bar/{bar}{baz}
(is (string= #U"http://www.foo.com/bar/{bar}{baz}"
"http://www.foo.com/bar/bar1"))))
(test interpolation2
(let ((bar "bar")
(baz 1))
(is (string= #Uhttp://www.foo.com/bar/{bar}/{baz}
(is (string= #U"http://www.foo.com/bar/{bar}/{baz}"
"http://www.foo.com/bar/bar/1"))))
(test interpolation1
(let ((baz 1))
(is (string= #Uhttp://www.foo.com/bar/{baz}
(is (string= #U"http://www.foo.com/bar/{baz}"
"http://www.foo.com/bar/1"))))
(test interpolation-encoding
(is (string= #Uhttp://www.foo.com/bar?foo={"^BAZ !bar"}
(is (string= #U"http://www.foo.com/bar?foo={"^BAZ !bar"}"
"http://www.foo.com/bar?foo=%5EBAZ%20%21bar")))
(test destructuring1
(is (equal
(uri-template-bind (#Uhttp://www.factory.com/orders/{part}/{number})
(uri-template-bind (#U"http://www.factory.com/orders/{part}/{number}")
"http://www.factory.com/orders/widget/1234"
(list part (parse-integer number) %uri-host))
'("widget" 1234 "www.factory.com"))))
......@@ -58,13 +58,13 @@
(test destructuring2
(is
(equal
(uri-template-bind (#U{uri})
(uri-template-bind (#U"{uri}")
"https://www.google.com/dir/1/2/search.html?arg=0-a&arg1=1-b&amp;arg3-c#hash"
(list %uri-scheme %uri-host %uri-path %uri-directory %uri-file %uri-query %uri-fragment))
'("https" "www.google.com" "/dir/1/2/search.html" "/dir/1/2/" "search.html" "arg=0-a&arg1=1-b&amp;arg3-c" "hash"))))
(test destructuring3
(is (equal (uri-template-bind (#U/apps/{app-name}/{table-template}/{table-id})
(is (equal (uri-template-bind (#U"/apps/{app-name}/{table-template}/{table-id}")
"/apps/EVWeb/Fixed%20Cost/20"
(list app-name table-template table-id %uri-path))
'("EVWeb" "Fixed Cost" "20" "/apps/EVWeb/Fixed Cost/20"))))
......@@ -72,7 +72,7 @@
(test destructuring4
(is
(equal
(uri-template-bind (#U{uri})
(uri-template-bind (#U"{uri}")
"http://files3.dsv.data.cod.ru/?WyIyNWQ3NWU5NTRmZDU1MWIzYmQ5NzVjNzJhZjRkZmNhZSIsMTI1MTA5NjMxNCwiXHUwNDEwXHUwNDNiXHUwNDRjXHUwNDRmXHUwNDNkXHUwNDQxIFx1MDQ0MVx1MDQzNVx1MDQ0MFx1MDQzZVx1MDQzYVx1MDQ0MFx1MDQ0Ylx1MDQzYlx1MDQ0Ylx1MDQ0NS5yYXIiLCJrTzNqSUo3bUN5WlBPenlBVGdcL0M3UkZVWHdXYkN6SWtEYzUweTl5a1lOVCtTRmlwVFdsN1UxWlVybGVLNjMyaGlYc0hvVDhGZitGWUt6eGVVRGxOVkxUN3R0MndLYjg4VGFjYmZSVnhrZjNYQXdZalpYemVEQXM4bmxzK0RCbnZEcnZQTmRMKytDS05pNjVJXC8yb2JnY0N1RmdyK1lpS0VSak8rNVZSeTIrcz0iXQ%3D%3D"
(list %uri-scheme %uri-authority %uri-path %uri-directory %uri-file %uri-query %uri-fragment))
'("http" "files3.dsv.data.cod.ru" "/" "/" nil "WyIyNWQ3NWU5NTRmZDU1MWIzYmQ5NzVjNzJhZjRkZmNhZSIsMTI1MTA5NjMxNCwiXHUwNDEwXHUwNDNiXHUwNDRjXHUwNDRmXHUwNDNkXHUwNDQxIFx1MDQ0MVx1MDQzNVx1MDQ0MFx1MDQzZVx1MDQzYVx1MDQ0MFx1MDQ0Ylx1MDQzYlx1MDQ0Ylx1MDQ0NS5yYXIiLCJrTzNqSUo3bUN5WlBPenlBVGdcL0M3UkZVWHdXYkN6SWtEYzUweTl5a1lOVCtTRmlwVFdsN1UxWlVybGVLNjMyaGlYc0hvVDhGZitGWUt6eGVVRGxOVkxUN3R0MndLYjg4VGFjYmZSVnhrZjNYQXdZalpYemVEQXM4bmxzK0RCbnZEcnZQTmRMKytDS05pNjVJXC8yb2JnY0N1RmdyK1lpS0VSak8rNVZSeTIrcz0iXQ==" nil))))
......@@ -80,7 +80,7 @@
(test destructuring5
(is
(equal
(uri-template-bind (#U{uri})
(uri-template-bind (#U"{uri}")
"http://www.foo.com/abc?bar=baz&xyz=1#hash"
(list %uri-scheme %uri-host %uri-path %uri-directory %uri-file %uri-query %uri-fragment %uri-head %uri-tail))
'("http" "www.foo.com" "/abc" "/" "abc" "bar=baz&xyz=1" "hash" "http://www.foo.com" "/abc?bar=baz&xyz=1#hash"))))
......@@ -88,7 +88,7 @@
(test destructuring6
(is
(equal
(uri-template-bind (#U{uri})
(uri-template-bind (#U"{uri}")
"http://user@www.foo.com:8080/dir/abc?bar=baz&xyz=1#hash"
(list %uri-scheme %uri-authority %uri-user %uri-host %uri-port %uri-path %uri-directory %uri-file %uri-query %uri-fragment %uri-head %uri-tail))
'("http" "user@www.foo.com:8080" "user" "www.foo.com" "8080" "/dir/abc" "/dir/" "abc" "bar=baz&xyz=1" "hash" "http://user@www.foo.com:8080" "/dir/abc?bar=baz&xyz=1#hash"))))
......@@ -96,7 +96,7 @@
(test destructuring7
(is
(equal
(uri-template-bind (#U{uri})
(uri-template-bind (#U"{uri}")
"http://www.foo.com/?bar=baz&xyz=1"
(list %uri-scheme %uri-host %uri-path %uri-directory %uri-file %uri-query %uri-fragment))
'("http" "www.foo.com" "/" "/" nil "bar=baz&xyz=1" nil))))
......@@ -104,7 +104,7 @@
(test destructuring8
(is
(equal
(uri-template-bind (#U{uri}) "http://user@host.com:8080/dir1/dir2/file?query=want&a=b#hash"
(uri-template-bind (#U"{uri}") "http://user@host.com:8080/dir1/dir2/file?query=want&a=b#hash"
(list %uri-scheme %uri-authority (list %uri-user %uri-host %uri-port)
%uri-path (list %uri-directory %uri-file) %uri-query %uri-fragment))
'("http" "user@host.com:8080" ("user" "host.com" "8080") "/dir1/dir2/file"
......@@ -113,31 +113,35 @@
(test destructuring9
(is
(equal
(uri-template-bind (#U{uri}) "/foo/bar"
(uri-template-bind (#U"{uri}") "/foo/bar"
(list %uri-head %uri-tail %uri-scheme
%uri-authority (list %uri-user %uri-host %uri-port)
%uri-path (list %uri-directory %uri-file) %uri-query %uri-fragment))
'(NIL "/foo/bar" NIL NIL (NIL NIL NIL) "/foo/bar" ("/foo/" "bar") NIL NIL))))
(test encoding1
(is (string= "abc123" #U{"abc123"})))
(is (string= "abc123" #U"{"abc123"}")))
(test encoding2
(is (string= "abc%20123" #U{"abc 123"})))
(is (string= "abc%20123" #U"{"abc 123"}")))
(test decoding3
(is (string= "abc123" (uri-template-bind (#U{x}) "abc123" x))))
(is (string= "abc123" (uri-template-bind (#U"{x}") "abc123" x))))
(test decoding4
(is (string= "abc 123" (uri-template-bind (#U{x}) "abc%20123" x))))
(is (string= "abc 123" (uri-template-bind (#U"{x}") "abc%20123" x))))
(test unicode-encoding1
(is (string= "%D1%84%D0%BE%D0%BE" #U{"фоо"})))
(is (string= "%D1%84%D0%BE%D0%BE" #U"{"фоо"}")))
(test unicode-decoding2
(is (string= "бар"
(uri-template-bind (#U{x}) "%D0%B1%D0%B0%D1%80" x))))
(uri-template-bind (#U"{x}") "%D0%B1%D0%B0%D1%80" x))))
(test null-template
(is (string= #U "")))
(is (string= #U"" "")))
(test delimited-template-before-string-no-whitespace
(is (equal (list #U"/foobar""baz")
'("/foobar" "baz"))))
......@@ -23,28 +23,42 @@
(defun read-uri-template (stream &optional recursive-p)
"A function suitable for inserting into the readtable so you can
read URI templates from your own dispatch character."
(let ((*readtable* (copy-readtable))
(template-accumulator ())
(string-accumulator #1=(make-array 10
:element-type 'character
:adjustable t :fill-pointer 0))
(next-char))
(set-syntax-from-char #\} #\))
(flet ((collect-string ()
(when (< 0 (length string-accumulator))
(push string-accumulator template-accumulator)
(setf string-accumulator #1#))))
(loop until (member
(setf next-char (read-char stream nil #\Space recursive-p))
'(#\Space #\Newline #\Tab #\)))
do (if (char= #\{ next-char)
(progn (collect-string)
(push `(uri-encode
(progn ,@(read-delimited-list #\} stream)))
template-accumulator))
(vector-push-extend next-char string-accumulator))
finally (unread-char next-char stream) (collect-string))
(reverse template-accumulator))))
(flet ((make-acc (&optional (type 'character))
(make-array 0 :adjustable t :fill-pointer t
:element-type type)))
(let ((template (make-acc t))
(str-acc (make-acc)))
(flet ((collect-string ()
(when (< 0 (length str-acc))
(vector-push-extend str-acc template)
(setf str-acc (make-acc)))))
(multiple-value-bind (original1 original2)
(get-macro-character #\})
(unwind-protect
(progn
(set-syntax-from-char #\} #\))
(do ((next-char
(assert
(char= #\"
(read-char stream t nil recursive-p))
()
"URI template needs to be delimited with double quotation marks. For example: #U\"http://www.website.com/pages/{pagenum}\"")))
((char= #\"
(setf
next-char
(read-char stream t nil recursive-p)))
(collect-string))
(if (char= #\{ next-char)
(progn
(collect-string)
(vector-push-extend
`(uri-encode
(progn
,@(read-delimited-list #\} stream)))
template))
(vector-push-extend next-char str-acc))))
(set-macro-character #\} original1 original2))))
(coerce template 'list))))
(defmacro uri-encode (x)
(let ((x1 (gensym)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment