Problem with my Perl Scrpt - Can't find Directories

[dbuuch]

I have this bulletin board script which used to work very well until i changed my site hosting company about two weeks ago. I then transferred all my files onto my new server as they were before.

The BB creates directories for each of the forums I have set up.

Can anyone help me please?

The following code is the bit which is supposed to find these directories and list them but it isn't detecting the existence of these directories even though I can clearly see the directories:

$ENV{'PATH'} = '/bin:/usr/bin';

my $VERSION = '2.1';


my $script = url();

#read the whole file in
undef $/;

if (!param()) {
	my ($forum,%count,@list,@rows);
	#chdir($BBS_DIR) || die "Cant chdir to $BBS_DIR: $!";
	opendir(DIR, $BBS_DIR) or die "Cant opendir $BBS_DIR: $!";
	my @forums = grep { !/^\./ } readdir(DIR);
	closedir(DIR);
	foreach $forum (@forums) {
		my $path = $BBS_DIR.'\\'.$forum;
		if (-d $path) {
			opendir(DIR, $path ) || die "Cant opendir $path: $!";
			$count{$forum} = (@list = grep { !/^\./ } readdir(DIR));
			closedir(DIR);
		}
	}

	my $counter = 0;
	my $odd_open = '<tr align="center"><td width="25%">';
	my $odd_close = '</td>';
	my $even_open = '<td width="25%">';
	my $even_close = '</td></tr>';
	
	foreach $forum ( sort keys %count) {
		next if $forum =~ /_archive$/;
		my $link = "$script?forum=$forum&task=list";
    		my $label = (($counter = 1- $counter) ? $odd_open : $even_open) . 
    		a({-href=>$link},get_label($forum) . " ($count{$forum} post" . 
    		($count{$forum} != 1 ? "s)" : ")")) . ($counter ? $odd_close : $even_close);
    	    	push @rows,$label;
		}
	
	
	
	print header,start_html(-bgcolor=>$BG,-text=>$TX,-link=>$LL,-vlink=>$VL,
    -background=>$BGIMG,-title=>"$BBS_TITLE"),
    
    h1({align=>'center'},"$BBS_TITLE");
    if (!@rows) {
    	print center('No forums have been defined.');
    }
    else {
    	print center(
    	'Select a forum from the list below.',p,
    	table(@rows),
    	);
    }
    print hr;
    
    if ($BBS_INFO) {
    	open(INFO, "$BBS_INFO") || die "Can't open $BBS_INFO: $!";
    	while (<INFO>) {
    		print;
    	}
    	close(INFO);
    }
    
	print hr,
	font({-size=>'-1'},a({-href=>$HOME,-target=>'_blank'},
	'Return to Old Vandals home page'),br, a({-href=>"mailto: $EMAIL"},
	"Email Webmaster")),,
    end_html;

	exit(0);
}

my $forum = param('forum');
if ($forum =~ /(^[a-zA-Z0-9_]+$)/) {
	$forum = $1;
}
else {
	bad_input();
}
	
my $forum_label = get_label($forum);	
my $task = param('task');

show_post_list() if $task eq 'list';
show_msg() if $task eq 'show_msg';
new_thread_form() if $task eq 'new_thread_form';
new_post() if $task eq 'new_post';
reply_form() if $task eq 'reply_form';
post_reply() if $task eq 'post_reply';
mark_read() if $task eq 'mark_read';
show_post_list() if $task eq 'list_archive';

"To educate a man is to educate an individual; to educate a woman is to educate a nation"
Dr. Aggrey, Ghana.

 

[KevinADC]

is the script printing any error messages? Have you checked the server error logs? is $BBS_DIR corrct for the new srver?

 

[dbuuch]

Thanks Kev. The script does not give any errors. In have it is suppose to print a message if it doesn't find any directories and it seems to do that correctly. Also, i have schecked the $BBS_DIR and it seems ok (to my uninitiated eye).

I did not post the entire code but below is it:

#!/usr/bin/perl 

use CGI qw/:all/;
use CGI::Carp(fatalsToBrowser);
use Fcntl;

