steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Support ; separator for query params, record raw-query

db4
Slava Pestov 2008-09-29 21:19:02 -05:00
parent ff48e56837
commit fd7b7511f5
4 changed files with 11 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/urls/encoding/encoding-tests.factor
View File

@ -21,6 +21,8 @@ USING: urls.encoding tools.test arrays kernel assocs present accessors ;
[ H{ { "a" { "b" "c" } } } ] [ "a=b&a=c" query>assoc ] unit-test [ H{ { "a" { "b" "c" } } } ] [ "a=b&a=c" query>assoc ] unit-test
[ H{ { "a" { "b" "c" } } } ] [ "a=b;a=c" query>assoc ] unit-test
[ H{ { "text" "hello world" } } ] [ "text=hello+world" query>assoc ] unit-test [ H{ { "text" "hello world" } } ] [ "text=hello+world" query>assoc ] unit-test
[ "a=3" ] [ { { "a" 3 } } assoc>query ] unit-test [ "a=3" ] [ { { "a" 3 } } assoc>query ] unit-test

2
basis/urls/encoding/encoding.factor
View File

@ -76,7 +76,7 @@ PRIVATE>
: query>assoc ( query -- assoc ) : query>assoc ( query -- assoc )
dup [ dup [
"&" split H{ } clone [ "&;" split H{ } clone [
[ [
[ "=" split1 [ dup [ query-decode ] when ] bi@ swap ] dip [ "=" split1 [ dup [ query-decode ] when ] bi@ swap ] dip
add-query-param add-query-param

5
basis/urls/urls-tests.factor
View File

@ -10,6 +10,7 @@ arrays kernel assocs present accessors ;
{ host "www.apple.com" } { host "www.apple.com" }
{ port 1234 } { port 1234 }
{ path "/a/path" } { path "/a/path" }
{ raw-query "a=b" }
{ query H{ { "a" "b" } } } { query H{ { "a" "b" } } }
{ anchor "foo" } { anchor "foo" }
} }
@ -20,6 +21,7 @@ arrays kernel assocs present accessors ;
{ protocol "http" } { protocol "http" }
{ host "www.apple.com" } { host "www.apple.com" }
{ path "/a/path" } { path "/a/path" }
{ raw-query "a=b" }
{ query H{ { "a" "b" } } } { query H{ { "a" "b" } } }
{ anchor "foo" } { anchor "foo" }
} }
@ -57,6 +59,7 @@ arrays kernel assocs present accessors ;
{ {
T{ url T{ url
{ path "bar" } { path "bar" }
{ raw-query "a=b" }
{ query H{ { "a" "b" } } } { query H{ { "a" "b" } } }
} }
"bar?a=b" "bar?a=b"
@ -210,6 +213,7 @@ urls [
T{ url T{ url
{ protocol "http" } { protocol "http" }
{ host "localhost" } { host "localhost" }
{ raw-query "foo=bar" }
{ query H{ { "foo" "bar" } } } { query H{ { "foo" "bar" } } }
{ path "/" } { path "/" }
} }
@ -220,6 +224,7 @@ urls [
T{ url T{ url
{ protocol "http" } { protocol "http" }
{ host "localhost" } { host "localhost" }
{ raw-query "foo=bar" }
{ query H{ { "foo" "bar" } } } { query H{ { "foo" "bar" } } }
{ path "/" } { path "/" }
} }

6
basis/urls/urls.factor
View File

@ -8,7 +8,7 @@ strings.parser lexer prettyprint.backend hashtables present
peg.ebnf urls.encoding ; peg.ebnf urls.encoding ;
IN: urls IN: urls
TUPLE: url protocol username password host port path query anchor ; TUPLE: url protocol username password host port path raw-query query anchor ;
: <url> ( -- url ) url new ; : <url> ( -- url ) url new ;
@ -47,7 +47,7 @@ protocol = [a-z]+ => [[ url-decode ]]
username = [^/:@#?]+ => [[ url-decode ]] username = [^/:@#?]+ => [[ url-decode ]]
password = [^/:@#?]+ => [[ url-decode ]] password = [^/:@#?]+ => [[ url-decode ]]
pathname = [^#?]+ => [[ url-decode ]] pathname = [^#?]+ => [[ url-decode ]]
query = [^#]+ => [[ query>assoc ]] query = [^#]+ => [[ >string ]]
anchor = .+ => [[ url-decode ]] anchor = .+ => [[ url-decode ]]
hostname = [^/#?]+ => [[ url-decode ]] hostname = [^/#?]+ => [[ url-decode ]]
@ -80,7 +80,7 @@ M: string >url
] [ f f f f f ] if* ] [ f f f f f ] if*
] ]
[ second ] ! pathname [ second ] ! pathname
[ third ] ! query [ third dup query>assoc ] ! query
[ fourth ] ! anchor [ fourth ] ! anchor
} cleave url boa } cleave url boa
dup host>> [ [ "/" or ] change-path ] when ; dup host>> [ [ "/" or ] change-path ] when ;