Creating a simple CGI message board
The HTML Templates
The Bulletin Board Script
Displaying the Message List
Displaying Messages
Adding New Messages
Adding Replies
Expiring Messages
The Complete Bulletin Board Script
The Complete Bulletin Board Script
Now that you have completed the five subroutines for your bulletin board script, you can put them all together into a single file called board.pl. Listing 8 contains the complete code for the bulletin board script. At the beginning of the board.pl file are several variable assignments. This is where the global variables mentioned in the previous sections are set. Also notice that the subroutines User_Data and No_SSI are both included in the board.pl file. You developed these subroutines earlier in this book. User_Data retrieves and URL decodes any data received from the user's Web browser. No_SSI eliminates any Server Side Include statements the user may have included in a message or reply.
Every time your bulletin board script is called, the line
$ENV{"REQUEST_METHOD"} eq "POST" ? &Which_Post : &Which_Get;
is executed. This line checks which method was used to call the board.pl script. If it was the POST method, which is used when a user posts a new message or a reply, the Which_Post subroutine is called. If it was the GET method, which is used when the user asks to view the message list or a specific message or reply, the Which_Get subroutine is called.
The Which_Post subroutine performs two main actions. First, it calls both the User_Data and No_SSI subroutines. This properly formats the user-supplied data into the %data_received associative array. Then it calls the proper subroutine, either Add_New_Message or Add_Reply, depending on which push button the user pressed. Recall from Listing 1 that the value for the submit button sent to the bulletin board script when the user posts a new message is Post Message. Also, from Listing 2, you see that the value for the submit button is Post Reply. So, you can call the correct subroutine by checking the value stored in the $data_received{'submit'} array element.
The Which_Get subroutine is called to display both the message list and messages and replies. Like Which_Post, Which_Get calls both the User_Data and No_SSI subroutines to retrieve any user data and place it in the %data_ received associative array. Then, an if...else statement block is used to distinguish which subroutine should be called, the Display_Message or Display_ Message_Lists subroutine. The conditional expression checks whether there is a value for the $data_received{'list'} array element. This element only has a value when the user asks to view a message or reply. In other words, the code under the if portion of the if...else statement calls the Display_Message subroutine. If the $data_ received{'list'} element does not contain a value, the message list is displayed to the user. Immediately before the Display_Message_Lists subroutine is called, the Expires subroutine can be called. If you place the subroutine call here, the message lists are updated every time any user requests the message list page. This keeps the message list fresh and current for every user. If you do not want your bulletin boards messages and replies to expire, just comment out the Expires subroutine by adding a pound sign (#) at the beginning of the line.
#!/usr/local/bin/perl
# All users need to change the values of the $path variable
# to the valid path for their machine. Windows users need to
# use a path in the form $path = "c:\\robertm";
$path = "/users/robertm";
# Windows users need to change all the slashes (/) in the following lines
# to double backslashes (\\). For example, $list_template would be
# $list_template = $path . "\\message-list.tmpl";
$list_template = $path . "/message-list.tmpl";
$list_dir = $path . "/message-lists";
$list_count = $list_dir . "/count.dat";
$message_template = $path . "/message.tmpl";
$message_dir = $path . "/messages";
$message_count = $message_dir . "/count.dat";
# All users need to change the value of $expires to the amount
# of days before you want messages on your bulletin board to expire.
# If you don't want messages to expire, comment out the line
# &Expires;
# in the Which_Get subroutine below.
$expires = 9Ø;
$date = localtime(time);
$ENV{"REQUEST_METHOD"} eq "POST" ? &Which_Post : &Which_Get;
sub Which_Post {
%data_received = &User_Data();
&No_SSI(%data_received);
&Add_New_Message(%data_received) if $data_received{'submit'} eq "Post Message";
&Add_Reply(%data_received) if $data_received{'submit'} eq "Post Reply";
}
sub Which_Get {
%data_received = &User_Data();
&No_SSI(%data_received);
if ($data_received{'list'}) {
&Display_Message(%data_received);
} else {
# If you don't want messages on your bulletin board to expire, comment out
# the &Expires; line below.
&Expires;
&Display_Message_Lists;
}
}
sub Expires {
local (@lists, @list_contents, @new_list_contents,
$num_lists, $i, $j, $name, $subject, $message_date,
$message_file, $header, $replies);
open(LISTS,"$list_count") || die "Content-type: text/html\n\nCannot open list
count!";
$num_lists = <LISTS>;
close(LISTS);
for ($i=1; $i<=$num_lists; $i++) {
# Open the message list file. If it cannot be
# opened, assume it has been deleted and go
# to the next message list.
# Windows users need to change the string "$list_dir/$i" to
# "$list_dir\\$i"
open(LIST, "$list_dir/$i") || next;
@list_contents = <LIST>;
close(LIST);
# Start creating the new header file list by placing the main message in
# the first element of the @new_list_contents array
@new_list_contents = ($list_contents[Ø]);
# If the header file only contains 1 message, there are no replies.
if (@list_contents > 1) {
# The message list contains replies, so check to
# see if they have expired.
for ($j=1; $j<@list_contents; $j++) {
# Split each message header from the message list file.
($name, $subject, $message_date, $message_file) =
split(/::/, $list_contents[$j]);
chop $message_file;
# This checks to see if the associated message file has expired. If so
# the message file is deleted.
# Windows users need to change the "$message_dir/$message_file" strings
# below to "$message_dir\\$message_file"
if (-M "$message_dir/$message_file" > $expires) {
unlink "$message_dir/$message_file";
} else {
# The message file has not expired, so add the header line to
# the new contents of the header file stored in the @new_list_contents
array.
push(@new_list_contents, $list_contents[$j]);
}
}
# Create the new header file.
# Windows users need to change the string "$list_dir/$i" to
# "$list_dir\\$i"
open(LIST, ">$list_dir/$i") || die "Content-type: text/html\n\nCannot open
list file for output!";
print LIST @new_list_contents;
close(LIST);
}
# Split each message header from the message list file.
($name, $subject, $message_date, $message_file) =
split(/::/, $list_contents[Ø]);
chop $message_file;
# Check to see if the main message has expired.
if (@new_list_contents == 1) {
# The list only contains the original message (no replies)
# Windows users need to change the string "$message_dir/$message_file" to
# "$message_dir\\$message_file"
if (-e "$message_dir/$message_file") {
# If the message has expired, delete the message file
# and the list file.
# Windows users need to change the "$list_dir/$i" and
# "$message_dir/$message_file" strings below to
# "$list_dir\\$i" and $message_dir\\$message_file"
unlink "$list_dir/$i", "$message_dir/$message_file"
if (-M "$message_dir/$message_file" > $expires);
} else {
# The original message file does not exist, so delete
# the list.
# Windows users need to change the string "$list_dir/$i"
# to "$list_dir\\$i"
unlink "$list_dir/$i";
}
} else {
# The list contains the original message and replies. Delete only the main
# message file if it exists and has expired.
# Windows users need to change the "$message_dir/$message_file" strings
# below to "$message_dir\\$message_file"
unlink "$message_dir/$message_file"
if ( (-e "$message_dir/$message_file") &&
(-M "$message_dir/$message_file" > $expires) );
}
}
}
sub Display_Message_Lists {
local (@template, @lists, @list_contents, $num_lists,
$i, $j, $name, $subject, $message_date, $message_file,
$header, $replies);
open(LISTS,"$list_count") || die "Content-type: text/html\n\nCannot open list
count!";
$num_lists = <LISTS>;
close(LISTS);
# Loop over all the message list files and add the contents to the message list
# which is displayed to the user.
for ($i=1; $i<=$num_lists; $i++) {
# Open the message list file. If it cannot be
# opened, assume it has been deleted and go
# to the next message list.
# Windows users need to change the string "$list_dir/$i" to
# "$list_dir\\$i"
open(LIST, "$list_dir/$i") || next;
@list_contents = <LIST>;
close(LIST);
# Split the message header from the message list file.
($name, $subject, $message_date, $message_file) =
split(/::/, $list_contents[Ø]);
chop $message_file;
# Format the header depending on whether the message file
# exists
# Windows users need to change the string "$message_dir/$message_file"
# to "$message_dir\\$message_file"
unless (-e "$message_dir/$message_file") {
$header = "<LI><B>$subject</B> $name - $message_date";
} else {
$header = "<LI><A HREF=\"/cgi-
bin/board.pl?message=$message_file&list=$i\">";
$header .= "<B>$subject</B></A> $name - $message_date";
}
# If the header file has more than one line, it contains header lines for
replies.
if (@list_contents > 1) {
$replies = "<UL>\n";
for ($j=1; $j<@list_contents; $j++) {
# Split each message header from the message list file.
($name, $subject, $message_date, $message_file) =
split(/::/, $list_contents[$j]);
chop $message_file;
# Format the replies for display in the user's Web browser.
$replies .= "<LI><A HREF=\"/cgi-
bin/board.pl?message=$message_file&list=$i\">";
$replies .= "$subject</A> $name - $message_date";
}
# Append the replies after the main message.
$header .= "\n$replies</UL>\n";
}
# Put the header and replies (if any) in the @lists array.
push(@lists, $header);
}
# If there are any messages in the @lists array, finish formatting with HTML
if (@lists) {
unshift(@lists, "<UL>\n");
push(@lists, "</UL>\n");
} else {
# No messages exist.
$lists[Ø] = "<H2>Currently No Messages</H2>";
}
open(TEMPLATE,"$list_template") || die "Content-type: text/html\n\nCannot open
template!";
@template = <TEMPLATE>;
close(TEMPLATE);
# Put the message headers in the template, and send to the user's Web browser.
splice(@template, 8, Ø, @lists);
print "Content-type: text/html\n\n";
print @template;
}
sub Display_Message {
local (%data) = @_;
local (@template, @list, @message, $subject, $message_file);
# Open and read in the template
open(TEMPLATE,"$message_template") || die "Content-type: text/html\n\nCannot
open template!";
@template = <TEMPLATE>;
close(TEMPLATE);
# Open and read in the message file
# Windows users need to change the string "$message_dir/$data{\"message\"}"
# to "$message_dir\\$data{\"message\"}"
open(MESSAGE,"$message_dir/$data{\"message\"}") || die "Content-type:
text/html\n\nCannot open message!";
@message = <MESSAGE>;
close(MESSAGE);
# Open and read in the list file
# Windows users need to change the string "$list_dir/$data{\"list\"}" to
# "$list_dir\\$data{\"list\"}"
open(LIST,"$list_dir/$data{\"list\"}") || die "Content-type:
text/html\n\nCannot open message!";
@list = <LIST>;
close(LIST);
# Find the subject for the message to be displayed.
foreach (@list) {
# Split each message header from the message list file.
(undef, $subject, undef, $message_file) =
split(/::/);
chop $message_file;
# Exit the loop when the message has been found.
last if $message_file == $data{'message'};
}
# Put the subject in the <TITLE> line of the template.
$template[2] =~ s/XXXX/$subject/ge;
# Format the subject line for the Reply form at the end of the page.
unless ($subject =~ /^re:/i) {
substr($subject, Ø, Ø) = "Re: ";
}
# Insert the subject and list into the template.
$template[2Ø] =~ s/YYYY/$subject/ge;
$template[26] =~ s/ZZZZ/$data{'list'}/ge;
# Insert the message into the template and send it to the user's Web browser.
splice(@template, 4, Ø, @message);
print "Content-type: text/html\n\n";
print @template;
}
sub Add_New_Message {
local (%data) = @_;
local ($num_lists, $num_messages);
# Verify the user entered the required fields
die "Content-type: text/html\n\nYou must enter data for every field except the
E-mail address."
unless ($data{'name'} && $data{'subject'} && $data{'comments'});
# Get the last list number
open(LISTS,"$list_count") || die "Content-type: text/html\n\nCannot open list
count!";
$num_lists = <LISTS>;
close(LISTS);
# Increment the number
$num_lists++;
# Save the current list number to the file
open(LISTS,">$list_count") || die "Content-type: text/html\n\nCannot open list
count!";
print LISTS $num_lists;
close(LISTS);
# Get the last message number
open(MESSAGES,"$message_count") || die "Content-type: text/html\n\nCannot open
message count!";
$num_messages = <MESSAGES>;
close(MESSAGES);
# Increment the number
$num_messages++;
# Save the current message number to the file
open(MESSAGES,">$message_count") || die "Content-type: text/html\n\nCannot open
message count!";
print MESSAGES $num_messages;
close(MESSAGES);
# Create the new message
# Windows users need to change the string ">$message_dir/$num_messages"
# to ">$message_dir\\$num_messages"
open(NEWMESSAGE,">$message_dir/$num_messages") || die "Content-type:
text/html\n\nCannot create new message!";
print NEWMESSAGE "<B>Subject:</B> $data{\"subject\"}<BR>\n";
print NEWMESSAGE "<B>From:</B> $data{\"name\"}<BR>\n";
print NEWMESSAGE "<B>E-mail:</B> $data{\"email\"}<BR>\n" if $data{'email'};
print NEWMESSAGE "<B>Date:</B> $date<P>\n";
print NEWMESSAGE "$data{\"comments\"}<P>\n";
close(NEWLIST);
# Create the new list
# Windows users need to change the string ">$list_dir/$num_lists" to
# ">$list_dir\\$num_lists"
open(NEWLIST,">$list_dir/$num_lists") || die "Content-type: text/html\n\nCannot
create new list!";
print NEWLIST "$data{\"name\"}::$data{\"subject\"}::${date}::$num_messages\n";
close(NEWLIST);
&Display_Message_Lists;
}
sub Add_Reply {
local (%data) = @_;
local ($num_lists, $num_messages);
# Verify the user entered the required fields
die "Content-type: text/html\n\nYou must enter data for every field except the
E-mail address."
unless ($data{'name'} && $data{'subject'} && $data{'comments'});
# Get the last message number
open(MESSAGES,"$message_count") || die "Content-type: text/html\n\nCannot open
message count!";
$num_messages = <MESSAGES>;
close(MESSAGES);
# Increment the number
$num_messages++;
# Save the current message number to the file
open(MESSAGES,">$message_count") || die "Content-type: text/html\n\nCannot open
message count!";
print MESSAGES $num_messages;
close(MESSAGES);
# Create the new message
# Windows users need to change the string ">$message_dir/$num_messages" to
# ">$message_dir\\$num_messages"
open(NEWMESSAGE,">$message_dir/$num_messages") || die "Content-type:
text/html\n\nCannot create new message!";
print NEWMESSAGE "<B>Subject:</B> $data{\"subject\"}<BR>\n";
print NEWMESSAGE "<B>From:</B> $data{\"name\"}<BR>\n";
print NEWMESSAGE "<B>E-mail:</B> $data{\"email\"}<BR>\n" if $data{'email'};
print NEWMESSAGE "<B>Date:</B> $date<P>\n";
print NEWMESSAGE "$data{\"comments\"}<P>\n";
close(NEWLIST);
# Add message header to the list
# Windows users need to change the string ">>$list_dir/$data{\"list\"}"
# to ">>$list_dir\\$data{\"list\"}"
open(LIST,">>$list_dir/$data{\"list\"}") || die "Content-type:
text/html\n\nCannot open list!";
print LIST "$data{\"name\"}::$data{\"subject\"}::${date}::$num_messages\n";
close(LIST);
&Display_Message_Lists;
}
sub No_SSI {
local (*data) = @_;
foreach $key (sort keys(%data)) {
$data{$key} =~ s/<!--(.|\n)*-->//g;
}
}
sub User_Data {
local (%user_data, $user_string, $name_value_pair,
@name_value_pairs, $name, $value);
# If the data was sent via POST, then it is available
# from standard input. Otherwise, the data is in the
# QUERY_STRING environment variable.
if ($ENV{"REQUEST_METHOD"} eq "POST") {
read(STDIN,$user_string,$ENV{"CONTENT_LENGTH"});
} else {
$user_string = $ENV{"QUERY_STRING"};
}
# This line changes the + signs to spaces.
$user_string =~ s/\+/ /g;
# This line places each name/value pair as a separate
# element in the name_value_pairs array.
@name_value_pairs = split(/&/, $user_string);
# This code loops over each element in the name_value_pairs
# array, splits it on the = sign, and places the value
# into the user_data associative array with the name as the
# key.
foreach $name_value_pair (@name_value_pairs) {
($name, $value) = split(/=/, $name_value_pair);
# These two lines decode the values from any URL
# hexadecimal encoding. The first section searches for a
# hexadecimal number and the second part converts the
# hex number to decimal and returns the character
# equivalent.
$name =~
s/%([a-fA-FØ-9][a-fA-FØ-9])/pack("C",hex($1))/ge;
$value =~
s/%([a-fA-FØ-9][a-fA-FØ-9])/pack("C",hex($1))/ge;
# If the name/value pair has already been given a value,
# as in the case of multiple items being selected, then
# separate the items with a " : ".
if (defined($user_data{$name})) {
$user_data{$name} .= " : " . $value;
} else {
$user_data{$name} = $value;
}
}
return %user_data;
}
|