#Web Forums
#A Perl script to create an online bulletin/discussion board.
#Copyright 2000 NPSIS 
#[URL unfurl="true"]http://www.npsis.com[/URL]
#Last Modified August 20, 2000
#This is a free script. You may edit and alter it for personal
#use as you see fit. You may not sell it or otherwise claim it
#as your own, unless you have absolutely no morals.

#See the enclosed readme file for complete instructions for
#setting up the BBS.

#####User Edits Here#########################

$Username = 'Old Vandals Association';
my $HOME = '[URL unfurl="true"]http://www.oldvandals.com/';[/URL]
my $EMAIL = 'admin@oldvandals.com';
my $YOURNAME = 'Old Vandals';
my $BBS_TITLE = 'Welcome to the Old Vandals Association Forum';

#set this to 1 to quote message when replying
#set to 0 to not quote messages when replying
my $quote = 1;

my $BG = '#ffffff';	#background color
my $TX = '#4E172A';	#text color
my $LL = '#00008b';	#visited link color
my $VL = '#00008b';	#link color
my $BGIMG = '[URL unfurl="true"]http://www.oldvandals.com/picts/shadeform.jpg';[/URL]		#background image url

###############################################


$Loginfirstletter = substr($Username, 0, 1);

#my $BBS_DIR = "/usr/home/users/$Loginfirstletter/$Username/public_html/bbs/";
#my $BBS_DIR = 'D:\Webserver\oldvandals.com\[URL unfurl="true"]www\bbs';[/URL]
#my $SECRET = 'D:\Webserver\oldvandals.com\[URL unfurl="true"]www\bbs\admin.txt';[/URL]

my $BBS_DIR = '/kunden/homepages/18/d145475264/htdocs/bbs';
my $SECRET = '/kunden/homepages/18/d145475264/htdocs/bbs/admin.txt';

#the path to a file containing directions, etc. that will be printed on forum list page
my $BBS_INFO = '/kunden/homepages/18/d145475264/htdocs/bbs/info.txt';  #include trailing slash


#my $STYLE='<!-- a:link { text-decoration: none } -->';



#$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
$ENV{'PATH'} = '/bin:/usr/bin';

my $VERSION = '2.1';


my $script = url();

#read the whole file in
undef $/;

if (!param()) {
	my ($forum,%count,@list,@rows);
	#chdir($BBS_DIR) || die "Cant chdir to $BBS_DIR: $!";
	opendir(DIR, $BBS_DIR) or die "Cant opendir $BBS_DIR: $!";
	my @forums = grep { !/^\./ } readdir(DIR);
	closedir(DIR);
	foreach $forum (@forums) {
		my $path = $BBS_DIR.'\\'.$forum;
		if (-d $path) {
			opendir(DIR, $path ) || die "Cant opendir $path: $!";
			$count{$forum} = (@list = grep { !/^\./ } readdir(DIR));
			closedir(DIR);
		}
	}

	my $counter = 0;
	my $odd_open = '<tr align="center"><td width="25%">';
	my $odd_close = '</td>';
	my $even_open = '<td width="25%">';
	my $even_close = '</td></tr>';
	
	foreach $forum ( sort keys %count) {
		next if $forum =~ /_archive$/;
		my $link = "$script?forum=$forum&task=list";
    		my $label = (($counter = 1- $counter) ? $odd_open : $even_open) . 
    		a({-href=>$link},get_label($forum) . " ($count{$forum} post" . 
    		($count{$forum} != 1 ? "s)" : ")")) . ($counter ? $odd_close : $even_close);
    	    	push @rows,$label;
		}
	
	
	
	print header,start_html(-bgcolor=>$BG,-text=>$TX,-link=>$LL,-vlink=>$VL,
    -background=>$BGIMG,-title=>"$BBS_TITLE"),
    
    h1({align=>'center'},"$BBS_TITLE");
    if (!@rows) {
    	print center('No forums have been defined.');
    }
    else {
    	print center(
    	'Select a forum from the list below.',p,
    	table(@rows),
    	);
    }
    print hr;
    
    if ($BBS_INFO) {
    	open(INFO, "$BBS_INFO") || die "Can't open $BBS_INFO: $!";
    	while (<INFO>) {
    		print;
    	}
    	close(INFO);
    }
    
	print hr,
	font({-size=>'-1'},a({-href=>$HOME,-target=>'_blank'},
	'Return to Old Vandals home page'),br, a({-href=>"mailto: $EMAIL"},
	"Email Webmaster")),,
    end_html;

	exit(0);
}

