REBOL [
Title: "REBOL <-> Web Form"
Author: "Christopher Ross-Gill"
Date: 18-Nov-2009
Name: altwebform
Version: 0.9.1
Purpose: "Convert a Rebol block to a URL-Encoded Web Form string"
Comment: "Conforms to application/x-www-form-urlencoded"
File: %altwebform.r
Type: 'module
Exports: [load-webform to-webform]
Example: [
"a=3&aa.a=1&b.c=1&b.c=2"
[a "3" aa [a "1"] b [c ["1" "2"]]]
]
]
load-webform: use [result path string pair as-path url-decode][
result: copy []
as-path: func [name [string!]][to-path to-block replace/all name #"." #" "]
url-decode: use [deplus dehex decrlf][
deplus: func [text][
parse/all text [any [to #"+" change #"+" #" "] to end]
text
]
dehex: use [hx ch][
hx: charset [#"0" - #"9" #"a" - #"f" #"A" - #"F"]
func [text][
parse/all text: to-binary text [
any [
to #"%" remove [#"%" copy ch 2 hx]
(ch: debase/base ch 16) insert ch
] to end
]
to-string text
]
]
decrlf: func [text][
parse/all text [any [to crlf remove cr] to end]
text
]
func [text [any-string! none!]][
decrlf dehex deplus either text [to-string text][""]
]
]
path: use [aa an wd][
aa: charset [#"A" - #"Z" #"a" - #"z"]
an: charset [#"-" #"0" - #"9" #"A" - #"Z" #"-" #"a" - #"z"]
wd: [aa 0 40 an] ; one alpha, any alpha/numeric/dash/underscore
[wd 0 6 [#"." wd]]
]
string: use [ch hx][
ch: charset ["-." #"0" - #"9" #"A" - #"Z" #"-" #"a" - #"z" #"~"]
hx: charset [#"0" - #"9" #"a" - #"f" #"A" - #"F"]
[any [ch | #"+" | #"%" 2 hx]] ; any [unreserved | percent-encoded]
]
pair: use [name value tree][
[
copy name path #"=" copy value string [#"&" | end]
(
tree: :result
name: as-path name
value: url-decode value
until [
tree: any [
find/tail tree name/1
insert tail tree name/1
]
name: next name
switch type?/word tree/1 [
none! [unless tail? name [insert/only tree tree: copy []]]
string! [change/only tree tree: reduce [tree/1]]
block! [tree: tree/1]
]
if tail? name [append tree value]
]
)
]
]
func [
[catch] "Loads Data from a URL-Encoded Web Form string"
webform [string! none!]
][
webform: any [webform ""]
result: copy []
either parse/all webform [opt #"&" any pair][result][
make error! "Not a URL Encoded Web Form"
]
]
]
to-webform: use [
webform url-encode form-key emit
here path value block array object
][
path: []
form-key: does [
remove head foreach key path [insert "" reduce ["." key]]
]
emit: func [data][
repend webform ["&" form-key "=" url-encode data]
]
url-encode: use [ch mk][
ch: charset ["-." #"0" - #"9" #"A" - #"Z" #"-" #"a" - #"z" #"~"]
func [text [any-string!]][
either parse/all text: copy to-binary text [
any [
some ch | end | change " " "+" |
mk: (mk: join "%" back back tail to-hex mk/1 16)
change skip mk
]
][to-string text][""]
]
]
value: [
here: number! (emit form here/1)
| [logic! | 'true | 'false] (emit form here/1)
| [none! | 'none]
| date! (replace form date "/" "T")
| [any-string! | tuple! | money! | time!] (emit form here/1)
]
array: [any value end]
object: [
any [
here: [word! | set-word!] (insert path to-word here/1)
[value | block] (remove path)
] end
]
block: [
here: [
and any-block! (change/only here copy here/1)
| and object! (change/only here to-block here/1)
] into [object | mk: array]
]
func [
"Serializes block data as URL-Encoded Web Form string"
data [block! object!]
][
clear path
webform: copy ""
data: either object? data [to-block data][copy data]
if parse copy data object [to-string remove webform]
]
]