Scripts
AI
Animation
CGI
Compression
Console
Database
Debug
Dialects
Dialogs
Editor
Email
Encryption
Extension
External Library
File
File Handling
Files
Financial
FTP
Game
Games
Graphics
GUI
HTML
HTTP
Internet
LDC
Markup
Math
Module
Network
Networking
None
Other - Net
Parse
Patch
Printing
Protocol
Rebol
Scheme
Scientific
SDK
Security
Shell
Sound
SQL
TCP
Testing
Text
Text Processing
UI
User Interface
Util
Utility
VID
Visualization
Web
Win API
X-File
XML
Wiki
; (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