REBOL [
title: "Forum"
date: 16-May-2010
file: %forum.r
author: Nick Antonaccio
purpose: {
A CGI forum application, running at http://rebolforum.com.
Please link to it, so that new REBOLers have a place to ask questions!
}
]
#!./rebol276 -cs
REBOL []
print {content-type: text/html^/}
switch system/options/cgi/request-method [
"POST" [
cgi-data: copy "" cgi-buffer: copy ""
while [positive? read-io system/ports/input cgi-buffer 16380] [
append cgi-data cgi-buffer clear cgi-buffer
]
]
"GET" [cgi-data: system/options/cgi/query-string]
]
submitted: decode-cgi cgi-data
if submitted/2 = "rss" [
write/append %bb.db ""
bbs: load %bb.db
reverse bbs
stickycount: 0
foreach topic bbs [foreach item topic [if find item {STICKY:} [stickycount: stickycount + 1]]]
print trim {
REBOL Forum
Recent REBOL Forum Topics
http://rebolforum.com
}
count: 1
foreach item (at bbs (stickycount + 1)) [
rss-title: copy item/1
rss-title: replace/all rss-title {&} {&}
rss-title: replace/all rss-title {"} {"}
rss-title: replace/all rss-title {'} {'}
rss-title: replace/all rss-title {<} {<}
rss-title: replace/all rss-title {>} {>}
rss-description: rejoin [
(copy/part (pick item ((length? item) - 2)) 200)
", Posted by: " (pick item ((length? item) - 1))
" " (pick item (length? item))
]
rss-description: replace/all rss-description {&} {&}
rss-description: replace/all rss-description {"} {"}
rss-description: replace/all rss-description {'} {'}
rss-description: replace/all rss-description {<} {<}
rss-description: replace/all rss-description {>} {>}
print trim rejoin [
{-
} rss-title {
} rss-description {
http://rebolforum.com/index.cgi?f=printtopic&topicnumber=}
((length? bbs) + 1 - count - stickycount) {&archiveflag=new
}
]
count: count + 1
if count > 10 [break]
]
print trim {
}
quit
]
print {REBOL Forum
}
unless exists? %index.html [
write %index.html {}
]
if submitted/2 = "downloadreader" [
print trim/lines {
Home
(Open the REBOL console and "do" this page URL)
}
print decompress #{
789CC5544B8BDB3010BEFB570C82425C70B4CE52167C6B69F7B4A5901E430EB2
3DD9A8B525571AC7D996FEF74AF2234EB2DBC7A9821069E69BC7F78DA5F58777
9F1E6043922ACC80ADC3F15E9BB686358A120DDB46912D0CA2CAC03E59C29A1F
2476BCB7253B5120B7F23B4202E9CDCDD1FD22D28D2C6C06856E9E60B3052805
895C589C4C51D436CEE80CA5460B9B08DCBA080BB68BC84A8BD2E1929DAC100C
7E6BD15238F04080FB6D88F38B3D78F447B4563CA2CD183006AF0CE6BADA797E
4B3A52C0BA138A62DFD79F2A0E4DF9259A065539F4073B692CF58780E81BA594
FBC8A1CF1E1A1C76AF3BE70D7B9172C2230DA01F3F4F0091464E142F2C14A808
4D10162AF1A45B1A5A092A2F7ADDE33E5F61B4B543FD0C7CEEA492AEBBC542D8
A411D2C0C2E856959CF418C953780DCBD59B18D278B2ADE2D8CD6F757BBCBB8D
830223D99308F5A863DF3C639367D46F334040891A81648D5B58080297E8EB49
562754A10856F12CF74CE4B18C9BEE172DD50568D60828EC2AA966FFBE2A7363
0FA52FDD576958F277CB65FC5DAA6D74BD3B1FF3C868728F033F0509373CE144
84CE88E6CFC3BB7B7978219D416A8D0ADB9C14B0F7BA53E1E6ACD17F5CD39560
33753B23099FBF5A561C9EBD5F41C5CFCE392574F170EF202FDFB57139B225EC
899A8CF319ACD035CFF36599CFC439A7F0D6147B79C0F23F9048445FFB5FC88C
21D78CFCEB0A23AD733EFDDBE8DECD68FB0BE01DA7BF9F050000
}
print {}
print footer
quit
]
if submitted/2 = "api" [
print {}
print decompress #{
789CB5503D0BC23010DDFB2B8E0E3A15F74217C14E82E01A3AC4F62A912629F9
4044FADF4DD3D8D6A238883784BCBB07EFE3B8DB1EF6400C330DA6101F3DCCA5
B21C722B4AC3A4D0711145B4AA14EAD62147ABDD0548DDB312AB1A187E46B6AC
14969F50858DD5A804E5182047ADE9190B2010811B7E4B5AA94D0A0A2F920920
7EDBCFBD0EDAD94CB79BCEAB9956D6BDD19F517B032367743423045B232760CF
28FCAB90569BD26A23394CA91556B64420EB3EC4334C110D6509BC7EEA69D18A
B7FD5B434EACFB967859DE6B6D7FEDE30149C2C94C64020000
}
print {}
print footer
quit
]
if submitted/2 = "source" [
print trim/lines {
Home
(Open the REBOL console and "do" this page URL)
}
prin {REBOL [] editor decompress }
print compress read %index.cgi
print
print footer
quit
]
write/append %archive.db ""
write/append %bb.db ""
bbs: load %bb.db
displaylength: 49
captchacheck: does [
if submitted/10 <> (trim/all submitted/12) [
print {Incorrect Captcha Text
Click the [BACK] button in your browser to try again.
Home
}
print footer
quit
]
]
random/seed now/time password: copy [] wrds: first system/words
foreach ch mold pick wrds (random length? wrds) [append password ch]
if submitted/2 = "addnew" [
if (submitted/4 = "") or (submitted/6 = "") or (submitted/8 = "") [
print {
Incomplete submission
Click the [BACK] button in your browser to try again.
Home
}
print footer
quit
]
captchacheck
make-dir %./history/
save rejoin [
%./history/ now/year "_" now/month "_" now/day "_"
(replace/all form now/time ":" "_") ".db"
] bbs
entry: copy []
append entry submitted/6 ; topic
submitted-message: replace/all submitted/8 {REBOL [} {R E B O L [}
submitted-message: replace/all submitted-message {REBOL[} {R E B O L [}
append entry submitted-message ; message
append entry submitted/4 ; name
append entry form (now + 3:00)
append/only tail bbs entry
if (length? bbs) > displaylength [
write/append %archive.db mold bbs/1
remove head bbs
]
reverse bbs
foreach topic (copy bbs) [
foreach item topic [
if find item {STICKY:} [
move/to (find/only bbs topic) 1
]
]
]
reverse bbs
save %bb.db bbs
print {New Topic Added}
print footer
wait :00:02
print {}
quit
]
if submitted/2 = "printtopic" [
if submitted/6 = "archive" [bbs: load %archive.db]
current-topic: copy pick bbs (to-integer submitted/4)
print rejoin [
{Home
Archive
} (current-topic/1) {
}
]
foreach [message name timestamp] (at current-topic 2) [
replace/all message newline {
}
message2: copy message
append message { }
replace/all message2 { } { }
parse/all message [any [thru "http://" copy link to { } (replace message2 (rejoin [{http://} link]) (rejoin [{ http://} link { }]))] to end]
print rejoin [
message2 {
posted by: }
name { }
timestamp {
}
]
]
if submitted/6 = "new" [
print rejoin [
{ |
| Home |
}
]
]
print footer
quit
]
if submitted/2 = "search" [
print {Home
}
search-all: does [
foreach topic bbs [
foreach [message name timestamp] (at topic 2) [
if any [(find message submitted/4) (find name submitted/4)] [
replace/all message newline {
}
message2: copy message
append message { }
replace/all message2 { } { }
parse/all message [any [thru "http://" copy link to { } (replace message2 (rejoin [{http://} link]) (rejoin [{ http://} link { }]))] to end]
print rejoin [
{} archive-note topic/1 {
}
message2 {
posted by: }
name { }
timestamp {
}
]
]
]
]
]
archive-note: "" search-all
bbs: load %archive.db archive-note: {(Archive) } search-all
print footer
quit
]
if submitted/2 = "addresponse" [
if (submitted/6 = "") or (submitted/8 = "") [
print {
Incomplete submission.
Click the [BACK] button in your browser to try again.
Home
}
print footer
quit
]
captchacheck
save rejoin [
%./history/ now/year "_" now/month "_" now/day "_"
(replace/all form now/time ":" "_") ".db"
] bbs
topicnumber: to-integer submitted/4 ; topic number
submitted-message: replace/all submitted/8 {REBOL [} {R E B O L [}
submitted-message: replace/all submitted-message {REBOL[} {R E B O L [}
append bbs/:topicnumber submitted-message ; message
append bbs/:topicnumber submitted/6 ; name
append bbs/:topicnumber form (now + 3:00)
move/to (at bbs topicnumber) (length? bbs) ; sort messages by most recent
responded-topic: (first last bbs)
reverse bbs ; move sticky messages to top
foreach topic (copy bbs) [
foreach item topic [
if find item {STICKY:} [
move/to (find/only bbs topic) 1
]
]
]
reverse bbs
save %bb.db bbs
print rejoin [{Response added to "} responded-topic {"}]
print footer
wait :00:03
print {}
quit
]
either submitted/2 = "printarchive" [
archiveflag: "archive"
bbs: load %archive.db
head-text: "Archive"
] [
archiveflag: "new"
head-text: "REBOL Forum"
]
print rejoin [{
} head-text {
}]
counter: 1
reverse bbs
foreach bb bbs [
print rejoin [
{| } bb/1
{ | } ((length? bb) - 1 / 3)
{ | } (last bb)
{, } pick bb ((length? bb) - 1) { |
}
]
counter: counter + 1
if counter > displaylength [break]
]
message-count: 0
try [foreach record bbs [
message-count: message-count + ((length? record) - 1 / 3)
]]
either submitted/2 <> "printarchive" [
print rejoin [
{| ARCHIVED MESSAGES | }
{} message-count { active messages |
}
]
] [
print rejoin [
{ } message-count { archived messages | }
{ Home | }
]
]
print rejoin [{
}]
print footer
quit