REBOL [
Title: "REBOL CGI Test Script"
Version: 0.0.2
Name: "CGI-Test"
File: %test.r
Date: 17-Jan-2005
Author: "Dirk Weyand"
E-Mail: "D.Weyand--TGD-Consulting--DE"
Owner: "TGD-Consulting"
Rights: "TGD-Consulting"
Home: http://www.TGD-Consulting.DE
Needs: "Serve-It! or any other webserver featuring REBOL CGI-Scripts."
Purpose: "REBOL Test CGI-Script for Serve-It!"
License: "Freeware as long as you give credit to the author"
Library: [
level: 'intermediate
platform: 'all
type: [tool]
domain: [cgi html web]
tested-under: [view 1.2.1.1.1 on "AmigaOS 68k"]
support: none
license: 'PD
see-also: "Serve-It!, at http://www.TGD-Consulting.de/Download.html"
]
]
emit-tbl-row: func [
{Prints HTML-table row to STDOUT.}
type [string!] "text of first column."
content [string!] "text of second column."
colors [block! unset!] "Colors of the columns."
/local row foo
][
if error? try [unset? colors] [colors: copy []]
row: copy {}
insert row content
if none? foo: pick colors 2 [foo: {"white"}]
insert row join {| "]
if none? foo: pick colors 1 [foo: {"white"}]
insert row join { | | } type { | }]
print row
]
; -- HTML-Document starts here ----------------------------------------------------------------------
print {
}
; -- Header-Rows ------------------------------------------------------------------------------------
emit-tbl-row {Serve-It! (© TGD-Consulting)
} join {Using: REBOL/} [system/product " " system/version "
Built: " system/build "
Script: " system/script/header/Version " " system/script/header/Date ""] []
emit-tbl-row "Server Data/Time:" form now [{"#C0C060"}]
emit-tbl-row "Current Dir:" form what-dir [{"#C0C060"}]
; -- Base-Rows --------------------------------------------------------------------------------------
foo: third system/options/cgi ; Werte des CGI-Objektes
until [ emit-tbl-row join form first foo ":" form second foo [{"#F0F080"}]
lesser-or-equal? length? foo: skip foo 2 2 ]
; -- HTTP-Header Rows -------------------------------------------------------------------------------
either empty? foo: last foo [
emit-tbl-row form "other-headers" form foo [{"#F0C080"}]
][
headers: copy []
until [ insert/only headers reduce [uppercase form pick foo 1 form pick foo 2]
tail? foo: skip foo 2 ]
sort headers
foreach foo headers [
emit-tbl-row join "HTTP_" [first foo ":"] second foo [{"#F0C080"}]
]
]
; -- End of HTML-Document ---------------------------------------------------------------------------
print {
}
;halt