#!/usr/bin/perl
##############################################################################
# WWWBoard Version 2.0 ALPHA 2.1 #
# Copyright 1996 worldwidemart.com #
# Created 10/21/95 Last Modified 01/07/00 #
# Scripts Archive: https://www.worldwidemart.com/scripts/ #
##############################################################################
# COPYRIGHT NOTICE #
# This script is distributed under the Artistic License. #
# You may freely use and modify it, keeping this copyright notice intact. #
##############################################################################
use strict;
use warnings;
use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
use Fcntl qw(:flock);
# Configuration
my $basedir = '.'; # Base directory
my $baseurl = '/wwwboard'; # Base URL
my $cgi_url = '/cgi-bin/wwwboard.pl'; # Script URL
my $meession = "$basedir/wwwboard.html"; # Main board file
my $message_dir = "$basedir/messages"; # Directory for message files
my $data_file = "$basedir/data.txt"; # Data file
my $max_posts = 500; # Maximum posts to keep
# Admin settings
my $admin_password = 'changeme'; # CHANGE THIS!
##############################################################################
# Main Script
##############################################################################
my $cgi = CGI->new;
my $action = $cgi->param('action') || 'view';
if ($action eq 'post') {
post_message();
} elsif ($action eq 'followup') {
show_followup_form();
} elsif ($action eq 'delete' && verify_admin()) {
delete_message();
} else {
show_board();
}
##############################################################################
# Subroutines
##############################################################################
sub show_board {
print $cgi->header('text/html');
if (-e $meession) {
open(my $fh, '<', $meession) or die "Cannot open board: $!";
print while <$fh>;
close($fh);
} else {
print_default_board();
}
}
sub post_message {
my $name = $cgi->param('name') || 'Anonymous';
my $email = $cgi->param('email') || '';
my $subject = $cgi->param('subject') || 'No Subject';
my $body = $cgi->param('body') || '';
my $followup = $cgi->param('followup') || 0;
# Validate
unless ($body) {
error_page("Message body is required.");
return;
}
# Sanitize
$name = $cgi->escapeHTML($name);
$email = $cgi->escapeHTML($email);
$subject = $cgi->escapeHTML($subject);
$body = $cgi->escapeHTML($body);
$body =~ s/\n/
\n/g;
# Get next message number
my $num = get_next_num();
# Create message file
create_message_file($num, $name, $email, $subject, $body, $followup);
# Update main board
update_board($num, $name, $subject, $followup);
# Redirect to board
print $cgi->redirect($meession);
}
sub get_next_num {
my $num = 1;
if (-e $data_file) {
open(my $fh, '<', $data_file);
$num = <$fh>;
close($fh);
chomp($num);
$num++;
}
open(my $fh, '>', $data_file);
print $fh $num;
close($fh);
return $num;
}
sub create_message_file {
my ($num, $name, $email, $subject, $body, $followup) = @_;
mkdir $message_dir unless -d $message_dir;
my $timestamp = localtime();
my $email_link = $email ? qq{$name} : $name;
open(my $fh, '>', "$message_dir/$num.html") or die "Cannot create message: $!";
print $fh <
$subject
$subject
Posted by: $email_link
Date: $timestamp
$body
HTML
close($fh);
}
sub update_board {
my ($num, $name, $subject, $followup) = @_;
my $entry = qq{$subject - $name\n};
my $content = '';
if (-e $meession) {
open(my $fh, '<', $meession);
local $/;
$content = <$fh>;
close($fh);
} else {
$content = get_board_template();
}
my $marker = '';
$content =~ s/(\Q$marker\E)/$1\n$entry/;
open(my $fh, '>', $meession);
print $fh $content;
close($fh);
}
sub show_followup_form {
my $followup = $cgi->param('followup') || 0;
print $cgi->header('text/html');
print <
Post Followup
Post Followup
HTML
}
sub verify_admin {
my $pass = $cgi->param('password') || '';
return $pass eq $admin_password;
}
sub delete_message {
my $num = $cgi->param('num') || 0;
unlink "$message_dir/$num.html" if $num && -e "$message_dir/$num.html";
print $cgi->redirect($meession);
}
sub error_page {
my ($msg) = @_;
print $cgi->header('text/html');
print "Error
$msg
Go Back
";
}
sub print_default_board {
print get_board_template();
}
sub get_board_template {
return <<'TEMPLATE';
WWWBoard - Discussion Forum
WWWBoard - Discussion Forum
Post New Message
Messages
TEMPLATE
}
__END__
=head1 NAME
wwwboard.pl - Threaded Discussion Forum
=head1 DESCRIPTION
A threaded World Wide Web discussion forum and message board that allows
users to post new messages and follow up to existing ones.
=head1 LICENSE
Artistic License
=cut