urls.encoding: Add some javascript encoding words.

diff --git a/basis/urls/encoding/encoding-tests.factor b/basis/urls/encoding/encoding-tests.factor
index bdb41cc97962a9102e9b6d8f374c273b90bac0f6..16bf78e201b116eafbcbba655c01e7561924aa92 100644 (file)
--- a/basis/urls/encoding/encoding-tests.factor
+++ b/basis/urls/encoding/encoding-tests.factor
@@ -1,5 +1,4 @@
-USING: urls.encoding tools.test arrays kernel assocs present
-accessors linked-assocs ;
+USING: kernel linked-assocs sequences tools.test urls.encoding ;
 
 { "~hello world" } [ "%7ehello world" url-decode ] unit-test
 { "" } [ "%XX%XX%XX" url-decode ] unit-test
@@ -43,3 +42,8 @@ accessors linked-assocs ;
 { "a" } [ { { "a" f } } assoc>query ] unit-test
 
 { LH{ { "a" f } } } [ "a" query>assoc ] unit-test
+
+{ t } [ "?x=test" [ encode-uri decode-uri ] keep sequence= ] unit-test
+{ t } [ "шеллы" [ encode-uri decode-uri ] keep sequence= ] unit-test
+{ t } [ "?x=test" [ encode-uri-component decode-uri-component ] keep sequence= ] unit-test
+{ t } [ "шеллы" [ encode-uri-component decode-uri-component ] keep sequence= ] unit-test
\ No newline at end of file

diff --git a/basis/urls/encoding/encoding.factor b/basis/urls/encoding/encoding.factor
index 7927fd83aabb17f00178e57d3a1ba3c698efe01d..f64c4404068e864e604296d0e3a7529a06f5e387 100644 (file)
--- a/basis/urls/encoding/encoding.factor
+++ b/basis/urls/encoding/encoding.factor
@@ -79,16 +79,6 @@ PRIVATE>
         ] if url-decode-iter
     ] if ;
 
-PRIVATE>
-
-: url-decode ( str -- decoded )
-    [ 0 swap url-decode-iter ] "" make utf8 decode ;
-
-: query-decode ( str -- decoded )
-    "+" split "%20" join url-decode ;
-
-<PRIVATE
-
 : add-query-param ( value key assoc -- )
     [
         {
@@ -100,6 +90,61 @@ PRIVATE>
 
 PRIVATE>
 
+: escape-uri-component-char? ( ch -- ? )
+    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_.!~*'()" member? not ; inline
+
+: encode-uri-component ( str -- str' )
+    [
+        [ dup escape-uri-component-char? [ push-utf8 ] [ , ] if ] each
+    ] "" make ;
+
+: escape-uri-char? ( ch -- ? )
+    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789;,/?:@&=+$-_.!~*'()#" member? not ; inline
+
+: encode-uri ( str -- str' )
+    [
+        [ dup escape-uri-char? [ push-utf8 ] [ , ] if ] each
+    ] "" make ;
+
+<PRIVATE
+
+: decode-uri-hex ( index str quot: ( ch -- ? ) -- )
+    '[
+        2dup length 2 - >= [
+            2drop
+        ] [
+            [ 1 + dup 2 + ] dip subseq
+            dup hex> dup @ [ nip , ] [ CHAR: % , drop % ] if
+        ] if
+    ] call ; inline
+
+: decode-uri-iter ( index str quot: ( ch -- ? ) -- )
+    dup '[
+        2dup length >= [
+            2drop
+        ] [
+            2dup nth dup CHAR: % = [
+                drop 2dup _ decode-uri-hex [ 3 + ] dip
+            ] [
+                , [ 1 + ] dip
+            ] if _ decode-uri-iter
+        ] if
+    ] call ; inline recursive
+
+PRIVATE>
+
+: decode-uri-component ( str -- decoded )
+    [ 0 swap [ escape-uri-component-char? ] decode-uri-iter ] "" make utf8 decode ;
+
+: decode-uri ( str -- decoded )
+    [ 0 swap [ escape-uri-char? ] decode-uri-iter ] "" make utf8 decode ;
+
+: url-decode ( str -- decoded )
+    [ 0 swap url-decode-iter ] "" make utf8 decode ;
+
+: query-decode ( str -- decoded )
+    "+" split "%20" join url-decode ;
+
 : query>assoc ( query -- assoc )
     dup [
         "&;" split <linked-hash> [