{ $description "Decodes a URL-encoded string." } ;
HELP: url-encode
-{ $values { "str" string } { "encoded" string } }
+{ $values { "obj" object } { "encoded" string } }
{ $description "URL-encodes a string, excluding certain characters, such as \"/\"." } ;
HELP: url-encode-full
-{ $values { "str" string } { "encoded" string } }
+{ $values { "obj" object } { "encoded" string } }
{ $description "URL-encodes a string, including all reserved characters, such as \"/\"." } ;
HELP: url-quotable?
{ ":foo" } [ ":foo" url-encode ] unit-test
{ "%3Afoo" } [ ":foo" url-encode-full ] unit-test
+{ "%01%02%03ABC" } [ B{ 1 2 3 65 66 67 } url-encode ] unit-test
+{ "%01%02%03ABC" } [ B{ 1 2 3 65 66 67 } url-encode-full ] unit-test
+
{ "hello world" } [ "hello+world" query-decode ] unit-test
{ "\u001234hi\u002045" } [ "\u001234hi\u002045" url-encode url-decode ] unit-test
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays ascii assocs combinators combinators.short-circuit
-fry io.encodings.string io.encodings.utf8 kernel linked-assocs
-make math math.parser present sequences splitting strings ;
+USING: arrays ascii assocs byte-arrays combinators
+combinators.short-circuit fry io.encodings.string
+io.encodings.utf8 kernel linked-assocs make math math.parser
+present sequences splitting strings ;
IN: urls.encoding
: url-quotable? ( ch -- ? )
<PRIVATE
+: hex% ( n -- )
+ CHAR: % , >hex >upper 2 CHAR: 0 pad-head % ;
+
: push-utf8 ( ch -- )
- 1string utf8 encode
- [ CHAR: % , >hex >upper 2 CHAR: 0 pad-head % ] each ;
+ 1string utf8 encode [ hex% ] each ;
: (url-encode) ( str quot: ( ch -- ? ) -- encoded )
- '[ [ dup @ [ , ] [ push-utf8 ] if ] each ] "" make ; inline
+ [
+ over byte-array? [
+ '[ dup @ [ , ] [ hex% ] if ] each
+ ] [
+ [ present ] dip
+ '[ dup @ [ , ] [ push-utf8 ] if ] each
+ ] if
+ ] "" make ; inline
PRIVATE>
-: url-encode ( str -- encoded )
+: url-encode ( obj -- encoded )
[ url-quotable? ] (url-encode) ;
-: url-encode-full ( str -- encoded )
+: url-encode-full ( obj -- encoded )
[ unreserved? ] (url-encode) ;
<PRIVATE
[
[ url-encode-full ] dip [
dup array? [ 1array ] unless
- [ present url-encode-full "=" glue , ] with each
+ [ url-encode-full "=" glue , ] with each
] [ , ] if*
] assoc-each
] { } make "&" join ;