my $forum = param('forum');
if ($forum =~ /(^[a-zA-Z0-9_]+$)/) {
	$forum = $1;
}
else {
	bad_input();
}
	
my $forum_label = get_label($forum);	
my $task = param('task');

show_post_list() if $task eq 'list';
show_msg() if $task eq 'show_msg';
new_thread_form() if $task eq 'new_thread_form';
new_post() if $task eq 'new_post';
reply_form() if $task eq 'reply_form';
post_reply() if $task eq 'post_reply';
mark_read() if $task eq 'mark_read';
show_post_list() if $task eq 'list_archive';

#######################################################
sub mark_read {
	my $last_visit = time;
	my $cookie = cookie(-name=>$forum,
                -value=>$last_visit,
                -expires=>'+30d',);
                
    print header(-cookie=>$cookie);
    show_post_list('marked');
}    

sub post_reply {
	my $reply_to = param('reply_to');
	if ($reply_to =~ /(^\d\d\d\d(\.\d\d\d\d)*$)/) {
		$reply_to = $1;
	}
	else {
		bad_input();
	}
	my $email = param('email');
	validate_email($email) if $email;
	my $name = clean(param('name'));
	my $subject = clean(param('subject'));
	my $message = param('message');
	check_required($name,$subject,$message);
	my $time_stamp = time;
	my $date = get_date($time_stamp);
	my $forum_dir =  $BBS_DIR .'\\'. $forum;
	#chdir($forum_dir) || die "Can't chdir to $forum_dir: $!";
	opendir(DIR,$forum_dir) || die "Can't opendir $forum_dir: $!";
	#see if there any more replies to this post
	my @posts = grep { /^$reply_to\.\d\d\d\d$/o } readdir(DIR);
	closedir(DIR);

	my ($new_post,$last_post,$start,$end);
	if (!@posts) { #none yet
		$new_post = $reply_to . '.' .'0001';
	}
	else {
		$last_post = $posts[$#posts];
		$last_post =~ /^(.+)(\d\d\d\d)$/;
		$start = $1;
		$end = $2;
		$end = sprintf("%04d",++$end);
		$new_post = $start . $end;
	}
	chdir($forum_dir) || die "Can't chdir to $forum_dir: $!";
	until (sysopen(FILE,$new_post,O_WRONLY|O_EXCL|O_CREAT,0666)){
		$new_post =~ /(.+)(\d\d\d\d)$/; 
		$start = $1;
		$end = $2;
		$end = sprintf("%04d",++$end);
		$new_post = $start . $end;		
	}
	
	store_and_confirm(*FILE,$subject,$name,$email,$message);
	
	exit(0);
	

}

sub reply_form {
	my $msg = param('msg');
	if ($msg =~ /(^\d\d\d\d(\.\d\d\d\d)*$)/) {
		$msg = $1;
	}
	else {
		bad_input();
	}
	my $forum_dir =  $BBS_DIR .'\\'. $forum;
	chdir($forum_dir);
	open (POST, "$msg") || die "$!\n";
	my $content = <POST>;
	close(POST);
	my ($subject,$author,$email,$date,$message) = split(/\n/,$content,5);
	$date = get_date($date);
	my $attribution = '';
	if ($quote) {
		$attribution = "In reply to \"$subject\", posted by $author on $date:\n";
		$message =~ s/^(.{0,1})/>$1/mg;
		$message = $attribution . $message . "\n";
	}
	else {
		$message = '';
	}
	$subject = 'Re: ' . $subject;
	
	print header,
	start_html(-bgcolor=>$BG,-text=>$TX,-link=>$LL,-vlink=>$VL,
    -background=>$BGIMG,-title=>"$forum_label"),

    h1({align=>'center'},"$forum_label"),
    h2({align=>'center'},'Post Reply'),
    '<center><table bgcolor=#ffffff cellspacing=4 cellpadding=2 border=0>',
    '<td align=center valign=middle>',
	a({-href=>"$script?task=list&forum=$forum"},b('Message List')),
	'</td>',
	'<td align=center valign=middle>',
    a({-href=>$script},b('Forum List')),
    '</td>',
    '</tr></table></center>',
    hr,
    'Enter your reply below. You may edit the subject and message content.',p,
    b("In reply to \"$subject\", posted by $author on $date:"),p,
    font({-color=>'red'},'*'),b('Required Fields'),p,
    
    start_form(-action=>$script),
	hidden(-name=>'forum',-value=>$forum,-override=>1),
	hidden(-name=>'task',-value=>'post_reply',-override=>1),
	hidden(-name=>'reply_to',-value=>$msg,-override=>1),
	
	table(
		Tr({-align=>'LEFT'},
		th({-align=>'right'},font({-color=>'red'},'*'),'Name: '),
		td({-align=>'left'},textfield(-name=>'name',-size=>30))
		),
		Tr(
		th({-align=>'right'},'Email Address: '),
		td({-align=>'left'},textfield(-name=>'email',-size=>30))
		),
		Tr(
		th({-align=>'right'},font({-color=>'red'},'*'),'Subject: '),
		td({-align=>'left'},textfield(-name=>'subject',-value=>$subject,-size=>30))
		),
		Tr(
		th({-align=>'right',-valign=>'top'},font({-color=>'red'},'*'),'Message: '),
		td(textarea(-name=>'message',-rows=>10,
					-value=>$message,
                    -cols=>60,-wrap=>'soft')),
		),
		Tr({-align=>'center'},
		td({-colspan=>2},submit(-name=>'SUBMIT REPLY'),reset(-name=>'CLEAR FORM'))
		),
	),
	end_form,hr,
	

	font({-size=>'-1'},a({-href=>$HOME,-target=>'_blank'},
	'Return to Old Vandals home page'),br, a({-href=>"mailto: $EMAIL"},
	"Email Webmaster")),,
	end_html;
	exit(0);
	
	
	
}


sub new_thread_form {
	print header,
	start_html(-bgcolor=>$BG,-text=>$TX,-link=>$LL,-vlink=>$VL,
    -background=>$BGIMG,-title=>"$forum_label"),
    
    h1({align=>'center'},"$forum_label"),
    h2({align=>'center'},'New Post'),
    
    '<center><table bgcolor=#ffffff cellspacing=4 cellpadding=2 border=0><tr>',
    '<td align=center valign=middle>',
	a({-href=>"$script?task=list&forum=$forum"},b('Message List')),
	'</td>',
	'<td align=center valign=middle>',
    a({-href=>$script},b('Forum List')),
	'</td>',
	'</tr></table></center>',hr,
    
    font({-color=>'red'},'*'),b('Required Fields'),p,
    start_form(-action=>$script),
	hidden(-name=>'forum',-value=>$forum,-override=>1),
	hidden(-name=>'task',-value=>'new_post',-override=>1),
	table(
		Tr({-align=>'LEFT'},
		th({-align=>'right'},font({-color=>'red'},'*'),'Name: '),
		td({-align=>'left'},textfield(-name=>'name',-size=>30))
		),
		Tr(
		th({-align=>'right'},'Email Address: '),
		td({-align=>'left'},textfield(-name=>'email',-size=>30))
		),
		Tr(
		th({-align=>'right'},font({-color=>'red'},'*'),'Subject: '),
		td({-align=>'left'},textfield(-name=>'subject',-size=>30))
		),
		Tr(
		th({-align=>'right',-valign=>'top'},font({-color=>'red'},'*'),'Message: '),
		td(textarea(-name=>'message',-rows=>10,
                    -cols=>60,-wrap=>'soft')),
		),
		Tr({-align=>'center'},
		td({-colspan=>2},submit(-name=>'SUBMIT POST'),reset(-name=>'CLEAR FORM'))
		),
	),
	end_form,hr,

	font({-size=>'-1'},a({-href=>$HOME,-target=>'_blank'},
	'Return to Old Vandals home page'),br, a({-href=>"mailto: $EMAIL"},
	"Email Webmaster")),,
	end_html;
	exit(0);
}

sub new_post {
	my $email = param('email');
	validate_email($email) if $email;
	my $name = clean(param('name'));
	my $subject = clean(param('subject'));
	my $message = param('message');
	check_required($name,$subject,$message);
	#get a list of top level posts
	my $forum_dir =  $BBS_DIR .'\\'. $forum;
	#chdir($forum_dir) || die "Can't cd to $forum_dir $!\n";
	opendir(DIR, $forum_dir);
	my @posts = grep { /^\d\d\d\d$/ } readdir(DIR); 
	closedir(DIR);
	my $last_post = $posts[$#posts];
	my $new_post;
	if (!$last_post) {
		$new_post = '0001';
	}
	else {
		$new_post = sprintf("%04d",$last_post++);
	}
	chdir($forum_dir) || die "Can't cd to $forum_dir $!\n";
	until (sysopen(FILE,$new_post,O_WRONLY|O_EXCL|O_CREAT,0666)){
		$new_post++;		
	}
	
	store_and_confirm(*FILE,$subject,$name,$email,$message);
	exit(0);
	
}


#this sub shows a message
sub show_msg {
    my $archive_flag = 0;
    $archive_flag = 1 if $forum =~ /_archive$/;
    my $return_to;
    if ($archive_flag) {
        ($return_to = $forum) =~ s/_archive$//;
    }
    
	my $msg = param('msg');
	if ($msg =~ /(^\d\d\d\d(\.\d\d\d\d)*$)/) {
		$msg = $1;
	}
	else {
		bad_input();
	}
	
	my ($post,$back,$next,$back_link,$next_link);
	
	#get a list of the posts and figure back and next buttons
	my @posts = get_list();
	for (0..$#posts) {
		next unless $posts[$_] eq $msg;
		if ($_ != 0) {$back = $posts[$_ - 1];}
		$next = $posts[$_ +1];
		last;
	}

	if ($back){
		$back_link = "$script?forum=$forum&task=show_msg&msg=$back";
	}
	if ($next) {
		$next_link = "$script?forum=$forum&task=show_msg&msg=$next";
	}
	
	my $forum_dir =  $BBS_DIR .'\\'. $forum;
	chdir($forum_dir);
	open (POST, "$msg") || die "Can't open $msg: $!";
	my $content = <POST>;
	close(POST);
	my ($subject,$author,$email,$date,$message) = split(/\n/,$content,5);
	$date = get_date($date);
	print header,
	start_html(-bgcolor=>$BG,-text=>$TX,-link=>$LL,-vlink=>$VL,
    -background=>$BGIMG,-title=>$subject),
    
    h1({align=>'center'},"$forum_label"),
    h2({align=>'center'},"$subject");
    print '<center><table bgcolor=#ffffff cellspacing=4 cellpadding=2 border=0>';

    if (!$archive_flag) {
        print '<td align=center valign=middle>',
        a({-href=>"$script?forum=$forum&task=reply_form&msg=$msg"},b('Post Reply')),
        '</td>';
    }
    
    if ($back_link) {
        print '<td align=center valign=middle>',
        a({-href=>$back_link},b('Previous Post')),
        '</td>';
    }
    
    if ($next_link) {
        print '<td align=center valign=middle>',
        a({-href=>$next_link},b('Next Post')),
        '</td>';
    }
    
    if ($archive_flag) {
        print '<td align=center valign=middle>',
        a({-href=>"$script?task=list&forum=$forum"},b('Archived Message List')),
        '</td>';
        
        print '<td align=center valign=middle>',
   	    a({-href=>"$script?forum=$return_to&task=list"},b('Return to ', get_label($return_to))),
   	    '</td>';
    }
    else {
        print '<td align=center valign=middle>',
        a({-href=>"$script?task=list&forum=$forum"},b('Message List')),
        '</td>';
    }
    
    print '<td align=center valign=middle>', 
    a({-href=>$script},b('Forum List')),
    '</td>';
    
    print '</tr></table></center>',hr;
    
    print table(
    	Tr({-align=>'left'},
    	th('Posted by:'),td($author),
    	),
    	Tr({-align=>'left'},
    	th('Email:'),td($email ? a({-href=>"mailto:$email"},$email) : 'Not Entered'),
    	),
    	Tr({-align=>'left'},
    	th('Date:'),td($date),
    	),
    	Tr({-align=>'left',-valign=>'top'},
    	th('Message:'),td(text_to_html($message)),
    	),
    ),p,
    hr;
    
  		
    end_html;
    exit(0);
}
	
sub get_list {
	my $forum_dir =  $BBS_DIR .'\\'. $forum;
	my ($file,@posts);
	my $max = 0;
	
	opendir(DIR, $forum_dir) or die "Can't opendir $forum_dir: $!";
	while (defined($file = readdir(DIR))) {
	    if ($file =~ /(^\d\d\d\d(\.\d\d\d\d)*$)/) {
	        push @posts, $file;
	        #keep track of how deep the threads go, so we know how many fields
	        #to sort on
	        my $depth = (($file =~ tr/\.//) + 1);
	        $max = $depth if $depth > $max;
	    }
	}
	closedir(DIR);
    
    #top level threads sorted  reverse, others inorder of post
    my @sort_order = ('-1n',2..$max);
    my @sorted_posts = fieldsort ('\.', [@sort_order], @posts);
     
    return @sorted_posts;
}

#this sub shows the posts in a forum
sub show_post_list {
	my $forum_dir =  $BBS_DIR . '\\'.$forum;
	chdir($forum_dir)  || die "Can't chdir $forum_dir: $!";
	my $marked = shift;
	my $last_visit = cookie($forum);
	my @posts = get_list();
	my ($archive,$archive_path,$return_to,$archive_flag);
	$archive = $forum . '_archive';
	$archive_path = $BBS_DIR . $archive;
	if ($forum =~ /_archive$/) {
	    $archive_flag = 1;
	}
	
	
	#if we came here thru an archive request we need to fix forum name
	($return_to = $forum) =~ s/_archive$//;

    # if we are doing this after marking message read,
    #the header was already printed
    if (!$marked) { 
    	print header;
    }
  
	print start_html(-bgcolor=>$BG,-text=>$TX,-link=>$LL,-vlink=>$VL,
    -background=>$BGIMG,-title=>$forum_label),
    h1({align=>'center'},$forum_label),
    #'<center>',
   	 #'Select a message from the list below',p;
   	 '<center><table bgcolor=#ffffff cellspacing=4 cellpadding=2 border=0><tr>';
   	 unless ($archive_flag) {
   	    print '<td align=center valign=middle>',
   	    a({-href=>"$script?forum=$forum&task=new_thread_form"},b('New Post')),
   	    '</td>';
   	}
   	 print '<td align=center valign=middle>',
   	 a({-href=>$script},b('Forum List')),
   	 '</td>';
   	 #only show archive link if there is an archive for this forum
   	 #and we aren't already in archive view
   	 if  ((-e $archive_path) && (!$archive_flag) ){
   	    print '<td align=center valign=middle>',
   	    a({-href=>"$script?forum=$archive&task=list_archive"},b('View ', get_label($archive))),
   	    '</td>';
   	 }
   	 elsif ($task eq 'list_archive') {
   	    print '<td align=center valign=middle>',
   	    a({-href=>"$script?forum=$return_to&task=list"},b('Return to ', get_label($return_to))),
   	    '</td>';
   	}
   	
   	if ( (!$archive_flag) && (@posts) ){
   	    print '<td align=center valign=middle>',
    	a({-href=>"$script?forum=$forum&task=mark_read"},b('Mark All Messages Read')),
    	'</td>';
    }
       	
   	print '</tr></table></center><hr>';
    
	my $item;
	my $depth = 0; #this is how deep our list tags are
	
	if (!@posts) {
    	print center('No posts in this forum.');
    }
    
    else {
        if ($archive_flag) {
    	    print center(b('To reply to archive messages, start a new post in the forum.')),p;
    	}
    	
    	print b('Messages in this ' ,$archive_flag ? 'archive' : 'forum',':'),br;
		foreach $item (@posts) {
			my $count = (($item =~ tr/\.//) + 1);  #get the reply depth count
			open (POST, "$item")  || die "Can't open $item: $!";
			my $content = <POST>;
			close(POST);
			my ($subject,$author,$email,$post_time) = split(/\n/,$content);
			my $date = get_date($post_time);
	
			if ($depth < $count){ #need to go one deeper
				print '<ul>';
				$depth++;
			}
			if ($depth > $count) { #need to back up one level
				my $diff = $depth - $count;
				for (1..$diff) {
					print '</ul>';
					$depth--;
				}
			}
			my $link = "$script?forum=$forum&task=show_msg&msg=$item";
			if ($email) {
				print '<li>',a({-href=>$link},$subject), ' by ', a({-href=>"mailto:$email"}, $author), " ($date)";
				if (($last_visit) && ($post_time > $last_visit)) {
					print ' <font color = "red">NEW</font>' unless $marked;
				}
				
			}
			else {
				print '<li>',a({-href=>$link},$subject), ' by ', $author, " ($date)";
				if (($last_visit) && ($post_time > $last_visit)) {
					print ' <font color = "red">NEW</font>' unless $marked;
				}
			}
			
			print "\n";
		}
		
		for (1..$depth) { #clear them all out
			print '</ul>';
		}
	}
	
	print hr,
	font({-size=>'-1'},a({-href=>$HOME,-target=>'_blank'},
	'Return to Old Vandals home page'),br, a({-href=>"mailto: $EMAIL"},
	"Email Webmaster")),,

	end_html;
	
	exit(0);
}
#end show_post_list


sub get_label {
	my $label = $_[0];
	$label =~ s/_/\x20/g;      #switch underlines for spaces
	$label =~ s/\b(\w)/\U$1/g; #capitalize first letter of each word
	return $label;
}

sub validate_email {
	my $email = shift;

	#so far this check is pretty good
	if ($email !~ /^[\w\-\.\!\%\+]+\@[a-zA-z0-9\-]+(\.[a-zA-Z0-9\-]+)*\.[a-zA-Z0-9\-]+$/){
		print header,
	start_html(-bgcolor=>$BG,-text=>$TX,-link=>$LL,-vlink=>$VL,
    -background=>$BGIMG,-title=>"Form Error"),
		h2('Invalid Email Address'),
		'It appears that you did not enter a valid email address.',p,
		'Please correct the form before submitting.',p,
		a({href=>'javascript:history.go(-1);'},'Please try again.'),
		end_html;
		exit(0);
	}
}

sub get_date {
	my $time = shift;
    my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = localtime($time);

	my $month_name = ('Jan','Feb','Mar','April','May','June','July',
    'Aug','Sept','Oct','Nov','Dec')[$mon];
    
    $year += 1900;
    
    my $date = "$month_name $mday, $year";
    return $date;
}

sub text_to_html {
#since most messages will be read as html, convert these entities
	my $str = shift;
	$str=~s/&/&/g;
    $str=~s/\"/"/g;
	$str =~ s/</</g;
	$str =~ s/>/>/g;
	$str =~ s/\n\n/<p>/g;
	$str =~ s/\n/<br>/g;
	return $str;
}


sub clean {
#prevent any image tags, etc. used in subject and name fields
	my $str = shift;
	$str =~ s/<//g;
	$str =~ s/>//g;
	return $str;
}

sub check_required(){
	my ($name,$subject,$message) = @_;
	my @empty;
	if (!$name) {
		push @empty, 'Name<br>';
	}
	if (!$subject) {
		push @empty, 'Subject<br>';
	}
	if (!$message) {
		push @empty, 'Message<br>';
	}
	
	if (@empty) {
		print header,
	start_html(-bgcolor=>$BG,-text=>$TX,-link=>$LL,-vlink=>$VL,
    -background=>$BGIMG,-title=>"Form Error"),
		h2('Empty Form Fields'),
		'The following required fields were not filled in.',p,
		@empty,p,
		a({href=>'javascript:history.go(-1);'},'Please try again.'),
		end_html;
		exit(0);
	}
}		

sub store_and_confirm {
	my ($fh,$subject,$name,$email,$message) = @_;
	
	my $time_stamp = time;
	my $date = get_date($time_stamp);
	
	print $fh $subject . "\n";
	print $fh $name . "\n";
	print $fh $email . "\n";
	print $fh $time_stamp . "\n";
	print $fh $message . "\n";
	close($fh);
	
	print header,
	start_html(-bgcolor=>$BG,-text=>$TX,-link=>$LL,-vlink=>$VL,
    -background=>$BGIMG,-title=>"$forum_label"),
    
    h1({align=>'center'},"$forum_label"),
    h2({align=>'center'},'Message Posted'),
    
    '<center><table bgcolor=#ffffff cellspacing=4 cellpadding=2 border=0><tr>',
    '<td align=center valign=middle>',
    a({-href=>"$script?task=list&forum=$forum"},b('Message List')),
    '</td>',
    '<td align=center valign=middle>',
    a({-href=>"$script"},b('Forum List')),
    '</td>',
    '</tr></table></center>',

    hr,
    
    
    'The following message has been posted:',p,
    table(
    	Tr({-align=>'left'},
    	th('Posted by:'),td($name),
    	),
    	Tr({-align=>'left'},
    	th('Email:'),td($email ? $email : 'Not Entered'),
    	),
    	Tr({-align=>'left'},
    	th('Date:'),td($date),
    	),
    	Tr({-align=>'left'},
    	th('Subject:'),td($subject),
    	),
    	Tr({-align=>'left',-valign=>'top'},
    	th('Message:'),td(text_to_html($message)),
    	),
    ),p,hr,
    
    
	font({-size=>'-1'},a({-href=>$HOME,-target=>'_blank'},
	'Return to Old Vandals home page'),br, a({-href=>"mailto: $EMAIL"},
	"Email Webmaster")),,
	end_html;
		
}

sub bad_input {
		print header,
	start_html(-bgcolor=>$BG,-text=>$TX,-link=>$LL,-vlink=>$VL,
    -background=>$BGIMG,-title=>"Error"),
		h2('Bad News!'),
		'It appears that your input contains illegal characters.',
		end_html;
		exit(0);
}

#generic sort function by Joseph Hall, joseph@5sigma.com 
sub fieldsort {
	my ($sep, $cols);
	if (ref $_[0]) {
		$sep = '\\s+'
	} 
	else {
		$sep = shift;
	}
	unless (ref($cols = shift) eq 'ARRAY') {
		die "fieldsort columns must be in anon array";
	}
	my (@sortcode, @col);
	my $col = 1;
	for (@$cols) {
		my ($a, $b) = /^-/ ? qw(b a) : qw(a b);
		my $op = /n$/ ? '<=>' : 'cmp';
		push @col, (/(\d+)/)[0] - 1;
		push @sortcode, "\$${a}->[$col] $op \$${b}->[$col]";
	$col++;
	 }
	my $sortfunc = eval "sub { " . join (" or ", @sortcode) . " } ";
	my $splitfunc = eval 'sub { (split /$sep/o, $_)[@col] } ';
	return
	map $_->[0],
	sort { $sortfunc->() }
	map [$_, $splitfunc->($_)],
	@_;

}

"To educate a man is to educate an individual; to educate a woman is to educate a nation"
Dr. Aggrey, Ghana.

 

[ChrisHunt]

Is this (now) running on a unix server? You may need to set permissions on those directories and the files they contain so that the script can read them. The script will be running with a different user id that the one you use to ftp. Exactly how you do this depends on your software, but the unix command you'll need will be [tt]chmod[/tt].

-- Chris Hunt
Webmaster & Tragedian
Extra Connections Ltd