#!/usr/bin/perl
##########################################################
# ForumScript.co.uk 04/12/2004
# © 1999-2004 ForumScript.co.uk
# Script Updated for ForumScript.co.uk by Babelnotes.be
##########################################################
# Instructions: http://www.ForumScript.co.uk/instructions/
# FAQ: http://www.ForumScript.co.uk/faq/
##########################################################
my $ScriptName = "forumscript.pl";
my $Password = "password";
my $ForumData = 'forumscript.txt';
my $template = 'template.htm';
my $token = '@#@#@';
##########################################################
# Table Settings
my $TableBorder = '#000000';
my $TableHeadColor = '#000000';
my $MessageViewTableWidth = '100%';
my $CellSpacing = '1';
my $CellPadding = '3';
my $MessTitleFont = "Verdana";
my $MessTitleFontsize = 1;
my $MessTitleFontcolor = "#FFFFFF";
##########################################################
# Font Settings
my $MessFont = "Verdana";
my $MessFontsize = 1;
my $MessThreadFontSize = 2;
my $MessFontcolor = "#000000";
##########################################################
# Cell Colours
my $MainPageColorDark = '#FFEAD5';
my $MainPageColorLight = '#F0FFF0';
my $ThreadPageColorDark = '#FFEAD5';
my $ThreadPageColorLight = '#F0FFF0';
##########################################################
# Reply and Thread link Format
my $BottomFont = "Verdana";
my $BottomFontSize = "1";
my $BottomFontColor = "#000000";
##########################################################
# Message Form Settings
my $MaxLengthMessage = 3000;
my $ROWS = 10;
my $COLS = 60;
my $MaxNameChars = 10;
my $MaxSubjectChars = 58;
##########################################################
# Miscellaneous Settings
my $language = "EN";
my $MaxMessagesPerThread = 100;
my $WrapIE ='SOFT';
my $Wrap = 0;
##################################################################################
# ForumScript.co.uk © 1999 - 2004 Copyright #
# The scripts are available for private and commercial use. #
# You can use the scripts in any website you build. #
# It is prohibited to sell the scripts in any format to anybody. #
# The scripts may only be distributed by ForumScript.co.uk #
# The redistribution of modified versions of the scripts is prohibited. #
# ForumScript.co.uk accepts no responsibility or liability #
# whatsoever for any damages however caused when using our services or scripts. #
# By downloading and using this script you agree to the terms and conditions. #
##################################################################################
$DefaulPassword="";
open (TEMPLATE, "< $template") or die print "$MESS{'IO_ERROR'} ($template)";
@templ = ;
close (TEMPLATE);
$token_len = length($token);
$tmpl_cont = join('', @templ); $tmpl_len = length($tmpl_cont);
$forpos = index($tmpl_cont, $token);
$header = substr($tmpl_cont, 0, $forpos);
$footer = substr($tmpl_cont, $forpos+$token_len , $tmpl_len - $forpos -1);
#######################################################################
language();
if ($ENV{'REQUEST_METHOD'} eq 'GET') { $buffer = $ENV{'QUERY_STRING'} }
else { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}) }
$delimiter = '\|';
@querylist = split(m'&', $buffer);
for $i (@querylist) {
($key,$value) = split(/=/, $i);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/\/\>\;/gi;
$value =~ s///g;
$value =~ s/<([^>]|\n)*>//g;
$value =~ s/\r//g;
$value =~ s/$delimiter/I/g; # changed. check for problems
if ($key eq "onderwerp") {$value =~ s/[%=&\"\'\+\*\^\$\(\)\[\]\{\}\|\\\#]/_/eg }
$in{$key} = $value;
}
print "Content-type: text/html\n\n";
if ($in{'todo'} eq "Preview") { Preview() }
if ($in{'admin'} eq "1") { &Pass }
elsif ($in{'todo'} eq "NieuwOnderwerp") { NieuwOnderwerp() }
elsif ($in{'todo'} eq "PostingPlaatsen") { PostingPlaatsen() }
elsif ($in{'todo'} eq "BekijkOnderwerp") { BekijkOnderwerp() }
elsif ($in{'todo'} eq "Bijdrage") { Bijdrage() }
elsif ($in{'todo'} eq "EditBijdrage") { EditBijdrage() }
elsif ($in{'todo'} eq "EditBijdrageOK") { if ($Password eq $in{'TheWord'}) { &EditBijdrageOK } }
elsif ($in{'todo'} eq "EditBijdrageSave") { EditBijdrageSave() }
elsif ($in{'todo'} eq "DeleteBijdrage") { DeleteBijdrage() }
elsif ($in{'todo'} eq "DeleteBijdrageOK") { if ($Password eq $in{'TheWord'}) { &DeleteBijdrageOK } }
elsif ($in{'todo'} eq "VerwijderDiscussie") { &VerwijderDiscussie}
elsif ($in{'todo'} eq "VerwijderDiscussieOK") { if ($Password eq $in{'TheWord'}) { &VerwijderDiscussieOK } }
else { PrintOnderwerpen() }
############################## HELPER SUBS ############################
sub WrapLongLines
{
($input) = @_;
if ($Wrap)
{
my @ber = split(/
/, $input);
my $line;
my $part;
my @bericht;
foreach $line(@ber)
{
while (length($line) > $COLS+2)
{
$part = substr($line, 0, $COLS+2);
$part .= '
';
push(@bericht, $part);
$line = substr($line, $COLS+2);
}
$line .= '
';
push (@bericht, $line);
}
$message = join('', @bericht);
}
else
{
$message = $input;
}
return $message;
}
#######################################################################
sub Preview {
$NumPreviews = 6;
open (DBASE, $ForumData) || die print "$MESS{'IO_ERROR'} (error 1)";
@DBASE=reverse;
close (DBASE);
foreach $_ (@DBASE) {
($ONDERWERP,$DATUM,$NAAM,$BERICHT)=split(/$delimiter/);
if (length($ONDERWERP) > 2) {
if ($telhes{$ONDERWERP}) { $telhes{$ONDERWERP} += 1 }
if (!$telhes{$ONDERWERP}) { $telhes{$ONDERWERP} = 1 }
}
}
print <
| $MESS{'Thread'} |
$MESS{'LastBy'} |
$MESS{'Messages'} |
$MESS{'Date'} |
EOF
my $raster = $ThreadPageColorLight;
foreach $_ (@DBASE)
{
($ONDERWERP,$DATUM,$NAAM,$BERICHT)=split(/$delimiter/);
if (length($ONDERWERP) > 2 && !$donehes{$ONDERWERP} && $tel<$NumPreviews)
{
$tel++;
if ($raster eq "$ThreadPageColorLight") { $raster = "$ThreadPageColorDark" }
else {$raster = "$ThreadPageColorLight";}
$LinkONDERWERP = $ONDERWERP;
$LinkONDERWERP =~ s/ /\%20/ig;
print <
$ONDERWERP |
$NAAM |
$telhes{$ONDERWERP} |
$DATUM |
EOF
$donehes{$ONDERWERP} = 1;
}
}
exit;
}
sub VerwijderDiscussie {
PrintKop();
print <$MESS{'RemoveThread'}: "$in{'onderwerp'}"
$MESS{'Password'}:
EOF
PrintStaart();
}
#######################################################################
sub VerwijderDiscussieOK {
open (DBASE, $ForumData) || die print "$MESS{'IO_ERROR'} (error 1)";
@DBASE=;
close (DBASE);
open (DBASE, ">$ForumData") || die print "$MESS{'IO_ERROR'} (error 1)";
foreach $_ (@DBASE) {
($ONDERWERP,$DATUM,$NAAM,$BERICHT)=split(/$delimiter/);
if ($in{'onderwerp'} eq $ONDERWERP) { }
else { print DBASE $_; }
}
close (DBASE);
print <