[REBOL] Re: html post
From: brett:codeconscious at: 8-Aug-2002 23:15
I wrote,
> My playing around required .. :^)
Well I've done my playing and got some promising results - YMMV. What I did
is below the cut-line. It would need far more coding to get a production
quality script.
Regards,
Brett.
---------------------8<--------------------------------
#!e:/program files/rebol/core/rebol -cs
REBOL [
Title: "A sample HTML form decode script"
Comment: {
This script is an example only. There is no error handling,
it is not properly tested and is missing lots of logic.
In other words, do not use for production. Use it only
on a local test server. And don't blame me :)
}
Author: {Brett Handley}
Date: 8-Aug-2002
]
;******************************************************
; A MIME function I dug out of another script.
;******************************************************
; This could possibly be a simpler parse expression - but since
; I already had it lying around here it is.
mime-body-parts?: function [[catch]
"The separate parts of multipart mime content."
content [string! binary!]
boundary [string!]
line-terminator [string!] "The line terminator - either CRLF or
newline."
] [
normal-delimiter close-delimiter
prologue epilogue
msg-part parse-result
message-part-pattern
return-block
] [
; Get the parts
return-block: make block! 2
normal-delimiter: rejoin [line-terminator "--" boundary]
close-delimiter: rejoin [line-terminator "--" boundary "--"]
message-part-pattern: [
line-terminator copy msg-part [to normal-delimiter | to
close-delimiter]
(append return-block msg-part)
]
parse-result: parse/all content [
(epilogue: prologue: none)
[
"--" boundary message-part-pattern |
copy prologue to normal-delimiter
]
some [
close-delimiter copy epilogue to end |
normal-delimiter message-part-pattern
]
end
]
if not parse-result [throw make error! "Error: Assumption failed while
parsing parts."]
RETURN return-block
]
;******************************************************
; Begin the HTML response
;******************************************************
print "Pragma: no-cache"
print "Content-type: text/html^m^j"
print {<META HTTP-EQUIV="Pragma" CONTENT="no-cache">}
print {<META HTTP-EQUIV="Expires" CONTENT="0">}
print "<HTML><BODY><PRE>"
print join "<h3>TEST at " [now "</h3>"]
print mold what-dir
;******************************************************
; Determine content-type
;******************************************************
tmp: parse/all system/options/cgi/content-type ";"
content-type: first tmp
;******************************************************
; Get boundary
;******************************************************
repeat param next tmp [
if find param {boundary=} [
boundary: second parse/all trim/head/tail param "="
break
]
]
;******************************************************
;Get Content - Using Gabriele's example
;******************************************************
content-length: to-integer system/options/cgi/content-length
set-modes system/ports/input [binary: true no-wait: true]
content: copy system/ports/input
while [content-length > length? content] [
print "Wait for content..."
wait system/ports/input
insert tail content copy system/ports/input
]
;******************************************************
; Seperate the parts of the multipart form and
; output a rebol representation of them.
; PARSE-HEADER is already built in to REBOL - whole
; content string ends up in CONTENT field of object.
; Converts content to binary unless it is text. Text is
; typically sent across networks using CRLF lineending,
; so here I replace it with REBOL's newline convention.
; Note that REPLACE might be slow.
;******************************************************
parts: mime-body-parts? content boundary CRLF
repeat part parts [
result: copy []
msg: parse-header none part
either all [
in msg 'content-type
not find/match msg/content-type {text}
found? content
] [msg/content: to-binary msg/content] [
msg/content: replace/all CRLF newline
]
probe msg
]
;******************************************************
; Finish off the output
;******************************************************
print "</PRE></BODY></HTML>"
QUIT
