###############################################################################
# Subs.pl                                                                     #
###############################################################################
# YaBB: Yet another Bulletin Board                                            #
# Open-Source Community Software for Webmasters                               #
# Version:        YaBB 2.2.1                                                  #
# Packaged:       March 5, 2008                                               #
# Distributed by: http://www.yabbforum.com                                    #
# =========================================================================== #
# Copyright (c) 2000-2008 YaBB (www.yabbforum.com) - All Rights Reserved.     #
# Software by:  The YaBB Development Team                                     #
#               with assistance from the YaBB community.                      #
# Sponsored by: Xnull Internet Media, Inc. - http://www.ximinc.com            #
#               Your source for web hosting, web design, and domains.         #
###############################################################################

$subsplver = 'YaBB 2.2.1 $Revision: 1.129.2.25 $';
if ($debug) { &LoadLanguage('Debug'); }

use subs 'exit';
$yymain = '';
$yyjavascript = '';
$yyjavascriptlink = '';
$CGITempFile::TMPDIRECTORY = "$uploaddir";

# set line wrap limit in Display.
$linewrap = 80;
$newswrap = 0;

$langopt = "";

# get the current date/time
$date = int(time + $timecorrection);

# flag for empty pm folders
$emptyPMfolders = 0;

# parse the query string
&readform;                                   

$uid = substr($date, length($date) - 3, 3);
$session_id = $cookiesession_name;

$randaction = substr($date,0,length($date)-2);
chomp $randaction;

$headerstatus = qq~200 OK~;

$user_ip = $ENV{'REMOTE_ADDR'};

if ($user_ip eq "127.0.0.1") {
	if    ($ENV{'HTTP_CLIENT_IP'}       && $ENV{'HTTP_CLIENT_IP'}       ne "127.0.0.1") { $user_ip = $ENV{'HTTP_CLIENT_IP'}; }
	elsif ($ENV{'X_CLIENT_IP'}          && $ENV{'X_CLIENT_IP'}          ne "127.0.0.1") { $user_ip = $ENV{'X_CLIENT_IP'}; }
	elsif ($ENV{'HTTP_X_FORWARDED_FOR'} && $ENV{'HTTP_X_FORWARDED_FOR'} ne "127.0.0.1") { $user_ip = $ENV{'HTTP_X_FORWARDED_FOR'}; }
}
@numbers = split(/\./, $user_ip); 
my $ip_number = pack("C4", @numbers); 
$user_host = (gethostbyaddr($ip_number, 2))[0];
$user_agent = $ENV{'HTTP_USER_AGENT'}; 

if (-e ("YaBB.cgi")) { $yyext = "cgi"; }
else { $yyext = "pl"; }
if (-e ("AdminIndex.cgi")) { $yyaext = "cgi"; }
else { $yyaext = "pl"; }

sub nopostorder {
	@nopostorder = ();
	if(!keys(%NoPost)) { return; }	
	if (!-e "$vardir/nopostorder.txt") {
		fopen(NPORDER, ">$vardir/nopostorder.txt",1);
		while (($nopostkey, $nopostvalue) = each(%NoPost)) {
			print NPORDER "$nopostkey\n";
		}
		fclose(NPORDER);
	}
	fopen(NPORDER, "$vardir/nopostorder.txt");
	@nopostorder = <NPORDER>;
	fclose(NPORDER);
}

sub automaintenance {
	my $maction = $_[0];
	my $mreason = $_[1];
	if (lc($maction) eq "on") {
		fopen (MAINT, ">$vardir/maintenance.lock");
		print MAINT qq~Remove this file if your board is in maintenance for no reason\n~;
		fclose (MAINT);
		if ($mreason eq "low_disk"){ 
			&LoadLanguage('Error');
			&alertbox($error_txt{'low_diskspace'}); 
		}
	}
	if (lc($maction) eq "off") {
		unlink "$vardir/maintenance.lock" || &admin_fatal_error("cannot_open_dir","$vardir/maintenance.lock");
	}
}

sub getnewid {
	my $newid = int(time);
	while (-e "$datadir/$newid.txt") { ++$newid; }
	return $newid;
}

sub undupe {
	@in  = @_;
	@out = ();
	foreach $check (@in) {
		$duped = 0;
		foreach $checkout (@out) {
			if ($checkout eq $check) { $duped = 1; last; }
		}
		if ($duped == 0) {
			push(@out, $check);
		}
	}
	return @out;
}

sub exit {
	local $| = 1;
	local $\ = '';
	print '';
	CORE::exit($_[0] || 0);
}

sub header {
	my %params = @_;
	my $ret    = "";
	if ($params{'-status'}) {
		if ($yyIIS) {
			$ret .= "HTTP/1.0 $params{'-status'}\n";
		} else {
			$ret .= "Status: $params{'-status'}\n";
		}
	}
	if (!$cachebehaviour || $cachebehaviour == 0) {
		$ret .= qq~Cache-Control: no-cache, must-revalidate\n~;
		$ret .= qq~Pragma: no-cache\n~;
	}
	if ($params{'-cookie'}) {
		my (@cookie) = ref($params{'-cookie'}) && ref($params{'-cookie'}) eq 'ARRAY' ? @{ $params{'-cookie'} } : $params{'-cookie'};
		foreach (@cookie) {
			$ret .= "Set-Cookie: $_\n";
		}
	}
	if ($params{'-location'}) {
		$ret .= "Location: $params{'-location'}\n";
	}
	$params{'-charset'} = "; charset=$params{'-charset'}" if $params{'-charset'};
	$params{'Content-Encoding'} = "Content-Encoding: $params{'Content-Encoding'}\n" if $params{'Content-Encoding'};
	$ret .= "$params{'Content-Encoding'}Content-Type: text/html$params{'-charset'}\r\n\r\n";
	return $ret;
}

sub cookie {
	my %params = @_;

	if ($params{'-expires'} =~ /\+(\d+)m/) {
		my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime(time + $1 * 60);

		$year += 1900;
		my @mos = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
		my @dys = ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");
		$mon  = $mos[$mon];
		$wday = $dys[$wday];

		$params{'-expires'} = sprintf("%s, %02i-%s-%04i %02i:%02i:%02i GMT", $wday, $mday, $mon, $year, $hour, $min, $sec);
	}

	$params{'-path'}    = " path=$params{'-path'};"       if $params{'-path'};
	$params{'-expires'} = " expires=$params{'-expires'};" if $params{'-expires'};

	return "$params{'-name'}=$params{'-value'};$params{'-path'}$params{'-expires'}";
}

sub redirectexit {
	if ($gzcomp && $gzaccept) {
		if ($yySetCookies1 || $yySetCookies2 || $yySetCookies3) {
			print header(-status            => '302 Moved Temporarily',
				'Content-Encoding' => 'gzip',
				-cookie   => [$yySetCookies1, $yySetCookies2, $yySetCookies3],
				-location => $yySetLocation);
		} else {
			print header(-status            => '302 Moved Temporarily',
				'Content-Encoding' => 'gzip',
				-location          => $yySetLocation);
		}
	} else {
		if ($yySetCookies1 || $yySetCookies2 || $yySetCookies3) {
			$cookiewritten = "Cookie Set";
			print header(-status => '302 Moved Temporarily',
				-cookie   => [$yySetCookies1, $yySetCookies2, $yySetCookies3],
				-location => $yySetLocation);
		} else {
			print header(-status   => '302 Moved Temporarily',
				-location => $yySetLocation);
		}
	}
	exit;
}

sub redirectinternal {
	if ($currentboard) {
		if ($INFO{'num'}) { require "$sourcedir/Display.pl"; &Display; }
		else { require "$sourcedir/MessageIndex.pl"; &MessageIndex; }
	} else {
		require "$sourcedir/BoardIndex.pl";
		&BoardIndex;
	}
	exit;
}

sub ImgLoc {
	if (!-e "$forumstylesdir/$useimages/$_[0]") { $thisimgloc = qq~img src="$forumstylesurl/default/$_[0]"~; }
	else { $thisimgloc = qq~img src="$imagesdir/$_[0]"~; }
	return $thisimgloc;
}

sub ImgLoc2 {
	if (!-e "$forumstylesdir/$useimages/$_[0]") { $thisimgloc = qq~$forumstylesurl/default/$_[0]~; }
	else { $thisimgloc = qq~$imagesdir/$_[0]~; }
	return $thisimgloc;
}

sub ImgLoc3 {
	if (!-e "$forumstylesdir/$useimages/$_[0]") { $thisimgloc = qq~$forumstylesurl/default/$_[0]~; }
	else { $thisimgloc = qq~$imagesdir/$_[0]~; }
	return $thisimgloc;
}

