; (TGD) ; #!../rebol -cs
REBOL [
Title: "RBBS - REBOL Bulletin Board Tutorial"
File: %rbbs.r ; (TGD) ;
Version: 1.0.0
Created: 14-Nov-2004
Date: 25-Jan-2005
Author: [
"Carl Sassenrath"
"Gregg Irwin"
"Volker Nitsch"
"Tom Conlin"
]
Copyright: "REBOL Technologies"
License: "BSD (www.opensource.org/licenses/bsd-license.php)"
Web: http://www.rebol.com/docs/cgi-bbs.html
Note: "Go to the above URL for the tutorial document."
Purpose: "A CGI Web Bulletin Board / Message Board" ; (TGD) ;
Needs: "Serve-It! or any other webserver featuring REBOL CGI-Scripts." ; (TGD) ;
Library: [ ; (TGD) ;
level: 'intermediate
platform: 'all
type: [tool]
domain: [cgi html http]
tested-under: [view 1.2.1.1.1 on "AmigaOS" view 1.2.1.3.1 on "Windows 2000"]
support: none
license: 'BSD
see-also: "Serve-It!, at http://www.TGD-Consulting.de/Download.html"
]
]
; (TGD) ; Modified by Dirk Weyand to work smoothly with Serve-It!,
; (TGD) ; the smart server-engine based on REBOL/View.
; (TGD) ; All modifications of the original script are marked with ; (TGD) ;
; (TGD) ; Download Serve-It! @ http://www.TGD-Consulting.de/Download.html#reblets
; (TGD) ; print "content-type: text/html^/"
;-- Configuration Settings ---------------------------------------------------
config: context [
title: "Simple REBOL Message Board"
cgi-path: %/cgi-bin/rbbs.r
base-dir: %../rbbs/ ; (TGD) ; Document-Root
topic-id: join base-dir %id.r
topic-db: join base-dir %topics.db
msg-dir: join base-dir %messages/
html-template: join base-dir %template.html
html-form: join base-dir %form.html
max-days: 60 ; delete msgs older than this if...
max-msgs: 100 ; max messages is reached.
msg-order: none ; or 'new-first for reverse order
tags-allowed: [
]
]
if not exists? config/msg-dir [make-dir/deep config/msg-dir]
;-- Various Utility Functions ------------------------------------------------
abort: false ; (TGD) ; quit or halt shutdowns REBOL based Servers
attempt: func [ ; (TGD) ; function not implemented in REBOL/View 1.2.1.1.1
{Tries to evaluate and returns result or NONE on error.}
value][
if not error? set/any 'value try :value [get/any 'value]]
remove-each: func [ ; (TGD) ; function not implemented in REBOL/View 1.2.1.1.1
{Removes a value from a series for each block that returns TRUE.}
'word [get-word! word! block!] {Word or block of words to set each time (will be local)}
data [series!] "The series to traverse"
body [block!] "Block to evaluate. Return TRUE to remove."
][
while [not tail? data] [
set word first data
either do body [remove data] [data: next data]
]
unset word
]
build-tag: func [ ; (TGD) ; fixed version of function implemented in REBOL/View 1.2.1.1.1
"Generates a tag from a composed block."
values [block!] "Block of parens to evaluate and other data."
/local tag value-rule xml? name attribute value
][
tag: make string! 7 * length? values
value-rule: [
set value issue! (value: mold value)
| set value file! (value: replace/all copy value #" " " ")
| set value any-type!
]
xml?: false
parse compose values [
[
set name ['?xml (xml?: true) | word!] (append tag name)
any [
set attribute [word! | url!] value-rule (
repend tag [#" " attribute {="} value {"}]
)
| value-rule (repend tag [#" " value])
]
end (if xml? [append tag #"?"])
]
|
[set name refinement! to end (tag: mold name)]
]
to tag! tag
]
seconds: func [ ; (TGD) ; difference function in REBOL/View 1.2.1.1.1 doesn´t support date!
"Compute difference between dates in seconds."
a [date!] "first date"
b [date!] "second date"
] [
b - a * 86400 + (to decimal! b/time) - (to decimal! a/time) + (a/zone/hour - b/zone/hour * 3600)
]
; If not in CGI environment, set Test-Mode.
test-mode: not system/options/cgi/request-method
system/options/binary-base: 64
html: make string! 5000
emit: func [data] [append repend html data newline]
href: func [data] [build-tag [a href (reduce data)]] ; href [name ".txt"]
encode-html: func [
"Make HTML tags into HTML viewable escapes (for posting code)"
text
][
foreach [from to] ["&" "&" "<" "<" ">" ">"] [
replace/all text from to
]
]
;-- Nicely Format the Date ---------------------------------------------------
nice-date: func [
"Convert date/time to a friendly format."
date [date!]
/local n day time diff
][
n: now
time: date/time
diff: n/date - date/date
if not day: any [
if diff < 2 [
time: to time! seconds date n
; TGD ; time: difference n date
time/3: 0
return reform [time "hrs ago"]
]
if diff < 7 [pick system/locale/days date/weekday]
][
day: form date/date
if n/date/year = date/date/year [clear find/last day #"-"]
]
join day [
time " ET"]
]
;-- Read CGI Request ---------------------------------------------------------
read-cgi: func [
"Read CGI data. Return data as string or NONE."
/limit size "Limit to this number of bytes"
/local data buffer
][
if none? limit [size: 300000]
switch system/options/cgi/request-method [
"POST" [data: system/script/args] ; (TGD) ; Serve-It! liefert POST-Data
; (TGD) ; per system/script/args an das CGI-script
; (TGD) ; "POST" [
; (TGD) ; data: make string! 1020
; (TGD) ; buffer: make string! 16380
; (TGD) ; while [positive? read-io system/ports/input buffer 16380][
; (TGD) ; append data buffer
; (TGD) ; clear buffer
; (TGD) ; if (length? data) > size [
; (TGD) ; print ["aborted - posting is too long:"
; (TGD) ; length? data "limit:" size]
; (TGD) ; quit
; (TGD) ; ]
; (TGD) ; ]
; (TGD) ; ]
"GET" [data: system/options/cgi/query-string]
]
any [data ""] ; (TGD) ;
]
;-- Read HTML File Body ------------------------------------------------------
read-body: func [
"Extract the body contents of an HTML file."
html [file!]
][
html: read html
remove/part html find/tail find html ""
clear find html