sub template {
	my $gzaccept = $ENV{'HTTP_ACCEPT_ENCODING'} =~ /\bgzip\b/ || $gzforce;
	#print header
	if ($gzcomp && $gzaccept) {
		if ($yySetCookies1 || $yySetCookies2 || $yySetCookies3) {
			$cookiewritten = "Cookie Set";
			print header(-status            => $headerstatus,
				'Content-Encoding' => 'gzip',
				-cookie  => [$yySetCookies1, $yySetCookies2, $yySetCookies3],
				-charset => $yycharset);
		} else {
			print header(-status            => $headerstatus,
				'Content-Encoding' => 'gzip',
				-charset           => $yycharset);
		}
	} else {
		if ($yySetCookies1 || $yySetCookies2 || $yySetCookies3) {
			$cookiewritten = "Cookie Set";
			print header(-status => $headerstatus,
				-cookie  => [$yySetCookies1, $yySetCookies2, $yySetCookies3],
				-charset => $yycharset);
		} else {
			print header(-status  => $headerstatus,
				-charset => $yycharset);
		}
	}
	if ($yytitle ne $error_txt{'error_occurred'}) { 
		if (!$iamguest || ($iamguest && $guestaccess == 1))	{ $yyforumjump = &jumpto; }
	}
	$yyposition = $yytitle;
	$yytitle    = "$mbname - $yytitle";
	$yyimages        = $imagesdir;
	$yydefaultimages = $defaultimagesdir;
	$yystyle         = qq~<link rel="stylesheet" href="$forumstylesurl/$usestyle.css" type="text/css" />~;
	$yystyle      =~ s~$usestyle\/~~g;

	# This is for the Help Center and anywhere else that wants to add inline CSS.
	$yystyle      .= $yyinlinestyle;
	$yystylesheet  = $yystyle;

	if (!$usehead) { $usehead = qq~default~; }
	$yytemplate = "$templatesdir/$usehead/$usehead.html";
	fopen(TEMPLATE, $yytemplate) || die("$maintxt{'23'}: $yytemplate");
	my $output = join('', <TEMPLATE>);
	fclose(TEMPLATE);
	$newsloaded = 0;
	
	if (($iamadmin || $iamgmod) && $maintenance == 1) { $yyadmin_alert = qq~<br /><span class="highlight"><b>$load_txt{'616'}</b></span>~; }

	$yyboardname = "$mbname";
	$yyboardlink = qq~<a href="$scripturl" class="nav">$mbname</a>~;
	$yytime      = &timeformat($date, 1);

	if($output =~ /\{yabb tabmenu\}/g) {
		require "$sourcedir/TabMenu.pl";
		&mainMenu;
	}
	else {


		$yymenu = qq~<a href="$scripturl">$img{'home'}</a>$menusep<a href="$scripturl?action=help" style="cursor:help;">$img{'help'}</a>~;
		# remove search from menu if disabled by the admin
		if ($maxsearchdisplay > -1) {
			$yymenu .= qq~$menusep<a href="$scripturl?action=search">$img{'search'}</a>~;
		}
		if (!$ML_Allowed || ($ML_Allowed == 1 && !$iamguest) || ($ML_Allowed == 2 && $staff) || ($ML_Allowed == 3 && ($iamadmin || $iamgmod))) {
			$yymenu .= qq~$menusep<a href="$scripturl?action=ml">$img{'memberlist'}</a>~;
		}

		if ($iamadmin) { $yymenu .= qq~$menusep<a href="$boardurl/AdminIndex.$yyaext">$img{'admin'}</a>~; }
		if ($iamgmod) {
			if (-e ("$vardir/gmodsettings.txt")) {
				require "$vardir/gmodsettings.txt";
			}
			if ($allow_gmod_admin) { $yymenu .= qq~$menusep<a href="$boardurl/AdminIndex.$yyaext">$img{'admin'}</a>~; }
		}
		if ($sessionvalid == 0 && !$iamguest) {
			$sesredir = "";
			unless($action eq "revalidatesession" || $action eq "revalidatesession2") {
				$sestestenv = $testenv;
				$sestestenv =~ s/\=/\~/g;
				$sestestenv =~ s/;/x3B/g;
				if($sestestenv) { $sesredir = qq~;sesredir=$sestestenv~; }
			}
			$yymenu .= qq~$menusep<a href="$scripturl?action=revalidatesession$sesredir">$img{'sessreval'}</a>~;
		}
		if ($iamguest) {
			$yymenu .= qq~$menusep<a href="$scripturl?action=login">$img{'login'}</a>~;
			if ($regtype != 0) { $yymenu .= qq~$menusep<a href="$scripturl?action=register">$img{'register'}</a>~; }
			if ($PMenableGuestButton && $PM_level > 0 && $PMenableBm_level > 0)	{
				$yymenu .= qq~$menusep<a href="$scripturl?action=guestpm">$img{'pmadmin'}</a>~; }
		} 
		else {
			## pointing towards pm now
			$yymenu .= qq~$menusep<a href="$scripturl?action=mycenter">$img{'mycenter'}</a>~;
			$yymenu .= qq~$menusep<a href="$scripturl?action=logout">$img{'logout'}</a>~;
		}

	}

	$yylangChooser = "";
	if (($iamguest && !$guestLang) && $enable_guestlanguage && $guestaccess)	{
		if(!$langopt)	{&guestLangSel;}
		if($morelang > 1) {
			$yylangChooser = qq~$guest_txt{'sellanguage'}: <form action="$scripturl?action=guestlang" method="post" name="sellanguage">
			<select name="guestlang" onchange="submit();">
			$langopt
			</select>
			<noscript><input type="submit" value="$maintxt{'32'}" class="button" /></noscript>
			</form>~;
		}
	}
	elsif(($iamguest && $guestLang) && $enable_guestlanguage && $guestaccess)	{
		if(!$langopt)	{&guestLangSel;}
		if($morelang > 1) {
			$yylangChooser = qq~$guest_txt{'changelanguage'}: <form action="$scripturl?action=guestlang" method="post" name="changelanguage">
			<select name="guestlang" onchange="submit();">
			$langopt
			</select>
			<noscript><input type="submit" value="$maintxt{'32'}" class="button" /></noscript>
			</form>~;
		}
	}
	if ($iamguest) {  
        $toffs = $timeoffset;  
        $dstoffs = $dstoffset;  
	} else {  
        $toffs = ${$uid.$username}{'timeoffset'};  
        $dstoffs = ${$uid.$username}{'dsttimeoffset'} || $dstoffset;   
	}  
	(undef, undef, $yhours, undef) = gmtime(time + (3600 * ($toffs + $dstoffs)));  
	if ($yhours > 12 && $yhours < 18) { $wmessage = $maintxt{'247a'}; } # Afternoon  
	elsif ($yhours <= 12 && $yhours > 6) { $wmessage = $maintxt{'247m'}; } # Morning  
	else { $wmessage = $maintxt{'247e'}; } # Evening 
	if ($regtype == 0) {
		$yyuname = $iamguest ? qq~$maintxt{'248'} $maintxt{'28'}. $maintxt{'249'} <a href="$scripturl?action=login">$maintxt{'34'}</a>~ : qq~$wmessage $realname, ~;
	} elsif($iamguest) {
		$yyuname = $iamguest ? qq~$maintxt{'248'} $maintxt{'28'}. $maintxt{'249'} <a href="$scripturl?action=login">$maintxt{'34'}</a> $maintxt{'377'} <a href="$scripturl?action=register">$maintxt{'97'}</a>~ : qq~$wmessage $realname, ~;
	} elsif($PM_level == 0 || ($PM_level == 2 && !$iamadmin && !$iamgmod && !$iammod ) || ($PM_level == 3 && !$iamadmin && !$iamgmod) )	{
		$yyuname = qq~$wmessage $realname~;
	} elsif($PM_level == 1 || ($PM_level == 2 && ($iamadmin || $iamgmod || $iammod ) || ($PM_level == 3 && ($iamadmin || $iamgmod) )))	{
		$yyuname = qq~$wmessage $realname, ~;
	}
	# This next line fixes problems created when a fatal_error is called before Security.pl is loaded
	# We don't want to require since it's an error and trying to do anything extra for an error could be bad
	if ($output =~ m~<yabb copyright>~ || $output =~ m~{yabb copyright}~) { $yycopyin = 1; }	## new template style in also
	$yysearchbox = '';
	unless ($iamguest && $guestaccess == 0) {
		if ($maxsearchdisplay > -1) {
			$yysearchbox = qq~
		<script language="JavaScript1.2" src="$ubbcjspath" type="text/javascript"></script>
		<form action="$scripturl?action=search2" method="post">
		<input type="hidden" name="searchtype" value="allwords" />
		<input type="hidden" name="userkind" value="any" />
		<input type="hidden" name="subfield" value="on" />
		<input type="hidden" name="msgfield" value="on" />
		<input type="hidden" name="age" value="31" />
		<input type="hidden" name="numberreturned" value="$maxsearchdisplay" />
		<input type="hidden" name="oneperthread" value="1" />
		<input type="hidden" name="action" value="dosearch" />
		<input type="hidden" name="searchboards" value="!all" />
		<input type="text" name="search" size="16" style="font-size: 11px; vertical-align: middle;" />
		<input type="image" src="$imagesdir/search.gif" style="border: 0; background-color: transparent; margin-right: 5px; vertical-align: middle;" />
		</form>
		~;
		}
	}
	if ($enable_news) {
		fopen(NEWS, "$vardir/news.txt");
		@newsmessages = <NEWS>;
		fclose(NEWS);
		my $newscount = @newsmessages;
		if ($newscount) { $yynewstitle = qq~<b>$maintxt{'102'}:</b> ~; }
		undef $guest_media_disallowed;
		srand;
		$newswrap = 40;
		if ($shownewsfader == 1) {
			$fadedelay = $maxsteps * $stepdelay;
			$yynews .= qq~
			<script language="JavaScript1.2" type="text/javascript">
				<!--
					var maxsteps = "$maxsteps";
					var stepdelay = "$stepdelay";
					var fadelinks = $fadelinks;
					var delay = "$fadedelay";
					var bcolor = "$color{'faderbg'}";
					var tcolor = "$color{'fadertext'}";
					var fcontent = new Array();
					var begintag = "";~;
			$newsloaded = 1;
			for (my $j = 0; $j < @newsmessages; $j++) {
				$newsmessages[$j] =~ s/\n|\r//g;
				if ($i != 0) { $yymain .= qq~\n~; }
				$message = $newsmessages[$j];
				&wrap;
				if ($enable_ubbc) {
					if (!$yyYaBBCloaded) { require "$sourcedir/YaBBC.pl"; }
					&DoUBBC;
				}
				&wrap2;
				$message =~ s/\"/\\\"/g;    # "
				&ToChars($message);
				$yynews .= qq~
					fcontent[$j] = "$message";\n~;
			}
			$yynews .= qq~
					var closetag = '';
					//window.onload = fade;
				// -->
			</script>
			<script language="JavaScript1.2" type="text/javascript" src="$faderpath"></script>
			~;
		} else {
			$message = $newsmessages[int rand(@newsmessages)];
			&wrap;
			if ($enable_ubbc) {
				# No need to check if it's loaded; Perl does that with the %INC hash automatically
				require "$sourcedir/YaBBC.pl";
				&DoUBBC;
			}
			&wrap2;
			&ToChars($message);
			$yynews = $message;
		}
		$newswrap = 0;
	}
	# Moved this down here so it shows more
	##  pushed to own file for flexibility
	if ($debug == 1 or ($debug == 2 && $iamadmin)) {require "$sourcedir/Debug.pl"; &Debug;}
	$yyurl      = $scripturl;
	$addsession = qq~<input type="hidden" name="formsession" value="$formsession" /></form>~;
	## old tag template style decoding ##
	$output =~ s~<yabb\s+(\w+)>~${"yy$1"}~g;
	## new tag template style decoding ##
	$output =~ s~{yabb\s+(\w+)}~${"yy$1"}~g;
	$output =~ s~<includefile="(\S+)">~${\(IncludeFile($1))}~g;
	$output =~ s~(a href\=\S+?action\=viewprofile\;username\=.+?)(\>)~$1 rel=\"nofollow\"$2~isg;
	if($imagesdir ne $defaultimagesdir) {
		$output =~ s~img src\=\"$imagesdir\/(.+?)\"~&ImgLoc($1)~eisg;
		$output =~ s~img src\=\'$imagesdir\/(.+?)\'~"img src\=\'" . &ImgLoc2($1) . "\'"~eisg; # For Javascript generated images
		$output =~ s~\.src\=\'$imagesdir\/(.+?)\'~"\.src\=\'" . &ImgLoc2($1) . "\'"~eisg; # For Javascript generated images
		$output =~ s~input type\=\"image\" src=\"$imagesdir\/(.+?)\"~"input type\=\"image\" src=\"" . &ImgLoc2($1) . "\""~eisg; # For input images
		$output =~ s~option value=\"$imagesdir\/(.+?)\"~'option value="' . &ImgLoc2($1) . '"'~eisg; # For the post page
	}
	$output =~ s~(img src\=\"$imagesdir\/.+?)title\=\"(.*?)\"(.*? \/\>)~$1$3~oig;
	$output =~ s~alt\=\"(.*?)\"~alt\=\"$1\" title\=\"$1\"~ig;
	$output =~ s~</form>~$addsession~g;

	if ($yycopyin == 0) {
		$output = q~<center><h1><b>Sorry, the copyright tag <yabb copyright> must be in the template.<br />Please notify this forum's administrator that this site is using an ILLEGAL copy of YaBB!</b></h1></center>~;
	}
	# do output
	if ($gzcomp && $gzaccept) {
		if ($gzcomp == 1) {
			$| = 1;
			open(GZIP, "| gzip -f");
			print GZIP $output;
			close(GZIP);
		} else {
			require Compress::Zlib;
			binmode STDOUT;
			print Compress::Zlib::memGzip($output);
		}
	} else {
		print $output;
	}
}




# One should never criticize his own work except in a fresh and hopeful mood.
# The self-criticism of a tired mind is suicide.
# - Charles Horton Cooley

sub IncludeFile {
	my $fname = shift;
	my $file;
	$fname =~ s/([\&;\`'\|\"*\?\~\^\(\)\[\]\{\}\$\n\r])//g;
	fopen(INCLUDE, $fname) || return '[an error occured while processing this directive]';  #'
	$file = join('', <INCLUDE>);
	fclose(INCLUDE);
	return $file;
}

sub fatal_error_logging {
	my $tmperror = $_[0];

	# This flaw was brought to our attention by S M <savy91@msn.com> Italy
	# Thanks! We couldn't make YaBB successful without the help from the bug testers.
	&ToHTML($action);
	&ToHTML($INFO{'num'});
	&ToHTML($currentboard);

	$tmperror =~ s/\n//ig;
	fopen(ERRORLOG, "+<$vardir/errorlog.txt");
	seek ERRORLOG, 0, 0;
	my @errorlog = <ERRORLOG>;
	truncate ERRORLOG, 0;
	seek ERRORLOG, 0, 0;
	chomp @errorlog;
	$errorcount = $#errorlog + 1;

	if ($elrotate) {
		while ($errorcount >= $elmax) {
			my $void = shift @errorlog;
			$errorcount = $#errorlog + 1;
		}
	}

	foreach my $formdata (keys %FORM) {
		chomp $FORM{$formdata};
		$FORM{$formdata} =~ s/\n//ig;
	}

	if ($iamguest) {
		push @errorlog, time() . "\|$date\|$user_ip\|$tmperror\|$action\|$INFO{'num'}\|$currentboard\|$FORM{'username'}\|$FORM{'passwrd'}";
	} else {
		push @errorlog, time() . "\|$date\|$user_ip\|$tmperror\|$action\|$INFO{'num'}\|$currentboard\|$username\|$FORM{'passwrd'}";
	}
	foreach (@errorlog) {
		chomp;
		if ($_ ne "") {
			print ERRORLOG $_ . "\n";
		}
	}
	fclose(ERRORLOG);

	undef($tmperror);
}

# The error message is the Truth.  The error message is God.
# - File Of Good Advice.

sub fatal_error {
	&LoadLanguage('Error');
	# Gets filename and line where fatal_error was called.
	# Need to go further back to get correct subroutine name,
	# otherwise will print fatal_error as current subroutine!
	(undef, $e_filename, $e_line) = caller(0);
	(undef, undef, undef, $e_subroutine) = caller(1);
	(undef, $e_subroutine) = split(/::/, $e_subroutine);
	my($e,$t,$v) =@_;
	if ($t || $e) { $ot = "$maintxt{'error_description'}: $error_txt{$e} $t"; }
	if (($debug == 1 or ($debug == 2 && $iamadmin)) && ($e_filename || $e_line || $e_subroutine)) { $l = "<br />$maintxt{'error_location'}: $e_filename<br />$maintxt{'error_line'}: $e_line<br />$maintxt{'error_subroutine'}: $e_subroutine"; }
	if ($v) { $v = "<br />$maintxt{'error_verbose'}: $!"; }

	if ($elenable) {
		&fatal_error_logging("$ot$l$v");
	}
	# Commented the line below out to prevent recursion when errors occur
	# in the loadIMs routine. It looks OK without loading them, anyway.
	#if(!$iamguest){&LoadIMs; }
	if($e eq "no_access" || $e eq "cannot_open" || $e eq "not_found" || $e eq "members_only" || $e eq "im_members_only" || $e eq "no_topic_found" || $e eq "no_board_found" || $e =~ m/no_perm/){
		$headerstatus = qq~404 Not Found~;
	}

	$yymain .= qq~
<table border="0" width="80%" cellspacing="1" class="bordercolor" align="center" cellpadding="4">
  <tr>
    <td class="titlebg"><span class="text1"><b>$error_txt{'error_occurred'}</b></span></td>
  </tr><tr>
    <td class="windowbg"><br /><span class="text1">$ot$l$v</span><br /><br /></td>
  </tr>
</table>
<center><br /><a href="javascript:history.go(-1)">$maintxt{'193'}</a></center>
~;
	$yytitle = "$error_txt{'error_occurred'}";
	&template;
	exit;

}

sub admin_fatal_error {
	&LoadLanguage('Error');
	# Gets filename and line where fatal_error was called.
	# Need to go further back to get correct subroutine name,
	# otherwise will print fatal_error as current subroutine!
	(undef, $e_filename, $e_line) = caller(0);
	(undef, undef, undef, $e_subroutine) = caller(1);
	(undef, $e_subroutine) = split(/::/, $e_subroutine);
	my($e,$t,$v) =@_;
	if ($t || $e) { $ot = "$maintxt{'error_description'}: $error_txt{$e} $t"; }
	if (($debug == 1 or ($debug == 2 && $iamadmin)) && ($e_filename || $e_line || $e_subroutine)) { $l = "<br />$maintxt{'error_location'}: $e_filename<br />$maintxt{'error_line'}: $e_line<br />$maintxt{'error_subroutine'}: $e_subroutine"; }
	if ($v) { $v = "<br />$maintxt{'error_verbose'}: $!"; }

	if ($elenable) {
		&fatal_error_logging("$ot$l$v");
	}
	$yymain .= qq~
<table border="0" width="80%" cellspacing="1" class="bordercolor" align="center" cellpadding="4">
  <tr>
    <td class="titlebg"><span class="text1"><b>$error_txt{'error_occurred'}</b></span></td>
  </tr><tr>
    <td class="windowbg"><br /><span class="text1">$ot$l$v</span><br /><br /></td>
  </tr>
</table>
<center><br /><a href="javascript:history.go(-1)">$admin_txt{'193'}</a></center>
~;
	$yytitle = "$error_txt{'error_occurred'}";
	&AdminTemplate;
	exit;
}

sub FindPermalink {
	$old_env = $_[0];
	$old_env = substr($old_env,1, length($old_env));
	$permtopicfound = 0;
	$permboardfound = 0;
	$is_perm = 1;
	## strip off symlink for redirectlike e.g. /articles/ ##
	$old_env =~ s~$symlink~~g;
	## get date/time/board/topic from permalink

	($permyear, $permmonth, $permday, $permboard, $permnum) = split (/\//, $old_env);
	if(-e "$boardsdir/$permboard.txt") {
		$permboardfound = 1;
		if($permnum ne "" && -e "$datadir/$permnum.txt") {
			$new_env = qq~num=$permnum~;
			$permtopicfound = 1;
		} else { $new_env = qq~board=$permboard~; }
	}
	return $new_env;
}

sub permtimer {
	my $thetime = $_[0];
	my (undef, $pmin, $phour, $pmday, $pmon, $pyear, undef, undef, undef) = gmtime($thetime + (3600 * $timeoffset));
	my $pmon_num = $pmon + 1;
	$phour = sprintf("%02d", $phour);
	$pmin = sprintf("%02d", $pmin);
	$pyear = 1900 + $pyear;
	$pmon_num = sprintf("%02d", $pmon_num);
	$pmday = sprintf("%02d", $pmday);
	$pyear = sprintf("%04d", $pyear);
	return "$pyear/$pmon_num/$pmday";
}
	
sub readform {
	my (@pairs, $pair, $name, $value);
	if (substr($ENV{QUERY_STRING},0,1) eq "/" && $accept_permalink){$ENV{QUERY_STRING} = &FindPermalink($ENV{QUERY_STRING});}
	if ($ENV{QUERY_STRING} =~ m/action\=dereferer/) {
		$INFO{'action'} = "dereferer";
		$urlstart = index($ENV{QUERY_STRING}, "url=");
		$INFO{'url'} = substr($ENV{QUERY_STRING}, $urlstart + 4, length($ENV{QUERY_STRING}) - $urlstart + 3);
		$INFO{'url'} =~ s/\;anch\=/#/g;
		$testenv = "";
	} else {
		$testenv = $ENV{QUERY_STRING};
		$testenv =~ s/\&/\;/g;
		if(($debug == 1 or ($debug == 2 && $iamadmin)))	{$getpairs = qq~<br /><u>$debug_txt{'getpairs'}</u><br />~;}
	}
	if(($debug == 1 or ($debug == 2 && $iamadmin)))	{$getpairs .= qq~$testenv <br />~;}
	# URL encoding for web.de http://www.blooberry.com/indexdot/html/topics/urlencoding.htm
	$testenv =~ s/\%3B/;/g;
	$testenv =~ s/\%26/&/g;

	sub split_string {
		my ($string, $hash, $altdelim) = @_;

		if ($altdelim && $$string =~ m~;~) { @pairs = split(/;/, $$string); }
		else { @pairs = split(/&/, $$string); }
		foreach $pair (@pairs) {
			($name, $value) = split(/=/, $pair);
			$name  =~ tr/+/ /;
			$name  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
			$value =~ tr/+/ /;
			$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
			if(($debug == 1 or ($debug == 2 && $iamadmin)))	{$getpairs .= qq~$debug_txt{'name'} = [$name] \/ $debug_txt{'value'} = [$value] <br />~;}
			if (exists($hash->{$name})) {
				$hash->{$name} .= ", $value";
			} else {
				$hash->{$name} = $value;
			}
			
		}
	}

	split_string(\$testenv, \%INFO, 1);
	if ($ENV{'SERVER_SOFTWARE'} =~ /IIS/)	{
		($dummy,$IISver) = split( '\/', $ENV{'SERVER_SOFTWARE'});
		($IISver,$IISverM) = split( '.',$IISver);
		if(int($IISver) < 6 && int($IISverM) < 1)	{eval 'use Upload::CGI qw(:standard)';}
	}
	if ($ENV{REQUEST_METHOD} eq 'POST') {
		if ($ENV{CONTENT_TYPE} =~ /multipart\/form-data/) {
			require Upload::CGI;
			import Upload::CGI qw(:standard);
			my $query = new CGI;
			my (@keylist) = sort($query->param());
			foreach $key (@keylist) {
				# may be dealing with multiple values; need to join with comma
				$value = join(', ', $query->param($key));
				$FORM{$key} = $value;
				$postsize += length($value);
				$postsize += length($key) + 1;
			}
			if ($query->param('file')) {
				$filename = $query->param('file');
				$tmpfile  = $query->tmpFileName($filename);
				$postsize -= length('file') + 1;
			}
		} else {
			read(STDIN, my $input, $ENV{CONTENT_LENGTH});
			split_string(\$input, \%FORM);
		}
	}
	$action = $INFO{'action'} || $FORM{'action'};
	# Formsession checking moved to YaBB.pl to fix a bug.
	if($INFO{'username'} && $do_scramble_id){$INFO{'username'} = &decloak($INFO{'username'});}
	if($FORM{'username'} && $do_scramble_id && $action ne "login2" && $action ne "reminder2" && $action ne "register2" && $action ne "profile2"){$FORM{'username'} = &decloak($FORM{'username'});}
	if($INFO{'to'} && $do_scramble_id){$INFO{'to'} = &decloak($INFO{'to'});}
	if($FORM{'to'} && $do_scramble_id){$FORM{'to'} = &decloak($FORM{'to'});}
	if ($action eq 'search2') { &FromHTML($FORM{'search'}); }
	&ToHTML($INFO{'title'});
	&ToHTML($FORM{'title'});
	&ToHTML($INFO{'subject'});
	&ToHTML($FORM{'subject'});
}

sub getlog {
	if ($iamguest || $max_log_days_old == 0 || !(-e "$memberdir/$username.log")) { return; }
	my (@entries) = @_;
	unless (defined %yyuserlog) {
		%yyuserlog = ();
		my ($entry, $logentry, $name, $value, $thistime, $adate, $atime, $amonth, $aday, $ayear, $ahour, $amin, $asec);
		my $mintime = $date - ($max_log_days_old * 86400);
		fopen(GETLOG, "$memberdir/$username.log");
		my @logentries = <GETLOG>;
		fclose(GETLOG);
		foreach $entry (@entries) {
			chomp $entry;
			foreach $logentry (@logentries) {
				chomp $logentry;
				($name, $value, $thistime) = split(/\|/, $logentry);
				unless ($name)  { next; }
				if     ($value) {
					$thistime = $value;
				}
				$yyuserlog{$name} = $thistime;
			}
		}
	}
}

sub modlog {
	if ($iamguest || $max_log_days_old == 0) { return; }
	unless (defined %yyuserlog) { &getlog; }
	my ($entry, $dumbtime, $thistime) = @_;
	if ($dumbtime) {
		$thistime = $dumbtime;
	}
	unless ($thistime) {
		$thistime = $date;
	}
	$yyuserlog{$entry} = $thistime;
}

sub dumplog {
	if ($iamguest || $max_log_days_old == 0) { return; }
	if (@_) { &modlog(@_); }
	if (defined %yyuserlog) {
		fopen(DUMPLOG, ">$memberdir/$username.log");
		while ($_ = each(%yyuserlog)) {
			unless ($_) { next; }
			print DUMPLOG qq~$_||$yyuserlog{$_}\n~;
		}
		fclose(DUMPLOG);
	}
}

## standard jump to menu
sub jumpto {
	my (@masterdata, $category, @data, $found, $tmp, @memgroups, @newcatdata, $boardname);
	## jump links to messages/favourites/notifications.
	my $action = 'action=jump';
	my $onchange = qq~ onchange="if(this.options[this.selectedIndex].value) window.location.href='$scripturl' + this.options[this.selectedIndex].value;"~;
	if ($templatejump == 1) { 
		$action = 'action=';
		$onchange = '';
	}
	$selecthtml = qq~
<form method="post" action="$scripturl?$action" name="jump" style="display: inline;">
<select name="values"$onchange>
    <option value="" class="forumjump">$jumpto_txt{'to'}</option>	~;
    ## as guests don't have these, why show them?
    if (!$iamguest) { $selecthtml .= qq~
    <option value="?action=im" class="forumjumpcatm">$jumpto_txt{'mess'}</option>~ if $PM_level == 1 || ($PM_level == 2 && ($iamadmin || $iamgmod || $iammod)) || ($PM_level == 3 && ($iamadmin || $iamgmod)); $selecthtml .= qq~
    <option value="?action=favorites" class="forumjumpcatm">$jumpto_txt{'fav'}</option>
    <option value="?action=shownotify" class="forumjumpcatmf">$jumpto_txt{'note'}</option>
~;	}
	# drop in recent topics/posts lists. guests can see if browsng permitted
	$selecthtml .= qq~
	<option value="?action=recent;display=10">$recent_txt{'recentposts'}</option>
	<option value="?action=recenttopics;display=10">$recent_txt{'recenttopic'}</option>
	~;
	unless ($mloaded == 1) { require "$boardsdir/forum.master"; }
	foreach $catid (@categoryorder) {
		$boardlist = $cat{$catid};
		(@bdlist) = split(/\,/, $boardlist);
		($catname, $catperms) = split(/\|/, $catinfo{"$catid"});

		$cataccess = &CatAccess($catperms);
		if (!$cataccess) { next; }
		&ToChars($catname);
		## I've removed the dashed bands and css handles the cat highlighting.
		$selecthtml .= qq~    <option value="?catselect=$catid" class="forumjumpcat">$catname</option>~;
		foreach $board (@bdlist) {
			($boardname, $boardperms, $boardview) = split(/\|/, $board{"$board"});
			&ToChars($boardname);
			my $access = &AccessCheck($board, '', $boardperms);
			if (!$iamadmin && $access ne "granted" && $boardview != 1) { next; }
			if ($board eq $annboard && !$iamadmin && !$iamgmod) { next; }

			if ($board eq $currentboard) { $selecthtml .= "<option selected=\"selected\" value=\"?board=$board\" class=\"forumcurrentboard\">&raquo;&raquo; $boardname</option>\n"; }
			else { $selecthtml .= "<option value=\"?board=$board\">&nbsp; - $boardname</option>\n"; }
		}
	}
	$selecthtml .= qq~</select>
    <noscript><input type="submit" value="$maintxt{'32'}" class="button" /></noscript>
</form>~;
}

sub dojump {
	$yySetLocation = $scripturl . $FORM{'values'};
	&redirectexit;
}

sub moveto {
	my ($category, $boardname);
	unless ($mloaded == 1) { require "$boardsdir/forum.master"; }
	foreach $catid (@categoryorder) {
		$brdlist = $cat{$catid};
		if(!$brdlist) { next; }
		(@bdlist) = split(/\,/, $brdlist);
		($catname, $catperms) = split(/\|/, $catinfo{"$catid"});

		$cataccess = &CatAccess($catperms);
		if (!$cataccess) { next; }
		&ToChars($catname);
		$boardlist .= qq~<optgroup label="$catname">~;
		foreach $board (@bdlist) {
			($boardname, $boardperms, $boardview) = split(/\|/, $board{"$board"});
			&ToChars($boardname);
			my $access = &AccessCheck($board, '', $boardperms);
			if (!$iamadmin && $access ne "granted") { next; }
			if ($board ne $currentboard) {
				$boardlist .= qq~<option value="$board">$boardname</option>\n~;
			}
		}
		$boardlist .= qq~</optgroup>~;
	}
}

sub spam_protection {

	# Always look on the bright side of life
	# - Monty Python

	unless ($timeout) { return; }
	my ($time, $flood_ip, $flood_time, $flood, @floodcontrol);

	if (-e "$vardir/flood.txt") {
		fopen(FLOOD, "$vardir/flood.txt");
		push(@floodcontrol, "$user_ip|$date\n");
		while (<FLOOD>) {
			chomp($_);
			($flood_ip, $flood_time) = split(/\|/, $_);
			if ($user_ip eq $flood_ip && $date - $flood_time <= $timeout) { $flood = 1; }
			elsif ($date - $flood_time < $timeout) { push(@floodcontrol, "$_\n"); }
		}
		fclose(FLOOD);
	}
	if ($flood && !$iamadmin && $action eq 'post2') { &Preview("$maintxt{'409'} $timeout $maintxt{'410'}"); }
	if ($flood && !$iamadmin) {
		&fatal_error("post_flooding","$timeout $maintxt{'410'}");
	}
	fopen(FLOOD, ">$vardir/flood.txt", 1);
	print FLOOD @floodcontrol;
	fclose(FLOOD);
}

sub CountChars {
	$cliped = 0;
	$convertstr =~ s/(\[ch\d{3,}?\])/ $1/ig;

	# Don't count HTML entities against the length more than it should be
	my $htmltest = $convertstr;
	&FromHTML($htmltest);
	$convertcut += length($convertstr) - length($htmltest);
	undef $htmltest;

	# Commented...
#	while ($convertstr =~ m~\<.+?\>~g) { $convertstr =~ s/\s/&#32;/g; }
	# AK108: Not quite sure what this line intends.
	# If it's meant to convert spaces within angle backets to &#32;, then it fails at that.
	# This would work, though:
	# $convertstr =~ s!\<(.+?)\>! my $t = $1; $t =~ s/\s/\&\#32\;/g; "<$t>"!eg; # Nested regex
	$convertstr =~ s/(\<.+?\>)/ $1 /ig;
	my @cwords = split(/\s/, $convertstr);
	$convertstr = "";
	my $curword;
	foreach $curword (@cwords) {
		$curword =~ s/&#32;/ /g;
		$convertstr .= "$curword ";
		if ($curword =~ m~\[ch\d{3,}?\]~ || $curword =~ m~\<.+?\>~) {
			$convertcut += length($curword);
			if (length($convertstr) > $convertcut) {
				$clipdiff = length($curword) - (length($convertstr) - $convertcut);
				$convertcut += $clipdiff;
				$cliped = 1;
				last;
			}
		}
		if (length($convertstr) > $convertcut) {
			$cliped = 1;
			last;
		}
	}
	$convertstr =~ s/ (\<.+?\>) /$1/ig;
	$convertstr =~ s/ (\[ch\d{3,}?\])/$1/ig;
	$convertstr = substr($convertstr, 0, $convertcut);
	$convertstr =~ s/\&(\S*?)\Z//s;
	$convertstr =~ s/ \Z//;
}

sub WrapChars {
	$wrapstr =~ s/(\&\#\d{3,}?\;)/ $1/ig;
	$wrapstr =~ s~(\S{$wrapcut})~$1 ~gi;
	$tmpwrapcut = $wrapcut;
	my @wwords = split(/\s/, $wrapstr);
	$tmpwrapstr = "";
	$wrapstr    = "";
	my $curword;
	foreach $curword (@wwords) {

		if ($curword =~ m~\&\#\d{3,}?\;~) {
			$tmpwrapcut += length($curword);
		}
		if ((length($tmpwrapstr) + length($curword)) > $tmpwrapcut) {
			$wrapstr .= qq~$tmpwrapstr<br />~;
			$tmpwrapstr = "$curword ";
			$tmpwrapcut = $wrapcut;
		} else {
			$tmpwrapstr .= "$curword ";
		}
	}
	$wrapstr .= qq~$tmpwrapstr~;
	$wrapstr =~ s/ (\&\#\d{3,}?\;)/$1/ig;
	$wrapstr =~ s/ \Z//;
}

sub FromChars {
	$_[0] =~ s/&#(\d{3,});/ $1>127 ? "[ch$1]" : $& /egis;
}

sub ToChars {
	$_[0] =~ s/\[ch(\d{3,})\]/ $1>127 ? "\&#$1;" : '' /egis;
}

sub ToHTML {
	$_[0] =~ s/&/&amp;/g;
	$_[0] =~ s/"/&quot;/g;
	$_[0] =~ s/  / &nbsp;/g;
	$_[0] =~ s/</&lt;/g;
	$_[0] =~ s/>/&gt;/g;
	$_[0] =~ s/\|/&#124;/g;
	$_[0] =~ s/\{/\&#123;/g;
	$_[0] =~ s/\}/\&#125;/g;
}

sub FromHTML {
	$_[0] =~ s/&quot;/"/g;
	$_[0] =~ s/&nbsp;/ /g;
	$_[0] =~ s/&lt;/</g;
	$_[0] =~ s/&gt;/>/g;
	$_[0] =~ s/&#124;/\|/g;
	$_[0] =~ s/&#123;/\{/g;
	$_[0] =~ s/&#125;/\}/g;
	$_[0] =~ s/&amp;/&/g;
}

sub dopre {
	$_ = $_[0];
	$_ =~ s~<br \/>~\n~g;
	$_ =~ s~<br>~\n~g;
	return $_;
}

sub elimnests {
	$_ = $_[0];
	$_ =~ s~\[/*shadow([^\]]*)\]~~ig;
	$_ =~ s~\[/*glow([^\]]*)\]~~ig;
	return $_;
}

sub unwrap {
	$unwrapped = $_[0];
	$unwrapped =~ s~<yabbwrap>~~g;
	$unwrapped = qq~\[code\]$unwrapped\[\/code\]~;
	return $unwrapped;
}

sub wrap {
	if($newswrap) { $linewrap = $newswrap; }
	$message =~ s~ &nbsp; &nbsp; &nbsp;~\[tab\]~ig;
	$message =~ s~<br \/>~\n~g;
	$message =~ s~<br>~\n~g;
	$message =~ s/((\[ch\d{3,}?\]){$linewrap})/$1\n/ig;

	&FromHTML($message);
	$message =~ s~[\n\r]~ <yabbbr> ~g;
	my @words = split(/\s/, $message);
	$message = "";
	foreach $cur (@words) {
		if ($cur !~ m~www\.(\S+?)\.~ && $cur !~ m~[ht|f]tp://~ && $cur !~ m~\[\S*\]~ && $cur !~ m~\[\S*\s?\S*?\]~ && $cur !~ m~\[\/\S*\]~) { $cur =~ s~(\S{$linewrap})~$1\n~gi; }
		if ($cur !~ m~\[table(\S*)\](\S*)\[\/table\]~ && $cur !~ m~\[url(\S*)\](\S*)\[\/url\]~ && $cur !~ m~\[flash(\S*)\](\S*)\[\/flash\]~ && $cur !~ m~\[img(\S*)\](\S*)\[\/img\]~) {
			$cur =~ s~(\[\S*?\])~ $1 ~g;
			@splitword = split(/\s/, $cur);
			$cur = "";
			foreach $splitcur (@splitword) {
				if ($splitcur !~ m~www\.(\S+?)\.~ && $splitcur !~ m~[ht|f]tp://~ && $splitcur !~ m~\[\S*\]~) { $splitcur =~ s~(\S{$linewrap})~$1<yabbwrap>~gi; }
				$cur .= $splitcur;
			}
		}
		$message .= "$cur ";
	}
	$message =~ s~\[code\](.*?)\[\/code\]~&unwrap($1)~eisg;
	$message =~ s~ <yabbbr> ~\n~g;
	$message =~ s~<yabbwrap>~\n~g;

	&ToHTML($message);
	$message =~ s~\[tab\]~ &nbsp; &nbsp; &nbsp;~ig;
	$message =~ s~\n~<br />~g;
}

sub wrap2 {
	$message =~ s#<a href=(\S*?)(\s[^>]*)?>(\S{$linewrap,}?)</a># my $mess=$3; { $mess =~ s/\A((&.+?;|<.+?>|\[ch\d{3,}\]|.){$linewrap}).*\Z/$1.../s; } qq^<a href=$1$2>^ . $mess . qq^</a>^#eig;
}

sub RemoveThreadFiles {
	my $removethread = $_[0];
	if ($removethread) {
		unlink("$datadir/$removethread.txt");
		unlink("$datadir/$removethread.ctb");
		unlink("$datadir/$removethread.mail");
		unlink("$datadir/$removethread.poll");
		unlink("$datadir/$removethread.polled");
		$yymain .= qq~&nbsp; &nbsp; &nbsp;$removethread $removemess_txt{'7'}<br />~;
	}
}

sub MembershipGet {
	if (fopen(FILEMEMGET, "$memberdir/members.ttl")) {
		$_ = <FILEMEMGET>;
		chomp;
		fclose(FILEMEMGET);
		return split(/\|/, $_);
	} else {
		my @ttlatest = &MembershipCountTotal;
		return @ttlatest;
	}
}

#use Fcntl qw/:DEFAULT/; ### Do we need this?
unless (defined $LOCK_SH) { $LOCK_SH = 1; }

{
	my %yyOpenMode = (
		'+>>' => 5,
		'+>'  => 4,
		'+<'  => 3,
		'>>'  => 2,
		'>'   => 1,
		'<'   => 0,
		''    => 0);

	# fopen: opens a file. Allows for file locking and better error-handling.
	sub fopen ($$;$) {
		my ($pack, $file, $line) = caller;
		$file_open++;
		my ($filehandle, $filename, $usetmp) = @_;
		## make life easier - spot a file that's not closed!
		if (($debug == 1 or ($debug == 2 && $iamadmin))) { $openfiles .= qq~$filehandle -> $filename ~; }
		my ($flockCorrected, $cmdResult, $openMode, $openSig);

		$serveros = "$^O";
		if ($serveros =~ m/Win/ && substr($filename, 1, 1) eq ":") {
			$filename =~ s~\\~\\\\~g;    # Translate windows-style \ slashes to windows-style \\ escaped slashes.
			$filename =~ s~/~\\\\~g;     # Translate unix-style / slashes to windows-style \\ escaped slashes.
		} else {
			$filename =~ tr~\\~/~;       # Translate windows-style \ slashes to unix-style / slashes.
		}
		$LOCK_EX     = 2;                # You can probably keep this as it is set now.
		$LOCK_UN     = 8;                # You can probably keep this as it is set now.
		$LOCK_SH     = 1;                # You can probably keep this as it is set now.
		$usetempfile = 0;                # Write to a temporary file when updating large files.

		# Check whether we want write, append, or read.
		$filename =~ m~\A([<>+]*)(.+)~;
		$openSig  = $1                    || '';
		$filename = $2                    || $filename;
		$openMode = $yyOpenMode{$openSig} || 0;

		$filename =~ s~[^/\\0-9A-Za-z#%+\,\-\ \.\:@^_]~~g;    # Remove all inappropriate characters.

		if ($filename =~ m~/\.\./~) { &fatal_error("cannot_open","$filename. $maintxt{'609'}"); }

		# If the file doesn't exist, but a backup does, rename the backup to the filename
		if (!-e $filename && -e "$filename.bak") { rename("$filename.bak", "$filename"); }
		if (-z $filename && -e "$filename.bak") { rename("$filename.bak", "$filename"); }

		$testfile = $filename;
		if ($use_flock == 2 && $openMode) {
			my $count;
			while ($count < 15) {
				if (-e $filehandle) { sleep 2; }
				else { last; }
				++$count;
			}
			unlink($filehandle) if ($count == 15);
			local *LFH;
			CORE::open(LFH, ">$filehandle");
			$yyLckFile{$filehandle} = *LFH;
		}

		if ($use_flock && $openMode == 1 && $usetmp && $usetempfile && -e $filename) {
			$yyTmpFile{$filehandle} = $filename;
			$filename .= '.tmp';
		}

		if ($openMode > 2) {
			if ($openMode == 5) { $cmdResult = CORE::open($filehandle, "+>>$filename"); }
			elsif ($use_flock == 1) {
				if ($openMode == 4) {
					if (-e $filename) {

						# We are opening for output and file locking is enabled...
						# read-open() the file rather than write-open()ing it.
						# This is to prevent open() from clobbering the file before
						# checking if it is locked.
						$flockCorrected = 1;
						$cmdResult = CORE::open($filehandle, "+<$filename");
					} else {
						$cmdResult = CORE::open($filehandle, "+>$filename");
					}
				} else {
					$cmdResult = CORE::open($filehandle, "+<$filename");
				}
			} elsif ($openMode == 4) {
				$cmdResult = CORE::open($filehandle, "+>$filename");
			} else {
				$cmdResult = CORE::open($filehandle, "+<$filename");
			}
		} elsif ($openMode == 1 && $use_flock == 1) {
			if (-e $filename) {

				# We are opening for output and file locking is enabled...
				# read-open() the file rather than write-open()ing it.
				# This is to prevent open() from clobbering the file before
				# checking if it is locked.
				$flockCorrected = 1;
				$cmdResult = CORE::open($filehandle, "+<$filename");
			} else {
				$cmdResult = CORE::open($filehandle, ">$filename");
			}
		} elsif ($openMode == 1) {
			$cmdResult = CORE::open($filehandle, ">$filename");    # Open the file for writing
		} elsif ($openMode == 2) {
			$cmdResult = CORE::open($filehandle, ">>$filename");    # Open the file for append
		} elsif ($openMode == 0) {
			$cmdResult = CORE::open($filehandle, $filename);        # Open the file for input
		}
		unless ($cmdResult)      { return 0; }
		if     ($flockCorrected) {

			# The file was read-open()ed earlier, and we have now verified an exclusive lock.
			# We shall now clobber it.
			flock($filehandle, $LOCK_EX);
			if ($faketruncation) {
				CORE::open(OFH, ">$filename");
				unless ($cmdResult) { return 0; }
				print OFH '';
				CORE::close(OFH);
			} else {
				truncate(*$filehandle, 0) || &fatal_error("truncation_error","$filename");
			}
			seek($filehandle, 0, 0);
		} elsif ($use_flock == 1) {
			if ($openMode) { flock($filehandle, $LOCK_EX); }
			else { flock($filehandle, $LOCK_SH); }
		}
		return 1;
	}

	# fclose: closes a file, using Windows 95/98/ME-style file locking if necessary.
	sub fclose ($) {
		my ($pack, $file, $line) = caller;
		$file_close++;
		my $filehandle = $_[0];
		if (($debug == 1 or ($debug == 2 && $iamadmin))) { $openfiles .= qq~ ->> $debug_txt{'closefile'} -> $filehandle\n[$pack, $file, $line]\n\n~; }
		CORE::close($filehandle);
		if ($use_flock == 2) {
			if (exists $yyLckFile{$filehandle} && -e $filehandle) {
				CORE::close($yyLckFile{$filehandle});
				unlink($filehandle);
				delete $yyLckFile{$filehandle};
			}
		}
		if ($yyTmpFile{$filehandle}) {
			my $bakfile = $yyTmpFile{$filehandle};
			if ($use_flock == 1) {

				# Obtain an exclusive lock on the file.
				# ie: wait for other processes to finish...
				local *FH;
				CORE::open(FH, $bakfile);
				flock(FH, $LOCK_EX);
				CORE::close(FH);
			}

			# Switch the temporary file with the original.
			unlink("$bakfile.bak") if (-e "$bakfile.bak");
			rename($bakfile, "$bakfile.bak");
			rename("$bakfile.tmp", $bakfile);
			delete $yyTmpFile{$filehandle};
			if (-e $bakfile) {
				unlink("$bakfile.bak");    # Delete the original file to save space.
			}
		}
		return 1;
	}

}    #/ my %yyOpenMode

sub KickGuest {
	require "$sourcedir/LogInOut.pl";
	$sharedLogin_title = "$maintxt{'633'}";
	$sharedLogin_text  = qq~<br />$maintxt{'634'}<br />$maintxt{'635'} <a href="$scripturl?action=register">$maintxt{'636'}</a> $maintxt{'637'}<br /><br />~;
	$yymain .= &sharedLogin;
	$yytitle = "$maintxt{'34'}";
	&template;
	exit;
}

sub WriteLog {
	my ($curentry, $name);
	my $field = $username;
	if ($field eq "Guest") { $field = "$user_ip"; }

	fopen(LOG, "+<$vardir/log.txt");
	seek LOG, 0, 0;
	@online = <LOG>;
	truncate LOG, 0;
	seek LOG, 0, 0;
	print LOG "$field|$date|$user_ip|$user_host\n";
	foreach $curentry (@online) {
		$curentry =~ s/\n//g;
		($name, $date1, $orig_ip, undef) = split(/\|/, $curentry);

		# Case insensitive name-checking, so that you can't be listed twice online
		if (lc($field) eq lc($name)) { next; }
		$date2 = $date;
		chomp $date1;
		chomp $date2;
		&calctime;
		if ($name ne $field && $user_ip ne $name && $result <= ($OnlineLogTime * 60) && $result >= 0) {
			print LOG "$curentry\n";
		}

		# This check needs to be present to prevent thrashing of the user.vars file
		if ($result > ($OnlineLogTime * 60) && $name ne $orig_ip) {
			if (!${$uid.$name}{'password'}) { &LoadUser($name); }
			&UserAccount($name, "update", "lastonline");
		}
	}
	fclose(LOG);

	if ($action eq '' && $enableclicklog == 1) {
		fopen(LOG, "+<$vardir/clicklog.txt", 1);
		my @entries = <LOG>;
		seek LOG, 0, 0;
		truncate LOG, 0;
		if ($ENV{'HTTP_REFERER'} =~ m~$boardurl~i) { $thereferer = ""; }
		else { $thereferer = $ENV{'HTTP_REFERER'}; }
		print LOG "$field|$date|$ENV{'REQUEST_URI'}|$thereferer|$user_agent\n";
		foreach $curentry (@entries) {
			$curentry =~ s/\n//g;
			chomp $curentry;
			($name, $date1, undef, undef, undef) = split(/\|/, $curentry);
			$date2 = $date;
			chomp $date1;
			chomp $date2;
			&calctime;
			$ClickAge = int($result / 60);
			if ($ClickAge <= $ClickLogTime && $ClickAge >= 0) { print LOG "$curentry\n"; }
		}
		fclose(LOG);
	}
}

sub freespace {
	$sv_os = $^O;
	## Do an ordinary DOS dir command and grab the output if on Windows ##
	if ($sv_os =~/Win/){
		$mydrive = substr($htmldir,0,1);
		@grabdrive = qx{dir /-c};
		$grabline = $grabdrive[$#grabdrive];
		## error trapping if output fails ##
		if($grabline !~ m/byte/){				## the word byte should be in the line ##
			&LoadLanguage('Error');
			$yyfreespace = $error_txt{'module_missing'};
			$diskalert = 0;
			return;
		}
		$grabline =~ s/^\s+(\d+)\s+(.+?)\s+(\d+)\s+(.+?)\n$/$3/ig;
		$FreeBytesAvailableToCaller = $3;
		if ($FreeBytesAvailableToCaller >= 1000000000) {
			$yyfreespace = sprintf("%.2f", $FreeBytesAvailableToCaller/(1024*1024*1024))." Gb (Windows)";
		} elsif ($FreeBytesAvailableToCaller >= 1000000) {
			$yyfreespace = sprintf("%.2f", $FreeBytesAvailableToCaller/(1024*1024))." Mb (Windows)";
		} else {
			$yyfreespace = sprintf("%.2f", $FreeBytesAvailableToCaller/1024)." Kb (Windows)";
		}
		if ($FreeBytesAvailableToCaller < 1){$diskalert = 1; } else {$diskalert = 0; }
	}

	## Do an ordinary *nix df -k . command and grab the output if on *nix ##
	else {
		@grabdrive = qx{df -k .};
		$grabline = pop(@grabdrive);
		## error trapping if output fails ##
		if($grabline !~ m/\%/){				## the % sign should be in the line ##
			$yyfreespace = $error_txt{'module_missing'};
			$diskalert = 0;
			return;
		}
		## regex on df -b . ##
		## should look like: /dev/path 151694892 5495660 134063644 4% / ##
		@roughdata = split(" ", $grabline);
		$roughdata[3] =~ s/ //g;
		$FreeBytes1024blocks = $roughdata[3];
		$FreeBytes1024blocks =~ s/ //g;
		$FreeBytesAvailableToCaller = $FreeBytes1024blocks*1024;
		if ($FreeBytesAvailableToCaller >= 1000000000) {
			$yyfreespace = sprintf("%.2f", $FreeBytesAvailableToCaller/(1024*1024*1024))." Gb (Unix/Linux/BSD)";
		} elsif ($FreeBytesAvailableToCaller >= 1000000) {
			$yyfreespace = sprintf("%.2f", $FreeBytesAvailableToCaller/(1024*1024))." Mb (Unix/Linux/BSD)";
		} else {
			$yyfreespace = sprintf("%.2f", $FreeBytesAvailableToCaller/1024)." Kb (Unix/Linux/BSD)";
		}
		if ($FreeBytesAvailableToCaller < 1){$diskalert = 1; } else {$diskalert = 0; }
	}
}

sub encode_password {
	my $eol = "";
	$eol = $_[0];
	chomp $eol;
	require Digest::MD5;
	import Digest::MD5 qw(md5_base64);

	my $mypass = md5_base64($eol);
	return $mypass;
}

sub Censor {
	my $string = $_[0];
	foreach $censor (@censored) {
		my ($tmpa, $tmpb, $tmpc) = @{$censor};
		if ($tmpc) {
			$string =~ s~(^|\W|_)\Q$tmpa\E(?=$|\W|_)~$1$tmpb~gi;
		} else {
			$string =~ s~\Q$tmpa\E~$tmpb~gi;
		}
	}
	return $string;
}

sub CheckCensor {
	my $string = $_[0];
	foreach $censor (@censored) {
		my ($tmpa, $tmpb, $tmpc) = @{$censor};
		if ($string =~ m/(\Q$tmpa\E)/i) {
			$found_word .= "$1 ";
		}
	}
	return $found_word;
}

sub referer_check {
	$referencedomain = substr($boardurl, 7, (index($boardurl, "/", 7)) - 7);
	$refererdomain = substr($ENV{HTTP_REFERER}, 7, (index($ENV{HTTP_REFERER}, "/", 7)) - 7);
	if ($refererdomain !~ /$referencedomain/ && $ENV{QUERY_STRING} ne "" && length($refererdomain) > 0) {
		$goodaction = 0;
		fopen(ALLOWED, "$vardir/allowed.txt");
		@allowed = <ALLOWED>;
		fclose(ALLOWED);
		foreach $allow (@allowed) {
			chomp $allow;
			if ($action ne "" && $action eq $allow) { $goodaction = 1; last; }
		}
		if ($goodaction == 0 && $action ne "") { &fatal_error("referer_violation","$action<br />$reftxt{'7'} $referencedomain<br />$reftxt{'6'} $refererdomain"); }
	}
}

sub Dereferer {
	&fatal_error('no_access') unless $stealthurl;
	print "Content-Type: text/html\n\n";
	$refresh = qq~<html>\n<head>\n</head>\n<body Onload = document.location="$INFO{'url'}" target="_top">\n<font face="Arial" size="2">$dereftxt{'1'}</font>\n</body></html>\n~;
	print $refresh;
	exit;
}

sub LoadLanguage {
	my $what_to_load = $_[0];
	my $use_lang     = $language ? $language : $lang;
	if (-e "$langdir/$use_lang/$what_to_load.lng") {
		require "$langdir/$use_lang/$what_to_load.lng";
	} elsif (-e "$langdir/$lang/$what_to_load.lng") {
		require "$langdir/$lang/$what_to_load.lng";
	} elsif (-e "$langdir/English/$what_to_load.lng") {
		require "$langdir/English/$what_to_load.lng";
	} else {
		# Catches deep recursion problems
		# We can simply return to the error routine once we add the needed string
		if($what_to_load eq 'Error') {
			%error_txt = (
			'cannot_open_language' => "Can't find required language file. Please inform the administrator about this problem.",
			'error_occurred' => "An Error Has Occurred!",
			);
			return;
		}

		&fatal_error("cannot_open_language","$use_lang/$what_to_load.lng");
	}
}

sub Recent_Load {
	my $who_to_load = $_[0];
	if (-e "$memberdir/$who_to_load.wlog") {
		require "$memberdir/$who_to_load.wlog";
		&Recent_Save($who_to_load);
		unlink "$memberdir/$who_to_load.wlog";
	}
	if (-e "$memberdir/$who_to_load.rlog") {
		fopen(RLOG, "$memberdir/$who_to_load.rlog");
		%recent = map /(.*)\t(.*)/, <RLOG>;
		fclose(RLOG);
	}
}

sub Recent_Write {
	my ($todo, $recentthread, $recentuser) = @_;
	&Recent_Load($recentuser);
	if($todo eq "incr") {
		unless (exists($recent{$recentthread})) { $recent{$recentthread} = 0; }
		$recent{$recentthread}++;
	}
	if($todo eq "decr") {
		$recent{$recentthread}--;
		if ($recent{$recentthread} < 1) { delete $recent{$recentthread}; }
	}
	&Recent_Save($recentuser);
}

sub Recent_Save {
	my $who_to_save = $_[0];
	fopen(RLOG, ">$memberdir/$who_to_save.rlog");
	print RLOG map "$_\t$recent{$_}\n", keys %recent;
	fclose(RLOG);
	undef %recent;
	if (!-s "$memberdir/$who_to_save.rlog") { unlink("$memberdir/$who_to_save.rlog"); }
}

sub Write_ForumMaster {
	fopen(FORUMMASTER, ">$boardsdir/forum.master", 1);
	print FORUMMASTER qq~\$mloaded = 1;\n~;
	@catorder = &undupe(@categoryorder);
	print FORUMMASTER qq~\@categoryorder = qw(@catorder);\n~;
	while (($key, $value) = each(%cat)) {

		# Escape membergroups with a $ in them
		$value =~ s~\$~\\\$~g;
		# Strip membergroups with a ~ from them
		$value =~ s/\~//g;
		print FORUMMASTER qq~\$cat{'$key'} = qq\~$value\~;\n~;
	}
	while (($key, $value) = each(%catinfo)) {
		my($catname, $therest) = ();
		($catname, $therest) = split(/\|/, $value, 2);
		#$catname =~ s/\&(?!amp;)/\&amp;$1/g;
		# We can rely on the admin scripts to properly encode when needed.
		$value = "$catname|$therest";

		# Escape membergroups with a $ in them
		$value =~ s~\$~\\\$~g;
		# Strip membergroups with a ~ from them
		$value =~ s/\~//g;
		print FORUMMASTER qq~\$catinfo{'$key'} = qq\~$value\~;\n~;
	}
	while (($key, $value) = each(%board)) {
		my($boardname, $therest) = ();
		($boardname, $therest) = split(/\|/, $value, 2);
		#$boardname =~ s/\&(?!amp;)/\&amp;$1/g;
		# We can rely on the admin scripts to properly encode when needed.
		$value = "$boardname|$therest";

		# Escape membergroups with a $ in them
		$value =~ s~\$~\\\$~g;
		# Strip membergroups with a ~ from them
		$value =~ s/\~//g;
		print FORUMMASTER qq~\$board{'$key'} = qq\~$value\~;\n~;
	}
	print FORUMMASTER qq~\n1;~;
	fclose(FORUMMASTER);
}

### AK108 5-28-6: Appears to be unused (was used in Post.pl but removed before Y2.2)
#sub memparse {
#	foreach $line (@_) {
#		$line =~ s~(.*?)\t(.*?)~$1~isg;
#	}
#	return @_;
#}

sub dirstats {
	require File::Find;
	import File::Find;
	my ($size, $used_space, $free_space) = 0;
	&find(sub { $dirsize += -s }, $uploaddir);
	$used_space  = int($dirsize / 1024);
	$spaceleft   = ($mydirlimit - $dirsize);
	$kbspaceleft = ($dirlimit - $used_space);
}

sub clear_temp {
	if ($filename) {
		close($filename);
	}
	if (-e $tmpfile && $tmpfile ne '') {
		close($tmpfile);
		unlink $tmpfile || &fatal_error("cannot_delete","$tmpfile",1);
	}
}

sub MemberPageindex {
	my ($msindx, $trindx, $mbindx, $pmindx);
	($msindx, $trindx, $mbindx, $pmindx) = split(/\|/, ${$uid.$username}{'pageindex'});
	if ($INFO{'action'} eq "memberpagedrop") {
		${$uid.$username}{'pageindex'} = qq~$msindx|$trindx|0|$pmindx~;
	}
	if ($INFO{'action'} eq "memberpagetext") {
		${$uid.$username}{'pageindex'} = qq~$msindx|$trindx|1|$pmindx~;
	}
	&UserAccount($username, "update");
	my $SearchStr = $FORM{'member'} || $INFO{'member'};
	if ($SearchStr ne '') { $findmember = qq~;member=$SearchStr~; }
	if(!$INFO{'from'}) {
		$yySetLocation = qq~$scripturl?action=ml;sort=$INFO{'sort'};letter=$INFO{'letter'};start=$INFO{'start'}$findmember~;
	} elsif($INFO{'from'} eq "imlist") {
		$yySetLocation = qq~$scripturl?action=imlist;sort=$INFO{'sort'};letter=$INFO{'letter'};start=$INFO{'start'};field=$INFO{'field'}~;
	} elsif($INFO{'from'} eq 'admin') {
		$yySetLocation = qq~$adminurl?action=ml;sort=$INFO{'sort'};letter=$INFO{'letter'};start=$INFO{'start'}~;
	}

	&redirectexit;
}

#changed sub for improve perfomance, code from Zoo
sub check_existence {
	my ($dir, $filename) = @_;

	$filename =~ /(\S+?)(\.\S+$)/;
	my $origname = $1;
	my $filext = $2;
	my $numdelim = "_";
	my $filenumb = 0;
	while ( -e "$dir/$filename") {
			$filenumb = sprintf("%03d", ++$filenumb);
			$filename = qq~$origname$numdelim$filenumb$filext~;
	}
	return ($filename);
}


sub ManageMemberlist {
	my $todo    = $_[0];
	my $user    = $_[1];
	my $userreg = $_[2];
	if ($todo eq "load" || $todo eq "update" || $todo eq "delete" || $todo eq "add") {
		fopen(MEMBLIST, "$memberdir/memberlist.txt");
		%memberlist = map /(.*)\t(.*)/, <MEMBLIST>;
		fclose(MEMBLIST);
	}
	if ($todo eq "add") {
		$memberlist{$user} = "$userreg";
	}
	if ($todo eq "update") {
		$memregtime = $memberlist{$user};
		if ($userreg) { $memregtime = qq~$userreg~; }
		$memberlist{$user} = "$memregtime";
	}
	if ($todo eq "delete") {
		if ($user =~ /,/)	{	# been sent a list to kill, not a single
			my @oldusers = split(',', $user);
			foreach my $user (@oldusers)	{
				delete($memberlist{$user});
			}
		}
		else	{delete($memberlist{$user});}
	}
	if ($todo eq "save" || $todo eq "update" || $todo eq "delete" || $todo eq "add") {
		fopen(MEMBLIST, ">$memberdir/memberlist.txt");
		print MEMBLIST map "$_\t$memberlist{$_}\n", sort { lc $memberlist{$a} cmp lc $memberlist{$b} } keys %memberlist;
		fclose(MEMBLIST);
		undef %memberlist;
	}
}

## deal with basic member data in memberinfo.txt
sub ManageMemberinfo {
	my $todo       = $_[0];
	my $user       = $_[1];
	my $userdisp   = $_[2];
	my $usermail   = $_[3];
	my $usergrp    = $_[4];
	my $usercnt    = $_[5];
	my $useraddgrp = $_[6];
	## pull hash of member name + other data
	if ($todo eq "load" || $todo eq "update" || $todo eq "delete" || $todo eq "add") {
		fopen(MEMBINFO, "$memberdir/memberinfo.txt");
		%memberinf = map /(.*)\t(.*)/, <MEMBINFO>;
		fclose(MEMBINFO);
	}
	if ($todo eq "add") {
		$memberinf{$user} = "$userdisp|$usermail|$usergrp|$usercnt|$useraddgrp";
	}
	if ($todo eq "update") {
		($memrealname, $mememail, $memposition, $memposts, $memaddgrp) = split(/\|/, $memberinf{$user});
		if ($userdisp) { $memrealname = $userdisp; }
		if ($usermail) { $mememail = $usermail; }
		if ($usergrp) { $memposition = $usergrp; }
		if ($usercnt) { $memposts = $usercnt; }
		if ($useraddgrp) {
			if ($useraddgrp =~ /###blank###/) { $useraddgrp = ''; }
			$memaddgrp = $useraddgrp;
		}
		$memberinf{$user} = "$memrealname|$mememail|$memposition|$memposts|$memaddgrp";
	}
	if ($todo eq "delete") {
		if ($user =~ /,/)	{	# been sent a list to kill, not a single
			my @oldusers = split(',', $user);
			foreach my $user (@oldusers)	{
				delete($memberinf{$user});
			}
		}	
		delete($memberinf{$user});
	}
	if ($todo eq "save" || $todo eq "update" || $todo eq "delete" || $todo eq "add") {
		fopen(MEMBINFO, ">$memberdir/memberinfo.txt");
		print MEMBINFO map "$_\t$memberinf{$_}\n", keys %memberinf;
		fclose(MEMBINFO);
		undef %memberinf;
	}
	
}

sub Collapse_Load {
	my (@userhide, $hidden);
	$colbutton = 1;
	my $i = 0;
	@userhide = split(/\,/, ${$uid.$username}{'cathide'});
	foreach my $key (@categoryorder) {
		my ($catname, $catperms, $catallowcol) = split(/\|/, $catinfo{$key});
		$access = &CatAccess($catperms);
		if ($catallowcol == 1 && $access) { $i++; }
		$catcol{$key} = 1;
		foreach $hidden (@userhide) {
			chomp $hidden;
			if ($catallowcol == 1 && $key eq $hidden) { $catcol{$key} = 0; }
		}
	}
	if ($i == @userhide) { $colbutton = 0; }
	$colloaded = 1;
}

sub getMailFiles {
	opendir(BOARDNOT, "$boardsdir");
	@bmaildir = grep { /\.mail$/ } readdir(BOARDNOT);
	closedir(BOARDNOT);
	opendir(THREADNOT, "$datadir");
	@tmaildir = grep { /\.mail$/ } readdir(THREADNOT);
	closedir(THREADNOT);
}

sub MailList {
	&is_admin_or_gmod;
	my $delmailline = '';
	if (!$INFO{'delmail'}) {
		$mailline = $_[0];
		$mailline =~ s~\r~~g;
		$mailline =~ s~\n~<br />~g;
	} else {
		$delmailline = $INFO{'delmail'};
	}
	if (-e ("$vardir/maillist.dat")) {
		fopen(FILE, "$vardir/maillist.dat");
		@maillist = <FILE>;
		fclose(FILE);
		fopen(FILE, ">$vardir/maillist.dat");
		if (!$INFO{'delmail'}) {
			print FILE "$mailline\n";
		}
		foreach $curmail (@maillist) {
			chomp $curmail;
			$otime = (split /\|/, $curmail)[0];
			if ($otime ne $delmailline) {
				print FILE "$curmail\n";
			}
		}
		fclose(FILE);
	} else {
		fopen(FILE, ">$vardir/maillist.dat");
		print FILE "$mailline\n";
		fclose(FILE);
	}
	if ($INFO{'delmail'}) {
		$yySetLocation = qq~$adminurl?action=mailing~;
		&redirectexit;
	}
}

sub cloak{
	my ($input) =$_[0];
	my ($user,$ascii,$key,$hex,$hexkey);
	$key = substr($date,length($date)-2,2);
	$hexkey = uc(unpack("H2", pack("V", $key)));
	for($n=0; $n < length $input ; $n++)    {
		$ascii = substr($input, $n, 1);
		$ascii = ord($ascii) ^ $key; # xor it instead of adding to prevent wide characters
		$hex = uc(unpack("H2", pack("V", $ascii)));
		$user .= $hex;
	}
	$user .= $hexkey;
	$user .= '0';
	return $user;
}

sub decloak{
	my ($input) =$_[0];
	my ($user,$ascii,$key,$dec,$hexkey);
	if (length($input) % 2 == 0) {return &old_decloak($input);} # Old style, return it
	elsif ($input !~ /\A[0-9A-F]+\Z/) {return $input; } 	## probably a non cloacked ID as it contains non hex code
	else {$input =~ s~0$~~;}
	$hexkey = substr($input,length($input)-2,2);
	$key = hex($hexkey);
	for($n=0; $n < length($input)-2; $n += 2)    {
		$dec = substr($input, $n, 2);
		$ascii = hex($dec) ^ $key; # xor it to reverse it
		$ascii = chr($ascii);
		$user .= $ascii;
	}
	return $user;
}

# THIS IS BROKEN -- it fails on larger ASCII values (for example chr(255) )
# It is only here to support YaBBForum's old format.
sub old_decloak{
	my ($input) =$_[0];
	my ($user,$ascii,$key,$dec,$hexkey,$x);
	if ($input !~ /\A[0-9A-F]+\Z/) {return $input; } 	## probably a non cloacked ID as it contains non hex code
	$hexkey = substr($input,length($input)-2,2);
	$key = hex($hexkey);
	$x=0;
	for($n=0; $n < length($input)-2; $n++)    {
		$dec = substr($input, $n, 2);
		$ascii = hex($dec);
		$ascii = chr($ascii-$key+$x);
		$user .= $ascii;
		$n++;
		$x++;
		if ($x > 32){$x = 0;}
	}
	return $user;
}

## moved this here, so any user display page can get to it
sub usersOnline	{
	fopen(FILE, "$vardir/log.txt");
	@logentries = <FILE>;
	fclose(FILE);
}

###  this is the one from Instantmessage.pl, given a facelift.
sub userOnLineStatus	{
	my $userToCheck = $_[0];
	if ($userToCheck eq 'Guest') { $online = ''; return $online; }
	## run through the log. If the username is found, return 'on'. If the user isn't there, return 'off'
	$online = qq~<span class="useroffline">$maintxt{'61'}</span>~;
	&UserCheck($userToCheck, "offlinestatus+stealth");
	if ($usercheck{'stealth'} ne 'checked') {
		foreach my $lines (@logentries) {
			my ($name, undef) = split(/\|/, $lines, 2);
			chomp $name;
			if ($name eq $userToCheck) {
				$online = qq~<span class="useronline">$maintxt{'60'}</span>~;
				$usercheck{'offlinestatus'} = 'online';
				last;
			}
		}
	} elsif ($usercheck{'stealth'} eq 'checked' && ($iamadmin || $iamgmod)) {
		foreach my $lines (@logentries) {
			my ($name, undef) = split(/\|/, $lines, 2);
			chomp $name;
			if ($name eq $userToCheck) {
				$online = qq~<span class="useronline">$maintxt{'60'}</span>*~;
				$usercheck{'offlinestatus'} = 'online';
				last;
			}
		}
	}
	if ($enable_MCstatusStealth && $usercheck{'offlinestatus'} ne 'offline') {
		&LoadUser($userToCheck);
		# enable 'away' indicator 0=Off 1=Staff to Staff 2=Staff to all 3=Members
		if ($enable_MCaway > 0 && $usercheck{'offlinestatus'} eq 'away' && !$iamguest) {
			#enable for staff
			if ($enable_MCaway == 1 && ($iamadmin || $iamgmod || $iammod)) {
				$online = qq~<span class="useraway">$maintxt{'away'}</span>~;
			}
			## enabled for all
			if ($enable_MCaway > 1) {
				$online = qq~<span class="useraway">$maintxt{'away'}</span>~;
			}
		}
		## if the useris 'away' but the above conditions are not met, they show as 'offline'
	}
	return $online;
}

## cut down version to just return on/off status
sub userOnLineCheck	{
	my $userToCheck = $_[0];
	$userIsOnline = 0;
	if ($userToCheck eq "Guest") { return $userIsOnline; }
	## run through the log. If the username is found, return 'on'. If the user isn't there, return 'off'
	foreach my $lines (@logentries) {
		my ($name, undef) = split(/\|/, $lines, 2);
		chomp $name;
		if ($name eq $userToCheck) { $userIsOnline = 1; last; }
	}
	return $userIsOnline;
}

## moved from Register.pl so we can use for guest browsing
sub guestLangSel	{
	opendir(DIR, $langdir);
	$morelang = 0;
	my @langDir = readdir(DIR);
	close(DIR);
	foreach my $filesanddirs (sort {lc($a) cmp lc($b)} @langDir) {
		chomp $filesanddirs;
		if (($filesanddirs ne '.') && ($filesanddirs ne '..') && (-e "$langdir/$filesanddirs/Register.lng")) {
			$lngsel = "";
			if ($filesanddirs eq $language) { $lngsel = qq~ selected="selected"~; }
			$langopt .= qq~<option value="$filesanddirs"$lngsel>$filesanddirs</option>~;
			$morelang++;
		}
	}
	#close(DIR);
	return $langopt;
}

##  control geust language selection. 

sub setGuestLang	{
	## if either 'no guest access' or 'no guest lan sel', throw the user back to the logn screen
	if (!$guestaccess || !$enable_guestlanguage) {
		$yySetLocation = qq~$scripturl?action=login~;
		&redirectexit;	
	}
	# otherwise, grab the selected language from the form and redirect to load it.
	$guestLang = $FORM{'guestlang'};
	$language = $guestLang;
	$yySetLocation = qq~$scripturl~;
	&redirectexit;	
}

##  check for locked post bypass status - user must be at least mod and bypass lock must be set right.
sub checkUserLockBypass	{
	my $canbypass;
	## work down the levels
	if ($bypass_lock_perm eq "fa" && $iamadmin)	{ $canbypass = 1; }
	elsif ($bypass_lock_perm eq "gmod" && ($iamadmin || $iamgmod)) { $canbypass = 1; }
	elsif ($bypass_lock_perm eq "mod" && ($iamadmin || $iamgmod || $iammod)) { $canbypass = 1; } 
	return $canbypass;
}

sub alertbox {
	my $alertline = $_[0];
	$yymain .= qq~
	<script language="JavaScript" type="text/javascript">
	alert ("$alertline");
	</script>~;
}

## load buddy list for user, new version from sub isUserBuddy
sub loadMyBuddy {
	if (${$uid.$username}{'buddylist'}) {
		%mybuddie = ();
		my @buddies = split(/\|/, ${$uid.$username}{'buddylist'});
		chomp(@buddies);
		foreach my $buddy (@buddies) {
			$buddy =~ s/^ //;
			$mybuddie{$buddy} = 1;
		}
	}
	undef @buddies;
}

## add user to buddy list
## this is only for the 
sub addBuddy	{
	my $newBuddy;
	if ($INFO{'name'}) {
		if ($do_scramble_id) { $newBuddy = &decloak($INFO{'name'}); }
		else { $newBuddy = $INFO{'name'}; }
		chomp($newBuddy);
		if ($newBuddy eq $username) { &fatal_error("self_buddy"); }
		&ToHTML($newBuddy);
		if (!${$uid.$username}{'buddylist'})	{
			${$uid.$username}{'buddylist'} = "$newBuddy";
		} else {
			my @currentBuddies = split(/\|/, ${$uid.$username}{'buddylist'});
			push(@currentBuddies, $newBuddy);
			sort(@currentBuddies);
			@newBuddies = &undupe(@currentBuddies);
			$newBuddyList = join('|', @newBuddies);
			${$uid.$username}{'buddylist'} = $newBuddyList;
		}
		&UserAccount($username, "update");
	}
	$yySetLocation = qq~$scripturl?num=$INFO{'num'}/$INFO{'vpost'}#$INFO{'vpost'}~;
	if ($INFO{'vpost'} eq '') {
		$yySetLocation = qq~$scripturl?action=viewprofile;username=$INFO{'name'}~;
	}
	&redirectexit;
}

## check to see if user can view a broadcast message based on group
sub BroadMessageView {
	$icanview = 0;
	@groupToCheck = split(/\,/, $_[0]);
	if (!@groupToCheck) { return $icanview; }
	## obvious out of the way first - messages for admin/gmods etc
	if ($iamadmin) { $icanview = 1; return $icanview; }
	foreach my $checkgroup (@groupToCheck) {
		chomp $checkgroup;
		if ($checkgroup eq 'all') { $icanview = 1; return $icanview; }
		if ($checkgroup eq ('gmods' || 'mods') && $iamgmod) { $icanview = 1; return $icanview; }
		if ($checkgroup eq 'mods' && &is_moderator($username)) { $icanview = 1; return $icanview; }
		if ($checkgroup eq ${$uid.$username}{'position'}) { $icanview = 1; return $icanview; }
		my @modgroups = split(/\,\ /, ${$uid.$username}{'addgroups'});
		chomp @modgroups;
		foreach my $mgroup (@modgroups) {
			chomp $mgroup;
			if ($checkgroup eq $mgroup) { $icanview = 1; return $icanview; }
		}
	}
	## finished all possible ways to check groups so return no!
	return $icanview;
}

sub CheckUserPM_Level {
	my $checkuser = $_[0];
	$UserPM_Level = 1;
	if (!${$uid.$checkuser}{'password'}) { &LoadUser($checkuser); }
	if (${$uid.$checkuser}{'position'} eq 'Administrator' || ${$uid.$checkuser}{'position'} eq 'Global Moderator') { 
		$UserPM_Level = 3;
	} else {
		usercheck: foreach my $catid (@categoryorder) {
			my $boardlist = $cat{$catid};
			my (@bdlist) = split(/\,/, $boardlist);
			foreach my $checkboard (@bdlist) {
				${$uid.$checkboard}{'mods'} =~ s/ //g;
				foreach my $curuser (split(/\,/, ${$uid.$checkboard}{'mods'})) {
					if ($checkuser eq $curuser) { $UserPM_Level = 2; last usercheck; }
				}
				${$uid.$checkboard}{'modgroups'} =~ s/ //g;
				${$uid.$checkuser}{'addgroups'} =~ s/ //g;
				foreach my $curgroup (split(/\,/, ${$uid.$checkboard}{'modgroups'})) {
					if (${$uid.$checkuser}{'position'} eq $curgroup) { $UserPM_Level = 2; last usercheck; }
					foreach my $memberaddgroups (split(/\,/, ${$uid.$checkuser}{'addgroups'})) {
						if ($memberaddgroups eq $curgroup) { $UserPM_Level = 2; last usercheck; }
					}
				}
			}
		}
	}
	return $UserPM_Level;
}


1;
