#!/usr/bin/perl
#
# $Id: smilib.pl,v 1.51 2006/11/28 21:07:48 psims Exp $
#
# Source File: smilib.pl

require 'sitecfg.pl';
use POSIX;
use Time::HiRes;
use CGI qw/:standard/;
# use Data::Dumper;

my $HBI_Debug_smilib_show_template = 0 ;

sub get_client_configuration {
	$omsg = "not found";
	if ($_[0]) {
		$trash = join( $pathsep, $dataroot, "config.$_[0]");
		$omsg = "";
		open( CFGFILE, "<$trash" ) or $omsg="not found";
 	} 
	if ($omsg eq 'not found') {
		$trash = join( $pathsep, $dataroot, "config.$SESSION{'clid'}");
		$omsg = "";
		open( CFGFILE, "<$trash" ) or $omsg="not found";
	}
	if ($omsg eq 'not found') {
		$trash = join( $pathsep, $dataroot, "config.std");
		open( CFGFILE, "<$trash" ) or return;
	}
	@cfgentries = <CFGFILE>;
	close CFGFILE;
	for (0 .. $#cfgentries) {
		chop ($cfgentries[$_]);
		($entrykey,$entryvalue) = split(/=/, $cfgentries[$_]);
		$SYSTEM{$entrykey} = $entryvalue;
	}
	if (($SESSION{'clid'} ne 'sacc') && ($SESSION{'clid'} ne 'std')) {
		$SYSTEM{'languagesupport'} = ($SYSTEM{'ALLOWEDLANGS'} eq '' || $SYSTEM{'ALLOWEDLANGS'} =~ /none/) ? "FALSE" : "TRUE";
	} else {
		$SYSTEM{'languagesupport'} = "TRUE";
	}
}

sub put_client_configuration {
	$omsg = "not found";
	if ($_[0]) {
		$trash = join( $pathsep, $dataroot, "config.$_[0]");
		$omsg = "";
		open( CFGFILE, "<$trash" ) or $omsg="not found";
 	} 
	if ($omsg eq 'not found') {
		$trash = join( $pathsep, $dataroot, "config.$SESSION{'clid'}");
		$omsg = "";
		open( CFGFILE, "<$trash" ) or $omsg="not found";
	}
	if ($omsg eq 'not found') {
		$trash = join( $pathsep, $dataroot, "config.std");
		open( CFGFILE, "<$trash" ) or return;
	}
	@cfgentries = <CFGFILE>;
	close CFGFILE;
	for (0 .. $#cfgentries) {
		chop ($cfgentries[$_]);
		($entrykey,$entryvalue) = split(/=/, $cfgentries[$_]);
		$key = "C$entrykey";
		$key =~ s/ /+/g;
		if ($FORM{$key} ne '') {
			$cfgentries[$_] = "$entrykey=$FORM{$key}";
		} else {
			if ( $entrykey eq 'IP_ACCESS_FILTER') {
				$cfgentries[$_] = "$entrykey=$FORM{'CIP_ACCESS_FILTER'}";
			}
		}
	}
	$omsg = "not found";
	if ($_[0]) {
		$trash = join( $pathsep, $dataroot, "config.$_[0]");
		$omsg = "";
		open( CFGFILE, ">$trash" ) or $omsg="not found";
 	} 
	if ($omsg eq 'not found') {
		$trash = join( $pathsep, $dataroot, "config.$SESSION{'clid'}");
		$omsg = "";
		open( CFGFILE, ">$trash" ) or $omsg="not found";
	}
	if ($omsg ne 'not found') {
		for (0 .. $#cfgentries) {
			print CFGFILE "$cfgentries[$_]\n";
		}
		close CFGFILE;
	}
	$chmodok = chmod 0666, $trash;
}

sub createtrace {
	my $trash = join( $pathsep, $secroot, "$ENV{'REMOTE_ADDR'}.log");
	my $msg = "";
	open( TRACEFILE, "<$trash") or $msg = "notfound";
	if ($msg eq 'notfound') {
		open( TRACEFILE, ">$trash" ) || return 0;
		my $starttime= &format_date_time("yyyy-mm-dd hh:nn:ss GMT", "1", "0");
		print TRACEFILE "$starttime\n";
		close TRACEFILE;
		my $chmodok = chmod 0666, $trash;
	} else {
		close TRACEFILE;
	}
	&opentrace();
}

sub traceoutput {
	if ($SYSTEM{'traceon'} != 1) {
		if (&opentrace()) {
			&createtrace();
		}
	}
	if ($SYSTEM{'traceon'} == 1) {
		print TRACEFILE "$_[0]\n";
	};
}

sub opentrace {
	my $trash = join( $pathsep, $secroot, "$ENV{'REMOTE_ADDR'}.log");
	open( TRACEFILE, ">>$trash" ) || return 0;
	$SYSTEM{'traceon'} = 1;
	my $starttime= &format_date_time("yyyy-mm-dd hh:nn:ss GMT", "1", "0");
	&traceoutput($starttime);
	return 1;
}

sub closetrace {
	$SYSTEM{'traceon'} = 0;
	my $starttime= &format_date_time("yyyy-mm-dd hh:nn:ss GMT", "1", "0");
	&traceoutput($starttime);
	close TRACEFILE;
}

sub createdebug {
	$trash = join( $pathsep, $secroot, "debug.$SESSION{'clid'}.txt");
	$msg = "";
	open( DBGFILE, "<$trash") or $msg = "notfound";
	if ($msg eq 'notfound') {
		open( DBGFILE, ">$trash" ) || return 0;
		$starttime= &format_date_time("yyyy-mm-dd hh:nn:ss GMT", "1", "0");
		&dbgprint("$starttime\n");
		close DBGFILE;
		$chmodok = chmod 0666, $trash;
	} else {
		close DBGFILE;
	}
	&opendebug("debug.txt");
}

sub opendebug {
	$trash = join( $pathsep, $secroot, "debug.$SESSION{'clid'}.txt");
	open( DBGFILE, ">>$trash" ) || return 0;
	$debugon = 1;
	return 1;
}

sub dbgprint {
	my ($s) = @_;
	&opendebug();
	print DBGFILE "$SESSION{'tid'}:$SESSION{'uid'}:$s";
	&closedebug();
}

sub closedebug {
	$debugon = 0;
	close DBGFILE;
}

sub showenv {
	for (keys %ENV) {
		if ($debugon) {
			&dbgprint("$_ = $ENV{$_}\n");
		} else {
			print "<!-- $_ = $ENV{$_} -->\n";
		}
	}
	$reqmeth = $ENV{'REQUEST_METHOD'};
	if ($reqmeth =~ /POST/i) {
		read (STDIN, $qstr, $ENV{'CONTENT_LENGTH'});
		if ($debugon) {
			&dbgprint("POSTED = $qstr\n");
		} else {
			print "<!-- POSTED = $qstr -->\n";
		}
	}
}

sub show_message_with_close {
	print "
<HTML>
<BODY>
<CENTER>
$_[0]<BR>
\&nbsp;<BR>
<FORM>
<INPUT TYPE=SUBMIT VALUE=\"CLOSE\" onClick='window.close()'><BR>
</FORM>
</BODY>
</HTML>
";
}

### DED-03 8/6/2002 Added this function to replace show_message_with_close
###	because it would close entire browser window
sub show_message_with_back {
	$URL="$PATHS{'cgiroot'}/sadmin.pl?tid=$SESSION{'tid'}&dtl=$_[1]&lang=$FORM{'lang'}";
	print "
<HTML>
<BODY>
<CENTER>
$_[0]<BR>
\&nbsp;<BR>\n";
if ($_[1] == 2) {
	print "<a href=$URL target=_parent>BACK</a>\n";
} else {
	print "<a href=$URL>BACK</a>\n";
}
print "
</BODY>
</HTML>
";
}

sub file_exists {
	open (TMPFILE,"<$_[0]") or return 0;
	close TMPFILE;
	return 1;
}

sub file_exists_with_extension {
	@feexts = split(/\;/, $_[1]);
	foreach $feext (@feexts) {
		$fename = "$_[0].$feext";
		if (&file_exists($fename)) {
			@feexts = ();
			$feext = "";
			return $fename;
		}
	}
	@feexts = ();
	$feext = "";
	$fename = "";
	return "";
}

sub app_initialize {
	$FORM{servertime} = POSIX::strftime($UI{DATETIME_FMT}, localtime(time));

	# parse request parameters into variables
	$query = new CGI;
	%FORM = $query->Vars;

	#foreach $key (keys(%FORM)) {
		#if ($FORM{$key} =~ /\-\-$/) {
			#chop($FORM{$key});
			#chop($FORM{$key});
		#}
	#}

	### DED Rip ALL this out, change UPLOADED_FILES references
	###	to use "CGI::upload"

						#if ($ftype eq 'csv') {
							#$content =~ s/\r//g;
							#$content =~ s/\n\n/\n/g;
						#} else {
							#### DED 1/24/06 
							## Removed for png supt
							## but breaks reports
							##$content =~ s/(.*)\r\n/$1/;
							#$content =~ s/(.*)\r\n/$1/;
						#}

        # make sure connection is https
	$set_https = 0;
	if ($FORM{'clid'} ne '') {
		&get_client_configuration($FORM{'clid'});
		$set_https = 0;
	} elsif ($FORM{'tid'} ne '' && &get_session($FORM{'tid'})) {
		&get_client_configuration($SESSION{'clid'});
		$set_https = 0;
	}
	if ($set_https) {
		if ( ($ENV{'HTTPS'} ne "on") && ( ($SYSTEM{'FORCEHTTPSOVERRIDE'} eq "Yes") || ($SYSTEM{'FORCEHTTPSOVERRIDE'} ne "No" && $SYSTEM{'forcehttps'}) ) ) {
			$url = "https://".$ENV{'SERVER_NAME'};
			if ($ENV{'SERVER_PORT'} != "80") {
				$port = $ENV{'SERVER_PORT'} + 1;
					$url .= ":".$port;
			}
			$url .= $ENV{'REQUEST_URI'};
			print "Location: $url\n";
		}
	}

        if ($qstr) {
		return 1;
	} else {
		return 0;
	}
}


sub copy_file {
	system("cp $_[1] $_[0] -p");
	print "<br>File successfully copied...<br>"; 
	return 1;
}
sub make_file {
	if ( ! open (TMPFILE, "<$_[1]") ) {
		&logger::logerr("Unable to open $_[1] for reading:  $!\n");
		return 0;
	}
	@copylines = <TMPFILE>;
	close TMPFILE;
	if ( ! open (TMPFILE, ">$_[0]") ) {
		&logger::logerr("Unable to open $_[0] for writing:  $!\n");
		return 0;
	}
	if ($_[2] == 1) {
		print TMPFILE "$copylines[0]";
	} else {
		foreach $copyline (@copylines) {
			print TMPFILE "$copyline";
		}
	}
	close TMPFILE;
	$chmodok = chmod 0666, $_[0];
	return 1;
}

sub get_io_file {
	if ( ! open (TMPFILE, "<$_[0]") ) {
		&logger::logerr("Unable to open $_[0] for reading:  $!\n");
		return 0;
	}
	@copylines = <TMPFILE>;
	close TMPFILE;
	if ( ! open (TMPFILE, ">$_[1]") ) {
		&logger::logerr("Unable to open $_[1] for writing:  $!\n");
		return 0;
	}
	foreach $copyline (@copylines) {
		print TMPFILE "$copyline";
	}
	close TMPFILE;
	$chmodok = chmod 0666, $_[1];
	return 1;
}

############################################################################
#
# Function:  cpbin( $fromfile, $tofile, $opts )
#
# Description:  Perform a binary copy of one binary file to another.
#
# Usage:  cpbin( $fromfile, $tofile, $opts )
#
# 	$opts is a hashref of options as follows:
#
# 		$opts->{clobber} : If set to 1, any existing $tofile will be clobbered.
# 		                   Otherwise, the copy will fail and return 0.
#
# Returns:  1 if successful, 0 if not, with very little error-checking
# 			to prevent accidental clobbering.
#
# Author:  efl, 11/2001
#
############################################################################
sub cpbin {
	my($fromfile, $tofile, $opts) = @_;

	my $clobber = $opts->{clobber};

	if ( -f $tofile && ! $clobber ) {
		&logger::logerr("Unable to open $fromfile for writing:  File exists and no clobbering allowed.  Set \$opts->{clobber} = 1 to force clobbering.\n");
		return 0;
	}

	if ( ! open (INFILE, "<$fromfile") ) {
		&logger::logerr("Unable to open $fromfile for reading:  $!\n");
		return 0;
	}
	binmode(INFILE);
	@content = <INFILE>;
	close INFILE;

	if ( ! open (OUTFILE, ">$tofile") ) {
		&logger::logerr("Unable to open $tofile for writing:  $!\n");
		return 0;
	}
	binmode(OUTFILE);
	foreach $content (@content) {
		print OUTFILE $content;
	}
	close OUTFILE;

	return 1;
}

sub gentid {
	$coreid = time;
	$spfmt = join('', "\%s\%0", sprintf("%d", length($idmax)), "d");
	$tid = sprintf( $spfmt, $coreid, (int(rand(0) * $idmax)));
	return $tid;
}

sub init_session {
	if ($FORM{'clid'} eq 'sacc') { $FORM{'clid'} = 'std';}
	$SESSION{'tid'} = &gentid;
	$SESSION{'clid'}=$FORM{'clid'};
	$SESSION{'uid'}=$FORM{'uid'};
	$SESSION{'uac'}=$FORM{'uac'};
	$SESSION{'useragent'}=$ENV{'HTTP_USER_AGENT'};
	$SESSION{'ipaddr'}=$ENV{'REMOTE_ADDR'};
	$SESSION{'referer'}=$ENV{'HTTP_REFERER'};
	$SESSION{'home'}=$FORM{'home'};
	$SESSION{'lang'}=$FORM{'lang'};
	$SESSION{'loggedin'}=time;
	if ($FORM{'browser'} eq '') {
		if ($SESSION{'useragent'} =~ /MSIE/ ) {
			$FORM{'browser'} = "MSIE/4";
		} else {
			$FORM{'browser'} = "NSNV/4";
		}
	}
	($SESSION{'browserapp'}, $SESSION{'browserversion'}) = split(/\//, $FORM{'browser'});
	&put_session($SESSION{'tid'}, "y");
}

sub get_session {
	my ($session_id, $skip_warning) = @_;
	if (! defined $session_id) {
		warn "HBI Undefined Session id" ;
	}
	if ($session_id eq "") { 
		&show_illegal_access_warning unless ($skip_warning);
		warn "HBI Blank Session id" ;
		return 0;
	}
	unless ($session_id =~ m/^\d{13,15}$/ ) {
		# only 13, 14, or 15 digits is OK.
		$session_id =~ tr/\000/,/ ; # Replace a null with a comma.
		my $err_mesg = "HBI Bad Y Session id $session_id X " . length $session_id . " Z" ;
		warn $err_mesg ;
		$session_id =~ s/\,.*$// ; # Drop any comma and the fo;;owing characters.
	}
	$trash = join($pathsep, $logroot, "sess.$session_id");
	open (SESSFILE, "<$trash");
	@sessrecs = <SESSFILE>;
	close SESSFILE;
	if ($#sessrecs == -1) {
		&show_illegal_access_warning unless ($skip_warning);
		warn "HBI No Lines in Session file, $trash ." ;
		return 0;
	} else {
		foreach $sessrec (@sessrecs) {
			chop ($sessrec);
			($nm,$vlu)=split(/=/,$sessrec);
			$SESSION{$nm} = $vlu;
		}
		unless ($SESSION{'clid'}) {
			warn "HBI Unknown Client ID in Session file." ;
		}
		unless ($SESSION{'uid'}) {
			warn "HBI Unknown Candidate ID in Session file." ;
		}
		if ($SESSION{'clid'} eq 'sacc') { $SESSION{'clid'} = 'std';}
		# FIXME:  AOL's use of dynamically changing IP addresses on each
		# FIXME:  successive pageview breaks fails against this scheme.
		# DED 2005-11-08 Removed to facilitate round-robin proxies
		#$sameuser = ($SESSION{'ipaddr'} eq $ENV{'REMOTE_ADDR'}) ? 1 : 0;
		#if ( $SESSION{'ipaddr'} ne $ENV{'REMOTE_ADDR'} ) {
		#	&logger::logwarn("SESSION{'ipaddr'} ($SESSION{'ipaddr'}) !== ENV{'REMOTE_ADDR'} ($ENV{'REMOTE_ADDR'}) for session ID $session_id");
		#}
		#$sameuser = ($SESSION{'loggedout'} ne '') ? 0 : $sameuser;
		$sameuser = ($SESSION{'loggedout'} ne '') ? 0 : 1;
		if ( $SESSION{'loggedout'} ne '' ) {
			&logger::logwarn("SESSION{'loggedout'} ($SESSION{'loggedout'}) !== '' for session ID $session_id ... meaning exactly what??");
		}
		return $sameuser;
	}
}

sub close_session {
	$SESSION{'loggedout'}=time;
	&put_session($SESSION{'tid'});
	$tofile = join($pathsep, $logroot, "sess.$_[0]");
	$archivefile = join($pathsep, $logroot, "sess.$_[0]");
	rename $tofile, $archivefile;
}

sub set_session {
	my $temp = $_[2];
	&get_session($_[0]);
	$SESSION{$_[1]} = $temp;
	&put_session($_[0]);
}

sub put_session {
	if ($_[0] eq "") { 
		return 0;
	}
	$SESSION{'lastaccess'}=time;
	$trash = join($pathsep, $logroot, "sess.$_[0]");
	open (SESSFILE, ">$trash");
	for (keys %SESSION) {
		print SESSFILE "$_\=$SESSION{$_}\n";
	}
	close SESSFILE;
	if ($_[1] eq 'y') { $chmodok = chmod 0666, $trash;}
}

sub show_illegal_access_warning {
	my ($user) = @_;
	&send_illegal_attempt;
	print "<HTML>\n";
	print "<BODY>\n";
        print "\&nbsp;<BR>\n";
	if ($user eq "user") {
		print "Attention User:<br>\n";
		print "Either your IP address has changed or the session tracking mechanisms have encountered an error. \n"; 
		print "Please logoff and contact your administrator for assistance.<BR>\n";
	} else {
		print "Attention Site Administrators:<br>\n";
		print "You have either requested a service that is unavailable at this time, \n";		
		print "or else the session tracking mechanisms have encountered an error. \n"; 
		print "Please try another selection, or logoff and logon again to reset session tracking.<BR>\n";
	}
        print "\&nbsp;<BR>\n";
        print "\&nbsp;<BR>\n";
#        print "Attention Hackers:<br>You have attempted to gain access to this secure site \n";
#	print "by bypassing the site security.<BR>\n";
#	print "\&nbsp;<BR>\n";
#	print "The contents of this site are protected by United States and International copyright laws.<BR>\n";
#	print "The information on this site is proprietary and protected by United States and International information privacy laws.<BR>\n";
#	print "\&nbsp;<BR>\n";
#	print "This invalid attempt has been logged, the site administrator notified, and your access route traced.<BR>";
#	print "Any further unauthorized access attempts from $ENV{'REMOTE_ADDR'} will result ";
#	print "in further investigation and possible prosecution.<BR>\n";
	print "</BODY>\n";
	print "</HTML>\n";
}

sub check_admin_profiles {
	my ($cndid) = @_;
	@aprofs = &get_data("admin.dat");
	foreach $aprof (@aprofs) {
		($aid, $trash) = split(/&/, $aprof);
		if ($aid eq $cndid) { 
			return 1;
		}
	}
	return 0;
}

sub checkinprogress {
	my ($clid, $uid) = @_;

#	FIXME:  This code, which I commented out, is a nagging mystery.  
#   FIXME:  Why was it here?  Can't see how it worked?  -efl, 1/2002
#	$tmpfile = join( $pathsep, $testroot, "inprog", "$uid.dat");
#	open (TMPFILE, "<$tmpfile") || return 0;
#	@pairs = <TMPFILE>;
#	close TMPFILE;

	$testdir = join( $pathsep, $testroot, "inprog");

	if ( ! opendir(DIR, $testdir) ) {
		&logger::logerr("Unable to opendir $testdir:  $!");
		return 0;
	}
    @filenames = readdir(DIR);
	closedir(DIR);

	my @inprogtests = ();
	foreach my $srcfile ( @filenames ) {
		if ( $srcfile =~ /^$clid\.$uid\.(.*)$/ ) {
			my $testid = $1;
			#
			#  Now check to see if we are within the availability window 
			#
			if ( &within_availability_window($clid, $testid, time) ) {

#	FIXME:  Don't actually note the inprogress test file because this code
#	FIXME:  never worked before and was compensated for elsewhere.  If it
#	FIXME:  ain't broke, don't fix it.  If you uncomment the line below,
#	FIXME:  then this code works, but test resumption does not.  -efl, 1/2002
#				push( @inprogtests, $testid );

			}
		}
	}

	if ( scalar(@inprogtests) > 1 ) {
		&logger::logerr("There are ".scalar(@inprogtests)." tests in progress and available for uid $uid, clid $clid:  [".join(', ', @inprogtests)."].  It was previously assumed this would not happen.  No interface yet to choose which one to resume.");
	}


	$FORM{'uac'} = "";
	return scalar(@inprogtests);
}

# returns 1 if current time is within availability window, 0 if not
#
# $time is in secs since 1970...
sub within_availability_window {
	my ($clid, $testid, $time) = @_;

	my ($rc, $msg, $start, $end) = get_availability_window($clid, $testid);
	if ( ! $rc ) {
		&logger::logerr("Unable to retrieve availability window for clid '$clid', testid '$testid':  $msg");
		return 0;
	}

	if ( $time > $start && $time < $end ) {
		return 1;
	} else {
		return 0;
	}
}

sub get_availability_window( $ $ ) {
	my ($clid, $testid) = @_;

	my ($rc, $msg, $start, $end) = (0, "N/A", 0, 0);

	### DED 11/19/02 Have to restore original test profile when done
	my $holdtestid = $TEST{'id'};

	if ( ! &get_test_profile($clid, $testid) ) {
		&logger::logerr("Failed to get profile for clid '$clid', testid '$testid'");
		($rc, $msg, $start, $end) = (0, "Failed to retrieve test profile", 0,0);
		&get_test_profile($clid, $holdtestid);
		return ($rc, $msg, $start, $end);
	}

	$start = datetime_to_secssince1970( $TEST{availon} );
	if ( ! defined($start) ) {
		($rc, $msg, $start, $end) = (0, "Unable to parse availability start: [$TEST{availon}]", 0,0);
		&logger::logerr("Unable to parse \$TEST{availon} = $TEST{availon}");
		&get_test_profile($clid, $holdtestid);
		return ($rc, $msg, $start, $end);
	}

	$end = datetime_to_secssince1970( $TEST{availthru} );
	if ( ! defined($end) ) {
		($rc, $msg, $start, $end) = (0, "Unable to parse availability end: [$TEST{availthru}]", 0,0);
		&logger::logerr("Unable to parse \$TEST{availthru} = $TEST{availthru}");
		&get_test_profile($clid, $holdtestid);
		return ($rc, $msg, $start, $end);
	}

	&get_test_profile($clid, $holdtestid);
	return (1, $msg, $start, $end);
}

sub checkalreadyloggedin {
	$luid = "$_[0].$_[1]";
	open (LOGINFILE, "<$logroot/ulog.dat");
	@loginrecs = <LOGINFILE>;
	close LOGINFILE;
	foreach $loginrec (@loginrecs) {
		chop $loginrec;
		($lguid, $lgupid, $lgutm) = split(/&/, $loginrec);
		if ($lguid eq $luid) {
			return 1;
		}
	}
	open (LOGINFILE, ">>$logroot/ulog.dat");
	print LOGINFILE "$_[0]\&$_[1]\&$$\n";
	close LOGINFILE;
	return 0;
}

## v support for wildcard ids
sub IsTaclID {
	my ($clid,$taclid,$pwd,$testid) = @_;

	#
	# see if there are any test access ids for this client
	#
	my @taclrecs=&get_data("tacl.$clid");
	unless ($#taclrecs > 0) { return 0;}

	#
	# now build a list of available tests for the login id given
	#
	my @flds;
	my $lctaclid=lc($taclid);
	my $uctaclid=uc($taclid);
	my $rec="($taclid|$uctaclid|$lctaclid)\&(.*)\&$pwd\&";
	my @trecs=grep( /$rec/, @taclrecs);
	my $rec=shift @taclrecs;
	@taclrecs=();
	unless ($#trecs != -1) { return 0};

	#
	# found some matches, now confirm the password to verifry the grep
	#
	my $taclauthtests="";
	my $tsep="";
	foreach $tacl (@trecs) {
		chop ($tacl);
		@flds=split(/&/,$tacl);
		if ($flds[2] eq $pwd) {
			$taclauthtests=join ('::',$taclauthtests,"$tacl");
		}
	}
	@trecs=();
	unless ($taclauthtests ne '') { return 0};
	$taclauthtests = substr($taclauthtests,2);

	#
	# There is a list, so verify access for this id
	#
	###  DED 3/5/04 Added for auto-login support
	if ($pwd eq "_____") {
		$rec = "$taclid&$testid&$pwd";
		@trecs=grep( /$rec/, $taclauthtests);
		unless ($#trecs != -1) { return 0};
		$SESSION{'taclid'}=get_anon_seqno($clid, $testid);
	} else {
		$SESSION{'taclid'}="$taclid.$pwd";
	}
	$SESSION{'taclauthtests'}=$taclauthtests;
	$SESSION{'uac'} = "cnd";
	return 1;
}
## ^ support for wildcard ids

sub verifyaccess {
	$FORM{'uac'} = "";
## v support for wildcard ids
	if (&IsTaclID($FORM{'clid'},$FORM{'uid'},$FORM{'pwd'},$FORM{'testid'})) {
		return 1;
	}
## ^ support for wildcard ids
	if ($FORM{'tadm'} ne '' || $FORM{'sadm'} ne '') {
		$tmpfile = "admin.dat";
		($oldpass,$newpass,$confirmpass) = split(/\//, $FORM{'pwd'});
	} else {
		$oldpass = $FORM{'pwd'};
		$newpass = "";
		if ($FORM{'cnd'} ne '') {
			$tmpfile = "cnd.$FORM{'clid'}";
		} else {
			# self assessment request
			if ($FORM{'sar'} ne '') {
				$tmpfile = "sar.$FORM{'clid'}";
			} else {$uacerror = 1;}
		}
	}
	unless ($uacerror) {
		@pairs = &get_data($tmpfile);
		foreach $pair (@pairs) {
			chop ($pair);
			($id, $pw, $pv, $clid) = split(/&/, $pair);
			if ($id eq $FORM{'uid'}) {
				if ($pw eq $oldpass) {
					if ($FORM{'tadm'} ne '' || $FORM{'sadm'} ne '') {
						$FORM{'uac'} = $pv;
						$FORM{'clid'} = ($clid eq 'sacc') ? "std" : $clid;
						if ($newpass ne '') {
							if ($newpass eq $confirmpass) {
								if (&change_password($id,$newpass,$pv,$clid)) {
									$SYSTEM{'message'} = "Your password has been changed."
								} else {
									$SYSTEM{'message'} = "Your password could not be changed."
								}
							} else {
								$SYSTEM{'pwchange'} = "Your password was not changed. The new password and confirming password did not match."
							}
						} else {
							$SYSTEM{'pwchange'} = ""
						}
					} else {
						@flds = split(/&/, $pair);
						#if ($FORM{'sas'} ne '') {
						if ($flds[17] eq 'Y') {
							$FORM{'uac'} = "sas";
							$FORM{'sas'} = "xxx";
						} else {
							$FORM{'uac'} = "cnd";
						}
						$FORM{'clid'} = $FORM{'clid'};
					}
					if ($ipfilter ne '') {
						if ($FORM{'uac'} ne 'gadmin') {
							if (&ipfilteredaccess($ipfilter,$ENV{'REMOTE_ADDR'})) {
								return 1;
							} else {
								return 0;
							}
						} else {
							return 1;
						}
					} else { 
						$SESSION{'clid'} = $FORM{'clid'};
						&get_client_configuration();
						if ($SYSTEM{'IP_ACCESS_FILTER'} ne '') {
							$SYSTEM{'message'} = "System is Locked Down";
							if (($FORM{'uac'} ne 'gadmin') && ($FORM{'uac'} ne 'admin') && ($FORM{'uac'} ne 'madmin')) {
								if (&ipfilteredaccess($SYSTEM{'IP_ACCESS_FILTER'},$ENV{'REMOTE_ADDR'})) {
									return 1;
								} else {
									return 0;
								}
							} else {
								return 1;
							}
						} else {
							return 1;
						}
					}
				}
			}
		}
		if ($FORM{'cnd'} ne '') {
			$FORM{'tadm'} = "xxx";
			$FORM{'cnd'} = "";
			if (&verifyaccess) {
				if ($ipfilter ne '') {
					if ($FORM{'uac'} ne 'gadmin') {
						if (&ipfilteredaccess($ipfilter,$ENV{'REMOTE_ADDR'})) {
							return 1;
						} else { 
							if (($SYSTEM{'IP_ACCESS_FILTER'} ne '') && ($FORM{'uac'} ne 'gadmin')) {
								if (&ipfilteredaccess($SYSTEM{'IP_ACCESS_FILTER'},$ENV{'REMOTE_ADDR'})) {
									return 1;
								} else {
									return 0;
								}
							} else {
								return 1;
							}
						}
					} else {
						return 1;
					}
				} else {
					return 1;
				}
			} else {
					return 0;
			}
		}
	}
	return 0;
}

sub change_password {
	@rs = &get_data("admin.dat");
	$rskp = shift @rs;
	foreach $rs (@rs) {
		chop ($rs);
		($xxid, $xxpw, $xxpv, $xxclid) = split(/&/, $rs);
		if ($xxid eq $_[0]) {
			$rs = join('&', $_[0], $_[1], $_[2], $_[3]);
		}
		push @newrs, $rs;
	}
	@rs = sort @newrs;
	@newrs = ();
 	$tmpfile = join($pathsep, $dataroot, "admin.dat");
	open (TMPFILE, ">$tmpfile") or return 0;
	print TMPFILE "$rskp";
	foreach $rs (@rs) {
		print TMPFILE "$rs\n";
	}
	close TMPFILE;
	return 1;
}

sub eval_logical_html {	
	my ($exaction, $value, $exval) = @_;
	$exludeflag = 0;
	@exvals = split(/\,/, $exval);
	foreach $exval (@exvals) {
 		if ($exval eq 'NULL') {
 			$exval = "";
 		}
		if ($exaction eq 'INCLUDE') {
			$exludeflag = ($value eq $exval) ? 0 : 1;
		} else {
			$exludeflag = ($value eq $exval) ? 1 : 0;
		}
		last if($value eq $exval);
	}
	return $exludeflag;
}

sub xlatline {
	my ($xltline, $fh, $escapem, $parse_nop) = @_;  # print translation to filehandle $fh
	$fh = (defined($fh) ? $fh : *STDOUT);
	if ($#sifnests == -1) {
		$sifnests[0] = 0;
		$sifncnt = 0;
		$sifnestlevel = 0;
	}

	if ($xltline =~ /(<%=)NOP_(\S+.*?%>)/i && $parse_nop) {
		$xltline =~ s/(<%=)NOP_(\S+.*?%>)/$1$2/g;
	}
	my $nopopuptag ;

	if ($xltline =~ /<%=SYSTEM\.STARTIF.(.*?)%>/i ) {
		($trash, $exstatement) = split(/\?/, $xltline);
		($exvar, $exval, $exaction, $trash) = split(/ /, $exstatement);
		($exarray, $exkey) = split(/\./, $exvar);
		if ($exarray eq 'FORM') {
			$excludeon = &eval_logical_html($exaction,$FORM{$exkey}, $exval); 
		} elsif ($exarray eq 'CLIENT') {
			$excludeon = &eval_logical_html($exaction,$CLIENT{$exkey}, $exval); 
		} elsif ($exarray eq 'GROUP') {
			$excludeon = &eval_logical_html($exaction,$GROUP{$exkey}, $exval); 
		} elsif ($exarray eq 'TEST') {
			$excludeon = &eval_logical_html($exaction,$TEST{$exkey}, $exval); 
		} elsif ($exarray eq 'SUBTEST') {
			$excludeon = &eval_logical_html($exaction,$SUBTEST{$exkey}, $exval); 
		} elsif ($exarray eq 'QUESTION') {
			$excludeon = &eval_logical_html($exaction,$QUESTION{$exkey}, $exval); 
		} elsif ($exarray eq 'GRADEBOOK') {
			$excludeon = &eval_logical_html($exaction,$GRADEBOOK{$exkey}, $exval); 
		} elsif ($exarray eq 'CANDIDATE') {
			$excludeon = &eval_logical_html($exaction,$CANDIDATE{$exkey}, $exval); 
		} elsif ($exarray eq 'SYSTEM') {
			$excludeon = &eval_logical_html($exaction,$SYSTEM{$exkey}, $exval); 
		} elsif ($exarray eq 'UI') {
			$excludeon = &eval_logical_html($exaction,$UI{$exkey}, $exval); 
		} elsif ($exarray eq 'SUBJAREA') {
			$excludeon = &eval_logical_html($exaction,$SUBJAREA{$exkey}, $exval); 
		} elsif ($exarray eq 'SESSION') {
			$excludeon = &eval_logical_html($exaction,$SESSION{$exkey}, $exval); 
		}
		if ($sifnests[$sifcnt]) {
			$sifncnt++;
		} else {
			$sifncnt++;
			$sifnests[$sifncnt] = $excludeon;
			for (1 .. $sifncnt) {
				$sifnestlevel = $_;
				$excludeon = $sifnests[$_];
				last if ($excludeon);
			}
		}
		return "";
	} elsif ($xltline =~ /<%=SYSTEM\.ELSE%>/i ) {
		if ($sifnestlevel == $sifncnt) {
			$excludeon = ($excludeon) ? 0 : 1;
		}
		return "";
	} elsif ($xltline =~ /<%=SYSTEM\.ENDIF%>/i ) {
		$excludeon = 0;
		$sifnests[$sifncnt] = 0;
		$sifncnt--;
		$sifnestlevel = 0;
		for (1 .. $sifncnt) {
			$sifnestlevel = $_;
			$excludeon = $sifnests[$_];
			last if ($excludeon);
		}
		return "";
	} else {
		if ($excludeon) { return "";}
	}
	if ($xltline =~ /<%=(.*?)%>/ ) {
		if ($xltline =~ /<%=PATHS\.(.*?)%>/i ) {
			for (keys %PATHS) {
				$repl = $PATHS{$_};
				$srch1 = join('', "<%=PATHS.", $_, "%>");
				$xltline =~ s/$srch1/$repl/g;
			}
		}
		if ($xltline =~ /<%=SITE.REPORTS%>/) {
			&get_site_reports_list($fh);
		}
		if ($xltline =~ /<%=SYSTEM\.(.*?)%>/i ) {
			if ($xltline =~ /<%=SYSTEM\.INCLUDEJS (.*?)%>/i ) {
				@incsegs = split(/ /, $xltline);
				$incjsfile = $incsegs[1];
				@incsegs = ();
				unless ($incjsfile eq '') {
					$incjsfile = join($pathsep, $cfgroot, "js", $incjsfile);
					open (TMPJSFILE, "<$incjsfile");
					@tmpjslines = <TMPJSFILE>;
					close TMPJSFILE;
					foreach $tmpjsline (@tmpjslines) {
						$tmpjsline = &xlatline($tmpjsline, $fh);
					}
					@tmpjslines = ();
				}
				return "";
			} elsif ($xltline =~ /<%=SYSTEM\.date%>/i ) {
					$repl = `date "+%b %d, %Y"`;
					$srch1 = "<%=SYSTEM.date%>";
					$xltline =~ s/$srch1/$repl/g;
			} else {
				for (keys %SYSTEM) {
					$repl = $SYSTEM{$_};
					$srch1 = join('', "<%=SYSTEM.", $_, "%>");
					$xltline =~ s/$srch1/$repl/g;
				}
			}
		}
		if ($xltline =~ /<%=SESSION\.(.*?)%>/i ) {
			for (keys %SESSION) {
				$repl = $SESSION{$_};
				$srch1 = join('', "<%=SESSION.", $_, "%>");
				$xltline =~ s/$srch1/$repl/g;
			}
		}
		if ($xltline =~ /<%=FORM\.servertime%>/i ) {
			$repl = POSIX::strftime($UI{DATETIME_FMT}, localtime(time));
			$srch1 = join('', "<%=FORM.servertime%>");
			$xltline =~ s/$srch1/$repl/g;
		} elsif ($xltline =~ /<%=FORM\.(.*?)%>/i ) {
			for (keys %FORM) {
				$repl = $FORM{$_};
				$srch1 = join('', "<%=FORM.", $_, "%>");
				$xltline =~ s/$srch1/$repl/g;
			}
		}
		if ($xltline =~ /<%=TEST_SESSION\.(.*?)%>/i ) {
			for (keys %TEST_SESSION) {
				$repl = $TEST_SESSION{$_};
				$srch1 = join('', "<%=TEST_SESSION.", $_, "%>");
				$xltline =~ s/$srch1/$repl/g;
			}
		}
		if ($xltline =~ /<%=SUBTEST\.(.*?)%>/i ) {
			for (keys %SUBTEST) {
				$repl = $SUBTEST{$_};
				$srch1 = join('', "<%=SUBTEST.", $_, "%>");
				$xltline =~ s/$srch1/$repl/g;
			}
		}
		if ($xltline =~ /<%=GROUP\.(.*?)%>/i ) {
			for (keys %GROUP) {
				$repl = $GROUP{$_};
				$srch1 = join('', "<%=GROUP.", $_, "%>");
				$xltline =~ s/$srch1/$repl/g;
			}
		}
		if ($xltline =~ /<%=SUBJAREA\.(.*?)%>/i ) {
			for (keys %SUBJAREA) {
				$repl = $SUBJAREA{$_};
				$srch1 = join('', "<%=SUBJAREA.", $_, "%>");
				$xltline =~ s/$srch1/$repl/g;
			}
		}
		if ($xltline =~ /<%=PHRASE\.(.+?)%>/i) {
			while ( $xltline =~ m/<%=PHRASE\.(.+?)%>/ix) { 
				my $id = $1; 
				$srch1 = join("", "<%=PHRASE.", $id, "%>");  
				$repl = GetLanguageElement($SESSION{lang}, $id);
				$xltline =~ s/$srch1/$repl/g;
			}
		}
		if ($xltline =~ /<%=GRADEBOOK\.(.*?)%>/i ) {
			for (keys %GRADEBOOK) {
				$repl = $GRADEBOOK{$_};
				$srch1 = join('', "<%=GRADEBOOK.", $_, "%>");
				$xltline =~ s/$srch1/$repl/g;
			}
		}
		if ($xltline =~ /<%=CLIENTS\.Options%>/i ) {
			&print_client_options($fh);
			return "";
		}
		if ($xltline =~ /<%=CLIENTS\.List%>/) {
			$client_list = &print_client_list($fh);
			$xltline =~ s/<%=CLIENTS.List%>/$client_list/g;
		}
		if ($xltline =~ /<%=CLIENT\.(.*?)%>/i ) {
			if ( $xltline =~ /<%=CLIENT\.REPORTS%>/i) {
				&get_client_reports_list($fh, $SESSION{'clid'}, $SESSION{'uid'});
				return "";
			} elsif ( $xltline =~ /<%=CLIENT.TESTS%>/i) {
				&print_noncfa_test_options($CLIENT{'clid'}, $fh);
				return "";
			} elsif ( $xltline =~ /<%=CLIENT.userlist%>/i) {
				&print_client_cnd_options($CLIENT{'clid'}, $fh);
				return "";
			} elsif ( $xltline =~ /<%=CLIENT.adminids%>/i) {
				&print_client_adminids($CLIENT{'clid'}, $fh);
				return "";
			} elsif ( $xltline =~ /<%=CLIENT.forms%>/i) {
				&print_client_test_forms($CLIENT{'clid'}, $fh);
				return "";
			} elsif ( $xltline =~ /<%=CLIENT.grpowners%>/i) {
				&print_group_owners($CLIENT{'clid'}, $fh);
				return "";
			} elsif ( $xltline =~ /<%=CLIENT.grpowners_ownedby%>/i) {
				&print_group_owners($CLIENT{'clid'}, $fh, 1);
				return "";
			} elsif ( $xltline =~ /<%=CLIENT.registrars_ownedby%>/i) {
				&print_registrars($CLIENT{'clid'}, $fh, 1);
				return "";
			} elsif ( $xltline =~ /<%=CLIENT.groups%>/i) {
				&print_client_groups($CLIENT{'clid'}, $fh);
				return "";
# v sac modification to standardize test sequence inputs
			} elsif ( $xltline =~ /<%=CLIENT.cfas%>/i) {
				$repl = &print_client_seqtst_list($CLIENT{'clid'},"cfa",$TEST{'dscl'},$fh);
				$srch = join('', "<%=CLIENT.", "cfas", "%>");
				$xltline =~ s/$srch/$repl/g;
			} elsif ( $xltline =~ /<%=CLIENT.profbs%>/i) {
				$repl = &print_client_seqtst_list($CLIENT{'clid'},"profb",$TEST{'profb'},$fh);
				$srch = join('', "<%=CLIENT.", "profbs", "%>");
				$xltline =~ s/$srch/$repl/g;
			} elsif ( $xltline =~ /<%=CLIENT.profas%>/i) {
				$repl = &print_client_seqtst_list($CLIENT{'clid'},"profa",$TEST{'profa'},$fh);
				$srch = join('', "<%=CLIENT.", "profas", "%>");
				$xltline =~ s/$srch/$repl/g;
			} elsif ( $xltline =~ /<%=CLIENT.srvys%>/i) {
				$repl = &print_client_seqtst_list($CLIENT{'clid'},"srvy",$TEST{'srvy'},$fh);
				$srch = join('', "<%=CLIENT.", "srvys", "%>");
				$xltline =~ s/$srch/$repl/g;
# ^ sac modification to standardize test sequence inputs
			} elsif ( $xltline =~ /<%=CLIENT.userlanguageselect%>/i) {
				&print_user_language_select($CLIENT{'clid'});
				return "";
			} elsif ( $xltline =~ /<%=CLIENT.userlanguageselectdrop%>/i) {
				&print_user_language_select($CLIENT{'clid'},1);
				return "";
			} elsif ( $xltline =~ /<%=CLIENT.forsaletable%>/i) {
				&print_client_forsale_table($CLIENT{'clid'}, 0);
				return "";
			} elsif ( $xltline =~ /<%=CLIENT.ordertable%>/i) {
				&print_client_forsale_table($CLIENT{'clid'}, 1);
				return "";
			} elsif ( $xltline =~ /<%=CLIENT.clcnd1input%>/i) {
				&print_clcnd_input($CLIENT{'clid'}, 1, 0, 1);
				return "";
			} elsif ( $xltline =~ /<%=CLIENT.clcnd2input%>/i) {
				&print_clcnd_input($CLIENT{'clid'}, 2, 0, 1);
				return "";
			} elsif ( $xltline =~ /<%=CLIENT.clcnd3input%>/i) {
				&print_clcnd_input($CLIENT{'clid'}, 3, 0, 1);
				return "";
			} elsif ( $xltline =~ /<%=CLIENT.clcnd4input%>/i) {
				&print_clcnd_input($CLIENT{'clid'}, 4, 0, 1);
				return "";
			} elsif ( $xltline =~ /<%=CLIENT.clcnd1inputf%>/i) {
				&print_clcnd_input($CLIENT{'clid'}, 1, "f", 1);
				return "";
			} elsif ( $xltline =~ /<%=CLIENT.clcnd2inputf%>/i) {
				&print_clcnd_input($CLIENT{'clid'}, 2, "f", 1);
				return "";
			} elsif ( $xltline =~ /<%=CLIENT.clcnd3inputf%>/i) {
				&print_clcnd_input($CLIENT{'clid'}, 3, "f", 1);
				return "";
			} elsif ( $xltline =~ /<%=CLIENT.clcnd4inputf%>/i) {
				&print_clcnd_input($CLIENT{'clid'}, 4, "f", 1);
				return "";
			} else {
				for (keys %CLIENT) {
					$repl = $CLIENT{$_};
					$srch = join('', "<%=CLIENT.", $_, "%>");
					$xltline =~ s/$srch/$repl/g;
				}
			}
		}
		if ($line =~ /<%=MADMIN.CLIENTS%>/) {
			&get_madmin_client_list($SESSION{'mclid'});
		}
		if ($xltline =~ /<%=INSTANCE\.desc%>/i ) {
			$fh = (defined($fh) ? $fh : *STDOUT);
			my $repl = &get_a_key("tests.".$SESSION{'clid'}, $TEST{'instanceof'}, "desc");
			my $srch = "<%=INSTANCE.desc%>";
			$xltline =~ s/$srch/$repl/g;
		}
		if ($xltline =~ /<%=TESTS\.Options%>/i ) {
			&print_std_test_options($SESSION{'clid'}, $fh);
			return "";
		}
		if ($xltline =~ /<%=TESTS\.inherit%>/i ) {
			&print_filtered_test_options("std", $CLIENT{'clid'}, $fh);
			return "";
		}
		if ($xltline =~ /<%=TEST\.(.*?)%>/i ) {
			for (keys %TEST) {
				$repl = $TEST{$_};
				$srch = join('', "<%=TEST.", $_, "%>");
				$xltline =~ s/$srch/$repl/g;
			}
		}
		if ($xltline =~ /<%=QUESTION\.(.*?)%>/i ) {
			for (keys %QUESTION) {
				$repl = $QUESTION{$_};
				$repl = escape_special_chars( $repl ) if ( $escapem == 1 );
				$srch = join('', "<%=QUESTION.", $_, "%>");
				$xltline =~ s/$srch/$repl/g;
			}
		}
		while ($xltline =~ /<%=QUESTIONS_AH\.([0-9]+)\.(.+)%>/ ) {
			my $ques_num = $1 ;
			my $ques_index = $ques_num - 1 ;
			my $ques_key = $2 ;
			# warn "Found QUESTIONS_AH num $ques_num index $ques_index key $ques_key \n" ;
			$repl = ${$QUESTIONS_AH}[$ques_index]->{$ques_key} ;
			if ($OUTPUT_Format eq "RTF") {$repl =~ s/\<br\>/\\par /ig ;}
			$repl = &escape_special_chars( $repl ) if ( $escapem == 1 ) ;
			$srch = "<%=QUESTIONS_AH." . $ques_num . "." . $ques_key . "%>" ;
			$xltline =~ s/$srch/$repl/g ;
		}
		while ($xltline =~ /<%=QUESTIONS_AG\.([0-9]+)\.(.+)%>/ ) {
			my $ques_num = $1 ;
			my $ques_index = $ques_num - 1 ;
			my $ques_key = $2 ;
			# warn "Found QUESTIONS_AG num $ques_num index $ques_index key $ques_key \n" ;
			$repl = ${$QUESTIONS_AG}[$ques_index]->{$ques_key} ;
			if ($OUTPUT_Format eq "RTF") {$repl =~ s/\<br\>/\\par /ig ;}
			$repl = &escape_special_chars( $repl ) if ( $escapem == 1 ) ;
			$srch = "<%=QUESTIONS_AG." . $ques_num . "." . $ques_key . "%>" ;
			$xltline =~ s/$srch/$repl/g ;
		}
		if ($xltline =~ /(<%=)ESCAPED_(\S+\..*?%>)/i ) {
			#
			# I needed a way to indicate from within a template that a value
			# needs to be escaped for use within an HTML tag.  Thus,
			# you may put "ESCAPED_" in front of any template tag
			# and it gets removed here, but turns on the escape flag
			# for a recursive call to xlatline() and escape_special_chars().
			#
			# Initially this is only being implemented for %QUESTION,
			# but is structured to allow calls to escape_special_chars()
			# for other template tag types (see example above). -efl, 2/2002
			#
			$xltline =~ s/(<%=)ESCAPED_(\S+\..*?%>)/$1$2/g;
			return &xlatline($xltline, $fh, 1);
		}

		if ($xltline =~ /<%=CANDIDATES\.Options%>/i ) {
			&print_client_cnd_options($SESSION{'clid'}, $fh);
			return "";
		}
		if ($xltline =~ /<%=CANDIDATE\.(.*?)%>/i ) {
			# for (keys %CANDIDATE)   # This is the original code.  It is a loop. HBI 
			for (keys %CANDIDATE) {
				$srch1 = "<%=CANDIDATE.authtestsoptions%>";
				if ($xltline =~ m/$srch1/ ) {
					if ($CANDIDATE{'inproglist'} eq '') {
						@authtests = split(/\;/, $CANDIDATE{'authlist'});
						my $repl = "";
						foreach $authtest (@authtests) {
							if ($FORM{'testid'} eq "" || $FORM{'testid'} eq "$authtest") {
								&get_test_profile($SESSION{'clid'}, $authtest);
								#print $fh "<OPTION value=\"$TEST{'pwdtag'}$TEST{'id'}\">$TEST{'desc'}\n";
								$repl .= "<OPTION value=\"$TEST{'pwdtag'}$TEST{'popuptag'}$TEST{'id'}\">$TEST{'desc'}\n";
							}
						}
						#return "";
						$xltline =~ s/$srch1/$repl/eg;
					} else {
						@authtests = split(/\;/, $CANDIDATE{'inproglist'});
						my $repl = "";
						foreach $authtest (@authtests) {
							&get_test_profile($SESSION{'clid'}, $authtest);
							#print "<OPTION value=\"$TEST{'pwdtag'}$TEST{'id'}\">$TEST{'desc'}\n";
							$repl .= "<OPTION value=\"$TEST{'pwdtag'}$TEST{'popuptag'}$TEST{'id'}\">$TEST{'desc'}\n";
						}
						#return "";
						$xltline =~ s/$srch1/$repl/eg;
					}
				}
				$srch1 = "<%=CANDIDATE.authtestslist%>";
				if ($xltline =~ m/$srch1/ ) {
					$repl = $CANDIDATE{'authlist'};
					$replinprog = "";
					$replinprog = $CANDIDATE{'inproglist'};
					if ($replinprog ne "") {
						$replinprog=join('', $replinprog, '*');
						if ($repl eq "") {
							$repl=$replinprog;
						} else {
							$repl = join(';', $repl, $replinprog);
						}
					}
					$xltline =~ s/$srch1/$repl/eg;
				}
				$srch1 = "<%=CANDIDATE.oldtestsoptions%>";
				if ($xltline =~ m/$srch1/ ) {
					@authtests = split(/\;/, $CANDIDATE{'completedlist'});
					my $repl = "";
					foreach $authtest (@authtests) {
						&get_test_profile($SESSION{'clid'}, $authtest);
						$repl .= "<OPTION value=\"$TEST{'emlcndrvwopt'}$TEST{'id'}\">$TEST{'desc'}\n";
					}
					$xltline =~ s/$srch1/$repl/g;
				} 
				$srch1 = "<%=CANDIDATE.oldtestslist%>";
				if ($xltline =~ m/$srch1/ ) {
					$repl = $CANDIDATE{'completedlist'};
					$xltline =~ s/$srch1/$repl/g;
				}
				$srch1 = "<%=CANDIDATE.groups%>";
				if ($xltline =~ m/$srch1/ ) {
					&print_owned_groups($CLIENT{'clid'}, $CANDIDATE{'cndid'}, $fh);
				} else {
					$repl = $CANDIDATE{$_};
					$srch1 = join('', "<%=CANDIDATE.", $_, "%>");
					$xltline =~ s/$srch1/$repl/g;
				}
# v sac support for self-registration
				$srch1 = "<%=CANDIDATE.selfregistertests%>";
				if ($xltline =~ m/$srch1/ ) {
					if ($CANDIDATE{'inproglist'} ne '') {
						@authtests = split(/\;/, $CANDIDATE{'inproglist'});
						foreach $authtest (@authtests) {
							&get_test_profile($SESSION{'clid'}, $authtest);
							print "<OPTION value=\"$TEST{'pwdtag'}$TEST{'popuptag'}$TEST{'id'}\">$TEST{'desc'}";
						}
						return "";
					} else {
						$repl=&get_selfreg_test_list($SESSION{'clid'}, $CANDIDATE{'completedlist'});
						$xltline =~ s/$srch1/$repl/g;
						$xltline =~ s/\n/<\/option>\n/g;
						$xltline =~ s/\n<\/option>\n/\n/g;
					}
				}
			}
# ^ sac support for self-registration
		}
		$srch1 = "<%=DATE%>";
		if ($xltline =~ m/$srch1/ ) {
			$repl = &format_date_time("dd-mmm-yyyy", 1, "0");
			$xltline =~ s/$srch1/$repl/g;
		}
		if (!($xltline =~ /(<%=)NOP_(\S+.*?%>)/i)) {
			$xltline =~ s/<%=(.*?)%>//g;
		}
		print $fh "$xltline";
	} else {
		print $fh "$xltline";
	}
	return $xltline;
}

sub get_template {
	my ($template_base) = @_;
	# warn "Template $template_base Used." ; # HBI Trace template usage.
# v sac check for custom template
	if ($SESSION{'clid'} ne '') {
		$tmpfile = join($pathsep, $resptmplt, "$SESSION{'clid'}","$template_base.htt");
	} elsif ($FORM{'clid'} ne '') {
		$tmpfile = join($pathsep, $resptmplt, "$FORM{'clid'}","$template_base.htt");
	} else {
		$tmpfile = join($pathsep, $resptmplt, "$CLIENT{'clid'}","$template_base.htt");
	}
# ^ sac check for custom template
	unless (&file_exists($tmpfile)) {
		$tmpfile = join($pathsep, $resptmplt, "$template_base.htt");
	}
#	&logger::logdbg("Reading template $template_base.htt");
	my @locallines;
	# FIXME:  This should probably just be done with get_data(). -efl
	if ( open (TMPFILE, "<$tmpfile") ) {
		@locallines = <TMPFILE>;
		close TMPFILE;
	} else {
		&logger::logerr("Unable to open $tmpfile for reading:  $!");
	}
	return @locallines;
}

############################################################################
#
# Function:  generate_from_template($template_base, $targetfile)
#
# Description:  Read and parse template with name $template_base.htt
#               and output result to $targetfile.
#
# Returns:  1 if successful, 0 if not, with very little error-checking
# 			to prevent accidental clobbering.
#
# Author:  efl, 11/2001
#
############################################################################
sub generate_from_template( $ $ ) {
	my ($template_base, $targetfile) = @_;
	if ( ! $template_base ) {
		&logger::logerr("Unexpectedly undefined template basename; aborting template generation process.");
		return 0;
	}
	if ( ! $targetfile ) {
		&logger::logerr("Unexpectedly undefined template target filename; aborting template generation process.");
		return 0;
	}
	if ( ! open (OUTFILE, ">$targetfile") ) {
		&logger::logerr("Unable to open template target file '$targetfile': $!");
		return 0;
	}
	@lines = &get_template($template_base);
	foreach $line (@lines) {
		$line = &xlatline($line, *OUTFILE);
	}
	close OUTFILE;

	return 1;
}

sub show_template {
	my ($base, $fh) = @_;
	$fh = (defined($fh) ? $fh : *STDOUT);
	if (defined($SESSION{'lang'})) {
		&LoadLanguage($SESSION{'lang'});
	} elsif (defined($FORM{'lang'})) {
		&LoadLanguage($FORM{'lang'});
	}
	warn "HBI Debug Template file $base " if ($HBI_Debug_smilib_show_template) ;
	@lines = &get_template($base);
	foreach $line (@lines) {
		$line = &xlatline($line, $fh);
	}
}

sub show_admin_request {
        my ($key) = @_;
        &get_template($key);
        @lines = &get_template($key);
        foreach $line (@lines) {
                $line = &xlatline($line);
        }
}
sub get_site_reports_list {
	my ($fh) = @_;
	$fh = (defined($fh) ? $fh : *STDOUT);
	@rrecs = &get_data("sitereports.dat");
	$nrecs = $#rrecs;
	for $i (1 .. $nrecs) {
		@flds = split(/&/, $rrecs[$i++]);
		print $fh "<OPTION value=\"$flds[0]\">$flds[1]\n";
	}
}

sub get_client_reports_list {
	my ($fh, $cndid, $uid) = @_;
	$fh = (defined($fh) ? $fh : *STDOUT);
	my $isaregistrar = &get_a_key("cnd.$cndid", $uid, "registrar");
	@rrecs = &get_data("reports.$SESSION{'clid'}");
	$nrecs = $#rrecs;
	for $i (1 .. $nrecs) {
		@flds = split(/&/, $rrecs[$i++]);
		if ($isaregistrar eq 'Y') {
			if ($flds[0] ne "ENV" && $flds[0] ne "GROUPS") {
				print $fh "<OPTION value=\"$flds[0]\">$flds[1]\n";
			}
		} else {
			print $fh "<OPTION value=\"$flds[0]\">$flds[1]\n";
		}
	}
}

# Hashs to keep in-memory copies of data files.
# %data_get_data uses a file name for a key, and the value 
#   is a copy of the data file.
# %mtime_get_data uses the same key and the value is a
#   time value for the last known change to the file.
my %mtime_get_data = () ;
my %data_get_data = () ;

sub get_data {
	my ($file, $lock) = @_;
 	$tmpfile = join($pathsep, $dataroot, $file);
	if ($lock) { 
		$lockfile = join($pathsep, $dataroot, "$file.lock");
		while (-e $lockfile) {}
		if ( open (LOCKFILE, ">$lockfile") ) {
			close LOCKFILE;
		} else {
			&logger::logerr("get_data: Unable to lock $tmpfile:  $!");
			return 0;
		}
	}
	my @locallines; my $local_mtime ;
	my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, 
			$size, $atime, $mtime, $ctime, $blksize, $blocks) ;
	unless($data_get_data{$tmpfile}) {
		if ( open (TMPFILE, "<$tmpfile") ) {
			@locallines = <TMPFILE>;
			($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $local_mtime, $ctime, $blksize, $blocks) = stat TMPFILE ;
			close TMPFILE;
			$mtime_get_data{$tmpfile} = $local_mtime ;
			$data_get_data{$tmpfile} = \@locallines ;
		} else {
			&logger::logerr("Unable to open $tmpfile for reading:  $!");
		}
	} else {
		($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $local_mtime, $ctime, $blksize, $blocks) = stat $tmpfile ;
		if ($local_mtime > $mtime_get_data{$tmpfile}) {
			# Replace the data values.
			if ( open (TMPFILE, "<$tmpfile") ) {
				@locallines = <TMPFILE>;
				($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $local_mtime, $ctime, $blksize, $blocks) = stat TMPFILE ;
				$mtime_get_data{$tmpfile} = -- $local_mtime ;
				$data_get_data{$tmpfile} = \@locallines ;
				close TMPFILE;
				utime $atime, $local_mtime , $tmpfile ;
			} else {
				&logger::logerr("Unable to open $tmpfile for reading:  $!");
			}
		} else {
			@locallines = @{${data_get_data}{$tmpfile}} ;
		}
	}
	return @locallines;
}

sub get_log {
 	$tmpfile = join($pathsep, $logroot, $_[0]);
	open (TMPFILE, "<$tmpfile") or $msg="failed";
	@locallines = <TMPFILE>;
	close TMPFILE;
	return @locallines;
}

sub get_madmin_client_list {
	my ($clients, $fh) = @_;
	$fh = (defined($fh) ? $fh : *STDOUT);
	@clients = split(':', $clients);
	for $i (0 .. $#clients) {
		$clients[$i] =~ tr/\+/ /;
		if ($clients[$i] eq $CLIENT{'clid'}) {
			print $fh "<OPTION value=\"$clients[$i]\" selected>$clients[$i]</OPTION>\n";
		} else {
			print $fh "<OPTION value=\"$clients[$i]\">$clients[$i]</OPTION>\n";
		}
	}
}

sub regdusr {
	my ($template) = @_;
	@lines = &get_template($template);
	foreach $line (@lines) {
		if ($line =~ /<%=SITE.REPORTS%>/) {
			&get_site_reports_list;
		} elsif ($line =~ /<%=CLIENT.REPORTS%>/) {
			&get_client_reports_list(undef, $SESSION{'clid'}, $SESSION{'uid'});
		} elsif ($line =~ /<%=MADMIN.CLIENTS%>/) {
			&get_madmin_client_list($FORM{'clid'});
		} elsif ($line =~ /<%=FORM.testid%>/) {
			$line =~ s/<%=FORM.testid%>/$FORM{'testid'}/;
			print $line;
		} else {
			$line = &xlatline($line);
		}
	}
}

sub send_cookie {
	$expdte = &format_date_time("dddd, dd-mmm-yy hh:nn:ss GMT", "1", "2592000");
	print "Set-Cookie: $_[0]=$_[1]; DOMAIN=$ENV{'HTTP_HOST'}; path=/~smiadmin/; expires=$expdte\n";
}

#
# $datetimestring = &format_date_time($formatstring,$timezone,$flag,$value)
#	$formatstring	dd = day
#					mm = month (01,02,...)
#					mmm = month (Jan,Feb,...)
#					yy = year (00,01,...)
#					yyyy = year (2000,2001,...)
#	$timezone = 1 : GMT
#				2 : Local Time
#	$flag	 = 	-1 : time - 1000
#				-10000 : absolute ($value)
#				??? = relative (time + $flag)
#
sub format_date_time {
	$sformatted = $_[0];
	if ($_[1] == '1') {
		if ($_[2]=='-1') {
			@tmvalues = gmtime(time-1000);
		} else {
			if ($_[2]=='-10000') {
				@tmvalues = gmtime($_[3]);
			} else {
				@tmvalues = gmtime(time+$_[2]);
			}
		}
	} else {
		if ($_[2]=='-1') {
			@tmvalues = localtime(time-1000);
		} else {
			if ($_[2]=='-10000') {
				@tmvalues = localtime($_[3]);
			} else {
				@tmvalues = localtime(time+$_[2]);
			}
		}
	}

	$ss = sprintf( "%02d", $tmvalues[0]);
	($trash, $ms) = Time::HiRes::gettimeofday();
	$nn = sprintf( "%02d", $tmvalues[1]);
	$h = sprintf( "%d", $tmvalues[2]);
	$hh = sprintf( "%02d", $tmvalues[2]);
	$dd = sprintf( "%02d", $tmvalues[3]);
	$mm = sprintf( "%02d", $tmvalues[4]+1);
	$mmm = format_month($tmvalues[4], "0");
	$mmmm = format_month($tmvalues[4], "1");
	$yy = format_year($tmvalues[5], "0");
	$yyyy = format_year($tmvalues[5], "1");
	$ddd = format_day_of_week($tmvalues[6], "0");
	$dddd = format_day_of_week($tmvalues[6], "1");

	$sformatted =~ s/ss/$ss/ig;
	$sformatted =~ s/ms/$ms/ig;
	$sformatted =~ s/nn/$nn/ig;
	$sformatted =~ s/hh/$hh/ig;
	$sformatted =~ s/h/$h/ig;
	$sformatted =~ s/dddd/$dddd/ig;
	$sformatted =~ s/ddd/$ddd/ig;
	$sformatted =~ s/dd/$dd/ig;
	$sformatted =~ s/mmmm/$mmmm/ig;
	$sformatted =~ s/mmm/$mmm/ig;
	$sformatted =~ s/mm/$mm/ig;
	$sformatted =~ s/yyyy/$yyyy/ig;
	$sformatted =~ s/yy/$yy/ig;
	return $sformatted;
}

sub format_day_of_week {
	@dayarray = ( ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"],
		["Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"] );
	return $dayarray[$_[1]][$_[0]];
}

sub format_month {
	@montharray = ( ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"],
		["January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"] );
	return $montharray[$_[1]][$_[0]];
}

sub format_year {
	if ($_[0] > '99') {
		if ($_[1] == '0') {
			return sprintf("%02d", $_[0]-100);
		} else {
			return sprintf("%04d", $_[0]+1900);
		}
	} else {
		if ($_[1] == '0') {
			return sprintf("%02d", $_[0]);
		} else {
			return sprintf("%04d", $_[0]+1900);
		}
	}
	
}

#
# returns date time values in array elements:
#	0 = seconds	(0-59)
#	1 = minutes	(0-59)
#	2 = hours	(0-23)
#	3 = day		(0-30)
#	4 = month	(0-11)
#	5 = year
#	6 = day of week (0-6)
#	7 = seconds since Jan 1 1970
#
sub compute_date_time {
	my ($datestring) = @_;
	my @days = ('SUNDAY','MONDAY','TUESDAY','WEDNESDAY','THURSDAY','FRIDAY','SATURDAY');
	my @months = ('JANUARY','FEBRUARY','MARCH','APRIL','MAY','JUNE','JULY','AUGUST','SEPTEMBER','OCTOBER','NOVEMBER','DECEMBER');
	my @ampm = ('A','AM','P','PM');
	my $pmflag=0;
	my $tm="hns";
	my $mm="mdy";
	my @dtvalues=();
	my @numvals=();
	my @numflgs=();
	my @chrs=split(//,$datestring);
	my $c;
	my $h="";
	my $i=0;
	my $j=0;
	my $k=0;
	my $l=0;
	my $wordnum="";
	my $wordstr="";
	my $ignorespaces=1;
	my $wordbreak=0;
	foreach $c (@chrs) {
		if (($c eq ' ') && ($ignorespaces)) {
			next;
		};
		$ignorespaces=0;
		if ($c =~ /([:\-\/\,\s])/ ) {
			$wordbreak=1;
			$ignorespaces=1;
		} elsif ($c =~ /([a-zA-Z])/ ) {
			if ($wordnum eq '') {
				$wordstr=join('',$wordstr,"$c");
			} else {
				$wordbreak = 1;
				$h=$c;
			}
		} elsif ($c =~ /([0-9])/ ) {
			if ($wordstr eq '') {
				$wordnum = join('',$wordnum,"$c");
			} else {
				$wordbreak = 1;
				$h=$c;
			}
		} else {
		}
		$wordbreak = ($c eq $chrs[$#chrs]) ? 1 : $wordbreak;
		if ($wordbreak) {
			$wordbreak=0;
			if ($wordstr ne '') {
				$wordstr = uc($wordstr);
				# check AMPM and TZ
				if (length($wordstr) < 3) {
					for $j (0..$#ampm) {
						if ($ampm[$j] eq $wordstr) {
							$pmflag=($ampm[$j] =~ /P/ ) ? 1: 0;
							for $k (0 .. $i) {
								if ($numflgs[$k] eq 'h') {
									if ($pmflag) {
										if ($numvals[$k] < 12) {
											$numvals[$k]+=12;
										}
									} else {
										if ($numvals[$k] > 11) {
											$numvals[$k]-=12;
										}
									}
									last;
								}
							}
							last;
						}
					}
				} else {
					# check TZ
					# check for month
					for $j (0..$#months) {
						if ($months[$j] =~ /$wordstr/ ) {
							$numvals[$i]=$j;
							$numflgs[$i]="m";
							$mm =~ s/m//;
							$i++;
							last;
						}
					}
				}
				$wordstr="";
			} else {
				if ($c eq ':') {
					# time element
					$numflgs[$i]=substr($tm,0,1);
					$tm=substr($tm,1);
				} elsif (($c eq '/') || ($c eq '-')) {
					# date element
					$numflgs[$i]=$mm;
				} else {
					$j=$i-1;
					if ($numflgs[$j] eq 'n') {
						$numflgs[$i]="s";
						$tm = s/s//;
					} else {
						$numflgs[$i]="?";
					}
				}
				$numvals[$i]=$wordnum;
				$wordnum="";
				$i++;
			}
			if ($h ne '') {
				if ($h =~ /([a-zA-Z])/ ) {
					$wordstr=$h;
				} else {
					$wordnum=$h;
				}
				$h="";
				$wordbreak = ($c eq $chrs[$#chrs]) ? 1 : 0;
			}
		}
	}
	for $j (0 .. $#numvals) {
		$i = $j-1;
		$k = $j+1;
		if ($numflgs[$j] eq '?') {
			if ($j == 0) {
				if ($numflgs[$k] eq 'm') {
					$numflgs[$j]="d";
					$k++;
					$numflgs[$k]="y";
				}
			} elsif ($j == 1) {
				if ($numflgs[$i] eq 'm') {
					$numflgs[$j]="d";
					$numflgs[$k]="y";
				}
			} else {
				if (($j == 2) && ($numflgs[$i] eq 'm')) {
					$i--;
					if ($numflgs[$i] eq 'mdy') {
						$numflgs[$i]="d";
						$i++;
					}
					$numflgs[$j]="y";
					next;
				}
				if ($numflgs[$i] eq 'mdy') {
					$i--;
					if ($numflgs[$i] eq 'mdy') {
						$numflgs[$i]="m";
						$numvals[$i]--;
						$i++;
						$numflgs[$i]="d";
						$numflgs[$j]="y";
					}
				} elsif ($numflgs[$i] eq 'h') {
					$numflgs[$j]="n";
				} elsif (length($numvals[$j]) >= 4) {
					$k=length($numvals[$j]);
					$l=$#numflgs+1;
					for $i (0 .. $k) {
						if ($i == 1) {
							$numvals[$l]=substr($numvals[$j],0,2);
							$numflgs[$l]="h";
							$l++;
						} elsif ($i == 3) {
							$numvals[$l]=substr($numvals[$j],2,2);
							$numflgs[$l]="n";
							$l++;
						} elsif ($i == 5) {
							$numvals[$l]=substr($numvals[$j],4);
							$numflgs[$l]="s";
						}
					}
					$numvals[$j]="";
					$numflgs[$j]="";
				}
			}
		}
	}
	$dtvalues[0]=0;
	$dtvalues[1]=0;
	$dtvalues[2]=0;
	$dtvalues[3]=0;
	$dtvalues[4]=0;
	$dtvalues[5]=0;
	$dtvalues[6]=0;
	$dtvalues[7]=0;
	$j=0;
	for $i (0..$#numvals) {
		$dtvalue[$i]=0;
		if ($numflgs[$i] eq 's') {
			$dtvalues[0]=$numvals[$i];
			$j+=int($numvals[$i]);
		} elsif ($numflgs[$i] eq 'n') {
			$dtvalues[1]=$numvals[$i];
			$j+=(int($numvals[$i])*60);
		} elsif ($numflgs[$i] eq 'h') {
			$dtvalues[2]=$numvals[$i];
			$j+=(int($numvals[$i])*3600);
		} elsif ($numflgs[$i] eq 'd') {
			$dtvalues[3]=$numvals[$i];
			$j+=((int($numvals[$i])-1)*86400);
		} elsif ($numflgs[$i] eq 'm') {
			$dtvalues[4]=$numvals[$i];
		} elsif ($numflgs[$i] eq 'y') {
			if ($numvals[$i] < 100)  {
				if ($numvals[$i] > 69)  {
					$numvals[$i]+=1900;
				} else {
					$numvals[$i]+=2000;
				}
			}
			$dtvalues[5]=$numvals[$i];
			$k=int($numvals[$i])-1970;
			$l=($k+2)-(($k+2) % 4);
			$l=int($l/4) * 86400;
			$j+=(($k*31536000)+$l);
		}
	}
	$j+=compute_month_seconds($dtvalues[5],$dtvalues[4]);
	$dtvalues[7]=$j;
	return wantarray ? @dtvalues : $j;
}

sub compute_month_seconds {
	my ($y,$m) = @_;
	my $i;
	my $n=0;
	my @dpm = (0,31,28,31,30,31,30,31,31,30,31,30);
	$y %= 4;
	if ($y==0) {
		@dpm[2]++;
	}
	for $i (0 .. $m) {
		$n+=$dpm[$i]*86400;
	}
	return $n;
}

sub log_entry {
#
#	Emergency fix for lost test data
#
#	my ($clid, $uid) = @_;
#	$tmstmp = &format_date_time("dd-mmm-yy hh:nn:ss GMT", "1", "0");
#	@flds = @_;
#	$j = $#flds;
#	$newrec =  $tmstmp;
#	$newrec = join(',', $newrec, $SESSION{'tid'});
#	for $i (2 .. $j) {
#		$newrec = join(',', $newrec, $flds[$i++]);
#	}
#	$logfile = join($pathsep, $logroot, "$clid.$uid");
#	if (open (TMPFILE, ">>$logfile")) {
#		print TMPFILE "$newrec\n";
#		close TMPFILE;
#	} else {
#		open (TMPFILE, ">$logfile");
#		@tmprecs = <TMPFILE>;
#		foreach $tmprec (@tmprecs) {
#			print TMPFILE "$tmprec";
#		}
#		print TMPFILE "$newrec\n";
#		close TMPFILE;
#	}
#	$chmodok = chmod 0666, $logfile;
	my ($clid, $uid, $code, $message, $tmstmp) = @_;
	my $i;
	my $logfile;
	my @tmprecs;
	my $chmodok;

	if (!$tmstmp) {
		$tmstmp = &format_date_time("dd-mmm-yyyy hh:nn:ss.ms GMT", "1", "0");
	}
	my @flds = @_;
	my $j = $#flds;
	my $newrec =  $tmstmp;
	$newrec = join(',', $newrec, $SESSION{'tid'});
	for $i (2 .. $j) {
		$newrec = join(',', $newrec, $flds[$i++]);
	}
	$logfile = join($pathsep, $logroot, "$clid.$uid");
	if (open (TMPFILE, ">>$logfile")) {
		print TMPFILE "$newrec\n";
		close TMPFILE;
	} else {
		open (TMPFILE, ">$logfile");
		@tmprecs = <TMPFILE>;
		foreach $tmprec (@tmprecs) {
			print TMPFILE "$tmprec";
		}
		print TMPFILE "$newrec\n";
		close TMPFILE;
	}
	$chmodok = chmod 0666, $logfile;
}

sub print_client_adminids {
	my ($filterid, $fh) = @_;
	$fh = (defined($fh) ? $fh : *STDOUT);
	@adminids = &get_data("admin.dat");
	$adminid = $adminids[0];
	chop($adminid);
	@lstflds = split(/&/, $adminid);
	$lstidx = 0;
	foreach $lstfld (@lstflds) {
		if ($lstfld eq 'uid') { $uididx = $lstidx;}
		elsif ($lstfld eq 'clid') { $clididx = $lstidx;}
		elsif ($lstfld eq 'uac') { $uacidx = $lstidx;}
		$lstidx++;
	}
	for (1 .. $#adminids) {
		$adminid = $adminids[$_];
		chop($adminid);
		@lstflds = split(/&/, $adminid);
		if ($lstflds[$uacidx] eq "madmin") {
			$ids{$lstflds[$uididx]} = "m-$lstflds[$clididx]";
		} elsif ($lstflds[$clididx] eq $filterid ) {
			$ids{$lstflds[$uididx]} = "$lstflds[$clididx]";
		}
	}
	foreach $lstid (keys(%ids)) {
		print $fh "<OPTION VALUE=\"$ids{$lstid}\">$lstid</OPTION>\n";
	}
	@lstflds = ();
	@adminids = ();
}

sub print_client_test_forms {
	my ($clientID, $fh) = @_;
	$fh = (defined($fh) ? $fh : *STDOUT);
	$omsg = "";
	opendir( DATADIR, $questionroot ) or $omsg="could not open dir $questionroot: $!";
	if ($omsg ne "") {
		# handle error message
		#print $fh "$omsg\n";
	} else {
		@client_forms = grep { /$clientID.form$/ && -f "$questionroot/$_" } readdir(DATADIR);
		closedir(DATADIR);
		$numcforms = $#client_forms + 1;
		$tests = "";
		for ($i=0;$i<$numcforms;$i++) {
			my ($test, $trash) = split(/\./, $client_forms[$i]);
			$tests .= "\"$test\",";
		}
		$tests = substr($tests, 0, -1);
		print $fh "\tvar forms = new Array($tests)";
	}
}

sub make_group {
	$grpfile = join($pathsep, $dataroot, "$_[0].groups");
	open (TMPGRP, "<$grpfile") or $mustcreate = 1;
	close TMPGRP;
	if ($mustcreate == 1) {
		$grpfilestd = join($pathsep, $dataroot, "groups.std");
		&make_file($grpfile, $grpfilestd, 1);
	}
}

sub get_group_owners {
	@grpowners = &get_data("cnd.$_[0]");
	$grpowner = shift @grpowners;
	chop ($grpowner);
	@grpflds = split(/&/, $grpowner);
	for (1 .. $#grpflds) { $GOFIELDS{$grpflds[$_]} = $_; }
	@grpflds = ();
	return @grpowners;
}

sub print_group_owners {
	my ($clientID, $fh, $ownedby_flag) = @_;
	$fh = (defined($fh) ? $fh : *STDOUT);
	@grpowners = &get_group_owners($clientID);
	$idxid = $GOFIELDS{'cndid'};
	$idxnmf = $GOFIELDS{'nmf'};
	$idxnmm = $GOFIELDS{'nmm'};
	$idxnml = $GOFIELDS{'nml'};
	$idxgrpo = $GOFIELDS{'grpowner'};
	for (0 .. $#grpowners) {
		$grpowner = $grpowners[$_];
		chop ($grpowner);
		@grpdata = split(/&/, $grpowner);
		$selected = "";
		if ($grpdata[$idxgrpo] eq 'Y') {
			if ($ownedby_flag && $grpdata[$idxid] eq $TEST{'ownedby'}) {
				$selected = " SELECTED";
			}
			print $fh "<OPTION VALUE=\"$grpdata[$idxid]\"$selected>$grpdata[$idxnml], $grpdata[$idxnmf] $grpdata[$idxnmm]</OPTION>\n";
		}
	}
}

sub get_registrars {
	@registrars = &get_data("cnd.$_[0]");
	$registrar = shift @registrars;
	chop ($registrar);
	@regflds = split(/&/, $registrar);
	for (1 .. $#regflds) { $REGFIELDS{$regflds[$_]} = $_; }
	@regflds = ();
	return @registrars;
}

sub print_registrars {
	my ($clientID, $fh, $ownedby_flag) = @_;
	$fh = (defined($fh) ? $fh : *STDOUT);
	@registrars = &get_registrars($clientID);
	$idxid = $REGFIELDS{'cndid'};
	$idxnmf = $REGFIELDS{'nmf'};
	$idxnmm = $REGFIELDS{'nmm'};
	$idxnml = $REGFIELDS{'nml'};
	$idxreg = $REGFIELDS{'registrar'};
	for (0 .. $#registrars) {
		$registrar = $registrars[$_];
		chop ($registrar);
		@regdata = split(/&/, $registrar);
		$selected = "";
		if ($regdata[$idxreg] eq 'Y') {
			if ($ownedby_flag && $regdata[$idxid] eq $TEST{'ownedby'}) {
				$selected = " SELECTED";
			}
			print $fh "<OPTION VALUE=\"$regdata[$idxid]\"$selected>$regdata[$idxnml], $regdata[$idxnmf] $regdata[$idxnmm]</OPTION>\n";
		}
	}
}

sub get_client_groups {
	@grpsunsorted = &get_data( "groups.$_[0]");
	$grp = shift @grpsunsorted;
	@grps = sort @grpsunsorted;
	@grpsunsorted = ();
	chop ($grp);
	@grpflds = split(/&/, $grp);
	for (0 .. $#grpflds) { $GRPFIELD{$grpflds[$_]} = $_; }
	@grpflds = ();
	return @grps;
}

sub get_group {
	@grpcnds = &get_data("cnd.$_[0]");
	$grpcnd = $grpcnds[0];
	chop ($grpcnd);
	$grpcndflds = split(/&/, $grpcnd);
	for (0 .. $#grpcndflds) { $GRPMEMFLDS{$grpcndflds[$_]} = $_;}
	@grpcndflds = ();
	$idxgrpid = $GRPMEMFLDS{'grpid'};
	$idxmemid = $GRPMEMFLDS{'cndid'};
	$idxmemnme = "$GRPMEMFLDS{'nml'}, $GRPMEMFLDS{'nmf'}, $GRPMEMFLDS{'nmm'}";
	for (1 .. $#grpcnds) {
		$grpcnd = $grpcnds[$_];
		chop ($grp);
		@grpcnddata = split(/&/, $grpcnd);
		if ($grpcnddata[$idxgrpid] =~ /$_[0].$_[1]/i ) {
			
		} else {
		}
	}
}

# DED 11/9/04
# send clid, grpid
# return array of cndids in group
sub get_group_cnds {
	my @groups = &get_client_groups($_[0]);
	my $grpid = $_[1];
	foreach (@groups) {
		my @grp = split(/\&/, $_);
		if ($grp[1] eq "$grpid") {
			my @cnds = split(/\,/,$grp[3]);
			return @cnds;
		}
	}
}

sub get_owned_groups {
	@ownedgrps = ();
	@grps = &get_client_groups($_[0]);
	foreach $grp (@grps) {
		if ($grp =~ /$_[0].$_[1].(\.\*)\&/i ) {
			push @ownedgrps, $grp;
		}
	}
	@grps = ();
	return @ownedgrps;
}

sub print_client_groups {
	my ($clientID, $fh) = @_;
	$fh = (defined($fh) ? $fh : *STDOUT);
	@cligrps = &get_client_groups($clientID);
	$idxid = $GRPFIELD{'grpid'};
	$idxdesc = $GRPFIELD{'grpdesc'};
	for (0 .. $#cligrps) {
		$grp = $cligrps[$_];
		chop ($grp);
		@grpdata = split(/&/, $grp);
		print $fh "<OPTION VALUE=\"$grpdata[$idxid]\">$grpdata[$idxdesc]\n";
	}
}

sub print_owned_groups {
	@cligrps = &get_owned_groups($_[0], $_[1]);
	my $fh = (defined($_[2]) ? $_[2] : *STDOUT);
	$idxid = $GRPFIELD{'grpid'};
	$idxdesc = $GRPFIELD{'grpdesc'};
	for (1 .. $#cligrps) {
		$grp = $cligrps[$_];
		chop ($grp);
		@grpdata = split(/&/, $grp);
		print $fh "<OPTION VALUE=\"$grpdata[$idxid]\">$grpdata[$idxdesc]\n";
	}
}

$SYSTEM{'years'} = "<OPTION VALUE=\"2009\">2009
<OPTION VALUE=\"2010\">2010
<OPTION VALUE=\"2011\">2011
<OPTION VALUE=\"2012\">2012
<OPTION VALUE=\"2013\">2013
<OPTION VALUE=\"2014\">2014
<OPTION VALUE=\"2015\">2015
<OPTION VALUE=\"2016\">2016
<OPTION VALUE=\"2017\">2017
<OPTION VALUE=\"2018\">2018
<OPTION VALUE=\"2019\">2019
<OPTION VALUE=\"2020\">2020
<OPTION VALUE=\"2021\">2021
<OPTION VALUE=\"2022\">2022
<OPTION VALUE=\"2023\">2023
<OPTION VALUE=\"2024\">2024
<OPTION VALUE=\"2025\">2025
";

$SYSTEM{'months'} = "<OPTION VALUE=\"01\">Jan
<OPTION VALUE=\"02\">Feb
<OPTION VALUE=\"03\">Mar
<OPTION VALUE=\"04\">Apr
<OPTION VALUE=\"05\">May
<OPTION VALUE=\"06\">Jun
<OPTION VALUE=\"07\">Jul
<OPTION VALUE=\"08\">Aug
<OPTION VALUE=\"09\">Sep
<OPTION VALUE=\"10\">Oct
<OPTION VALUE=\"11\">Nov
<OPTION VALUE=\"12\">Dec
";
$SYSTEM{'days'} = "<OPTION VALUE=\"01\">01
<OPTION VALUE=\"02\">02
<OPTION VALUE=\"03\">03
<OPTION VALUE=\"04\">04
<OPTION VALUE=\"05\">05
<OPTION VALUE=\"06\">06
<OPTION VALUE=\"07\">07
<OPTION VALUE=\"08\">08
<OPTION VALUE=\"09\">09
<OPTION VALUE=\"10\">10
<OPTION VALUE=\"11\">11
<OPTION VALUE=\"12\">12
<OPTION VALUE=\"13\">13
<OPTION VALUE=\"14\">14
<OPTION VALUE=\"15\">15
<OPTION VALUE=\"16\">16
<OPTION VALUE=\"17\">17
<OPTION VALUE=\"18\">18
<OPTION VALUE=\"19\">19
<OPTION VALUE=\"20\">20
<OPTION VALUE=\"21\">21
<OPTION VALUE=\"22\">22
<OPTION VALUE=\"23\">23
<OPTION VALUE=\"24\">24
<OPTION VALUE=\"25\">25
<OPTION VALUE=\"26\">26
<OPTION VALUE=\"27\">27
<OPTION VALUE=\"28\">28
<OPTION VALUE=\"29\">29
<OPTION VALUE=\"30\">30
<OPTION VALUE=\"31\">31
";

$SYSTEM{'hours'} = "<OPTION VALUE=\"1\">1
<OPTION VALUE=\"2\">2
<OPTION VALUE=\"3\">3
<OPTION VALUE=\"4\">4
<OPTION VALUE=\"5\">5
<OPTION VALUE=\"6\">6
<OPTION VALUE=\"7\">7
<OPTION VALUE=\"8\">8
<OPTION VALUE=\"9\">9
<OPTION VALUE=\"10\">10
<OPTION VALUE=\"11\">11
<OPTION VALUE=\"12\">12
";

$SYSTEM{'minutes'} = "<OPTION VALUE=\"00\">00
<OPTION VALUE=\"5\">05
<OPTION VALUE=\"10\">10
<OPTION VALUE=\"15\">15
<OPTION VALUE=\"20\">20
<OPTION VALUE=\"25\">25
<OPTION VALUE=\"30\">30
<OPTION VALUE=\"35\">35
<OPTION VALUE=\"40\">40
<OPTION VALUE=\"45\">45
<OPTION VALUE=\"50\">50
<OPTION VALUE=\"55\">55
";

$SYSTEM{'pmoffset'} = "<OPTION VALUE=\"00\">AM
<OPTION VALUE=\"12\">PM
";

# <ACTSEMBED='filename' ALIGN=TOP|BOTTOM|INSERT NUMBER=BEFORE|AFTER>
sub merg_exhibit_in_text {
	$beginKeep = 0;
	$tmptext = $_[0];
	$findtext = "<ACTSEMBED=(.*)>";
	if ($tmptext =~ /$findtext/i ) {
		$findtext = "<ACTS";
		($toptext,$exhcmd) = split(/$findtext/, $tmptext);
		($exhcmd,$bottomtext) = split(/>/, $exhcmd);
		lc($exhcmd);
		@parms = split(/ /, $exhcmd);
		foreach $parm (@parms) {
			$parm =~ s/ //g;
			($nme,$vlu) = split(/=/, $parm);
			if (($nme ne '') && ($vlu ne '')) {
				lc($nme);
				lc($vlu);
				$EXHIBIT_PARM{$nme} = $vlu;
			}
		}
		if ($EXHIBIT_PARM{'EMBED'} ne '') {
			$prefile = join($pathsep, $questionroot, "actsexhibit", $EXHIBIT_PARM{'EMBED'});
			$exhfile = &file_exists_with_extension($prefile, "htt;htm;html");
			if ($exhfile ne '') {
				open(EXHFILE, "<$exhfile");
				@exhlines = <EXHFILE>;
				close EXHFILE;
				$instext = "\n";
				foreach $exhline (@exhlines) {
					if ($exhline =~ /<BODY/i) {
						$beginKeep=1;
					} else {
						if ($beginKeep) {
							if ($exhline =~ /BODY>/i) {
								$beginKeep=0;
							} else {
								$instext = join('', $instext, $exhline);
							}
						}
					}
				}
				if ($EXHIBIT_PATM{'align'} eq 'bottom') {
					$tmptext = join('',  $_[0], $instext);
				} elsif ($EXHIBIT_PATM{'align'} eq 'insert') {
					$tmptext = join('',  $toptext, $instext, $bottomtext);
				} else {
					$tmptext = join('', $instext,  $_[0]);
				}
			}
		}
	}
	return $tmptext;
}

# @phrases = &get_phrases(_LANGUAGE_ID);
sub get_phrases {
	my ($lang) = @_;
	$tmpfile = join($pathsep, $secroot, "language", "phrases.$lang");
	if ( ! open (TMPFILE, "<$tmpfile") ) {
		&logger::logerr("Unable to read $tmpfile: $!");
		return ();
	}
	@locallines = <TMPFILE>;
	close TMPFILE;
	return @locallines;
}

# @phrases = &put_phrases($languageid);
sub put_phrases {
	$tmpfile = join($pathsep, $secroot, "language", "phrases.$_[0]");
	open (TMPFILE, ">$tmpfile") or return 0;
	for (0 .. $#sTranslation) {
		print TMPFILE "$sTranslation[$_]\n";
	}
	close TMPFILE;
	return 1;
}

# 
# $access = &ipfilteredaccess($filtermasks, $visitorip);
#
#	RETURNS 0 = access denied
#		1 = access permitted
#
# ipaddress filters can be submitted in pairs separated by a comma
#	xxxx:nnn.sss.bbb.mmm,xxxx:nnn.sss.bbb.mmm
#  	x = A (absolute match of segment required) 
#     	x = M (masked LOGICAL AND match of segment required)
#  	if x is omitted, all segments are treated as masked.
#
sub ipfilteredaccess {
	my $visitor = $_[1];
	my $visitortocheck = $_[1];
	my @filters = split(/\,/, $_[0]);
	my @rslt = ();
	my @filtersegs = ();
	my @applymask = ();
	my @visitsegs = split(/\./, $visitor);
	my $filter = "";
	foreach $filter (@filters) {
		(my $segeval, my $ipmask) = split(/:/, lc($filter));
		if ($ipmask eq '') { $ipmask = $segeval; $segeval="MMMM";}
		@filtersegs = split(/\./, $ipmask);
		@applymask = split(//,$segeval);
		for (0 .. $#filtersegs) {
			use integer;
			if ($applymask[$_] eq "A") {
				@rslt[$_] = ($visitsegs[$_] eq $filtersegs[$_]) ? $visitsegs[$_] : 0;
		} elsif ($applymask[$_] eq "M") {
				@rslt[$_] = int($visitsegs[$_]) & int($filtersegs[$_]);
			} else {
				@rslt[$_] = 0;
			}
		}
		$visitor = "$rslt[0].$rslt[1].$rslt[2].$rslt[3]";
		@rslt = ();
		@filtersegs = ();
		@applymask = ();
		if ($visitor eq $visitortocheck) {
			@filters = ();
			return 1;
		}
	}
	@filters = ();
	return 0;
}
## v support for self-registration
sub setbrowsertype {
	$SESSION{'useragent'}=$ENV{'HTTP_USER_AGENT'};
	if ($FORM{'browser'} eq '') {
		if ($SESSION{'useragent'} =~ /MSIE/ ) {
			$FORM{'browser'} = "MSIE/4";
		} else {
			$FORM{'browser'} = "NSNV/4";
		}
	}
	($SESSION{'browserapp'}, $SESSION{'browserversion'}) = split(/\//, $FORM{'browser'});
}
## ^ support for self-registration

## v sac modification to standardize test sequence inputs
sub print_client_seqtst_list {
	my ($clid, $tseq, $tdefault, $fh) = @_;
	$fh = (defined($fh) ? $fh : *STDOUT);
	my @recs=();
	my @trecs=();
	my $grepfor;
	my $rec;
	my $id;
	my $desc;
	my $tmd;
	my $maxtm;
	my $seq;
	my $etc;
	my $html;
	my $selected="";

	if ($tseq eq 'cfa') {
		$grepfor="(.*)\&cfa\&(.*)";
	} elsif (($tseq eq 'profb') || ($tseq eq 'profa')) {
		$grepfor="(.*)\&(std|svy|dmg|adp)\&(.*)";
	} elsif ($tseq eq 'srvy') {
		$grepfor="(.*)\&(std|svy|dmg|adp)\&(.*)";
	}

	@recs = &get_data("tests.$clid");
	$rec = shift @recs;
	if ($#recs != -1) {
		@trecs=grep( /$grepfor/, @recs);
		if ($#trecs != -1) {
			@recs=();
			foreach $rec (@trecs) {
				($id,$desc,$tmd,$maxtm,$seq,$etc)=split(/&/, $rec);
				if (($grepfor =~ /$seq/i) && ($id ne $TEST{'id'})) {
					$rec = join('&',$desc,$id);
					push @recs, $rec;
				}
			}
			if ($#recs != -1) {
				@trecs=@recs;
				@recs = sort @trecs;
				@trecs=();
			}
		}
	}
	$seq = ($tseq eq 'cfa') ? 'dscl' : $tseq;
	$html="<select name=\"$seq\">\n";
	foreach $rec (@recs) {
		($desc,$id)=split(/&/, $rec);
		$selected = ($id eq $tdefault) ? " selected" : "";
		$html= join('',$html,"<option value=\"$id\"$selected>$desc\n");
		@flds=();
	}
	if ($tdefault eq '') {
		$html= join('',$html,"<option value=\"\" selected>None\n");
	} else {
		$html= join('',$html,"<option value=\"\">None\n");
	}
	$html= join('',$html,"</select><br>\n");
	return $html;
}
## ^ sac modification to standardize test sequence inputs

sub print_user_language_select {
	my ($clid, $dropdown) = @_;
	@allowed_langs = split(/,/, $SYSTEM{'ALLOWEDLANGS'});
	if ($CLIENT{'cllangflags'} eq "Y" && $dropdown != 1) {
		print "$xlatphrase[541]<BR>\n";
		foreach $lang (@allowed_langs) {
			print "<a href=\"#top\" name=\"$LANGUAGE_ID{$lang}\" onClick=\"return language_select('$lang')\">\n";
			print "<img src=\"$graphroot/$LANGUAGE_FLAG{$lang}\" border=0 Alt=\"$LANGUAGE_ID{$lang}\"></a>\n";
		}
	} else {
		print "&nbsp;$xlatphrase[833]&nbsp;<BR>\n";
		print "<SELECT NAME=\"sellang\" onChange=\"return language_select(this.value)\">\n";
		foreach $lang (@allowed_langs) {
			$selected = ($lang eq $FORM{'lang'}) ? " SELECTED" : "";
			print "	<OPTION VALUE=\"$lang\"$selected>$LANGUAGE_ID{$lang}</OPTION>\n";
		}
		print "</SELECT>\n";
	}
}

sub print_client_forsale_table {
	my ($clid, $order) = @_;
	my $total = 0;
	print "<TABLE BORDER=1>\n";
	print "<TR>\n";
	if ($order == 0) {
		print "\t<TH>Purchase</TH>";
	}
	print "<TH>Item</TH><TH>Price</TH><TH>Duration</TH>\n";
	print "</TR>\n";
	### tstid&tname&description&cost&duration
	@forsale = &get_data("forsale.".$CLIENT{'clid'});
	shift(@forsale);
	my $i=0;
	my $orderlist="";
	foreach $item (@forsale) {
		@details = split('\&', $item);
		if ($order == 1 ) {
			if ($FORM{"checkbox".$i++} eq $details[0]) { 
				$orderlist .= "$details[0]\;";
			} else {
				next; 
				
			}
		}
		print "<TR>\n";
		if ($order == 0) {
			print "\t<TD align=center>\n";
			print "\t\t<input type=checkbox name=checkbox".$i++." value=$details[0]>\n";
			print "\t</TD>\n";
		} else {
			$total += $details[4];
		}
		print "\t<TD>\n";
		print "\t\t<b>$details[2]</b><br>\n";
		print "\t\t$details[3]\n";
		print "\t</TD>\n";
		print "\t<TD align=center>\n";
		print "\t\t".sprintf("&nbsp;\$%0.2f", $details[4])."&nbsp;\n";
		print "\t</TD>\n";
		print "\t<TD align=center>\n";
		if ($details[5] == 365) {
			print "\t\t1 year\n";
		} else {
			print "\t\t$details[5] days\n";
		}
		print "\t</TD>\n";
		print "</TR>\n";
	}
	if ($order == 1) {
		$total = sprintf("%0.2f", $total);
		print "<TR>\n";
		print "\t<TD colspan=3 align=right>\n";
		print "\t\t<b>Total:</b>&nbsp;\n";
		print "\t\t\$$total\n";
		print "\t</TD>\n";
		print "</TR>\n";
		print "</TABLE>\n";
		print "<INPUT TYPE=HIDDEN NAME=\"OrderID\" VALUE=\"\">\n";
                print "<INPUT TYPE=HIDDEN NAME=\"total\" VALUE=\"$total\">\n";
                print "<INPUT TYPE=HIDDEN NAME=\"orderlist\" VALUE=\"$orderlist\">\n";
		$url = "https://".$ENV{'SERVER_NAME'};
		if ($ENV{'SERVER_PORT'} != 443) {
			$url .= ":".$ENV{'SERVER_PORT'};
		}
		$url .= "/cgi-bin/shop.pl";
		print "<INPUT TYPE=HIDDEN NAME=URL VALUE=$url>\n";
	} else {
		print "</TABLE>\n";
	}
}

## v sac relocated and renamed general support functions
# originally named sub get_file_to_html_string{ moved from tstart.pl
sub get_file_html_body {
	my($filename) = @_;
	my $exhline;
	open(AFILE, "<$filename");
	my @exhlines = <AFILE>;
	close AFILE;
	my $instext ='';
	foreach $exhline (@exhlines) {
		$instext = join('',$instext ,$exhline);
	}
	$instext =~ s/(.*)\<body(.*)\>(.*)\<\/body(.*)/$3/ig;
	return $instext;
}
## ^ sac relocated and renamed general support functions

sub make_tree {
	my ($dirtree) = @_;
	my $dirbase=$docroot;
	my $dirbranch = $dirtree;
	my $dirbranch = s/^$docroot//g;
	my @branches=split($pathsep,$dirbranch);
&dbgprint("make_tree:$dirbase:$dirtree:$dirbranch:$#branches\n");
	for $i (0 .. $#branches) {
		$dirbranch=join($pathsep,$dirbase,$branches[$i]);
		if (opendir(TMPDIR,"$dirbranch")) {
			closedir TMPDIR;
		} else {
			mkdir $dirbranch,0666;
&dbgprint("mkdirResult:$dirbranch:$!\n");
		}
		$dirbase=$dirbranch;
	}
}

sub get_last_cnd_action {		#Basically, this just gets the timestamp
					#of the last action a candidate does by 
					#looking at his logfile.
					#Example: &get_last_cnd_action($account_name, $candidate_name);
        my $acct_nombre = $_[0];        #Get client's account name
                                        #into something more permanent

        my $cnd_nombre = $_[1];         #Get the candidate name to check
                                        #last login date.
        my $cnd_logfile = "../secure_html/log/$acct_nombre.$cnd_nombre"; #logfile relative to cgi-bin
        my @fileinfo = stat($cnd_logfile);      #Holds the file info.
        my $file_mtime = $fileinfo[9];         #mtime value of the log file
        return $file_mtime;
}


sub compare_time {              #Compares a logfile's timestamp to time()
                                #Takes values: client ID, file_mtime (returned
                                #from &get_last_cnd_action), and time_delimiter
                                #(Number of days to check against, like 30, 60,
                                #etc). This should be passed in the POST/GET.
                                #   Example: &compare_time(clid, file_mtime,
                                #   time_delimiter);
                                #Returns client_id if it passes, else nothing.
        my $client_id = $_[0];  #get client ID
        my $file_time = $_[1];  #get mtime
        my $time_delimiter = $_[2]; #get delimiter (no. of days)

        $file_time = int(((($file_time/60)/60)/24)); #change it into days
        my $localtime = time;  #First step is to get the current time in days
        $localtime = int(((($localtime/60)/60)/24)); #change it into days

        my $difference = $localtime - $file_time; #find their difference

        #Do the simple checking...
        return $client_id unless ($difference > $time_delimiter);
}

my %get_a_key_data = () ;

sub get_a_key {
  #gets a hash:key value from a file
  #like cnd.clientid or something
  #Example: &get_a_key(filename, cndID, hash_key);
  #takes filename(the file that holds the
  #stuff to parse), cndid (candidate
  #name/id), and hash_key(basically, the
  #field at the top of the file seperated
  #by &). Returns the value of hash_key
  my $match = $_[1];
  my $magic_key = $_[2];
  my $key_file = $_[0] ;
  unless ($get_a_key_data{$key_file}) {
    my @searching = &get_data($key_file);
    my $getlegend  = shift(@searching);
    chomp($getlegend);
    my @labels = split( '&', $getlegend);
    my @fields = ();
    my %megahash =();
    foreach (@searching) {
      chomp $_;
      @fields = split( '&', $_);
      my $hashlength = $#fields;
      my $betty;
      foreach $betty (0..$hashlength) {
        $get_a_key_data{$key_file}->{$fields[0]}->{$labels[$betty]} = $fields[$betty] ;
      }
    }
  }
  return $get_a_key_data{$key_file}->{$match}->{$magic_key} ;
}

sub print_clcnd_input {
	my ($clid, $clcndid, $flag, $print) = @_;
	$cnd = 'cnd'.$clcndid;
	$clcnd = 'clcnd'.$clcndid;
	$clcndvals = 'clcnd'.$clcndid."vals";
	$clcndformat = 'clcnd'.$clcndid."format";
	if ($flag eq "f") { 
		$flag = " onChange='set_change_flag()'";
	} else {
		$flag = "";
	}
	$output = "<TR>\n";
	if ($CLIENT{$clcndvals} ne "") {

		my @vals = split(/\,/, $CLIENT{$clcndvals});
		if ($CLIENT{$clcndformat} eq "radio") {
			### Print radio buttons based on clcnd values
        		$output .= "\t<TD COLSPAN=2 ALIGN=\"left\" VALIGN=\"middle\" NOWRAP>\n";
                	$output .= "\t\t<FONT SIZE=2>\n";
                	$output .= "\t\t\t$CLIENT{$clcnd}\n";
                	$output .= "\t\t</FONT>\n";
        		$output .= "\t</TD>\n";
			$output .= "</TR>\n";
			$output .= "<TR>\n";
        		$output .= "\t<TD ALIGN=\"right\" VALIGN=\"middle\" NOWRAP>\n";
			$output .= "\t\t&nbsp;\n";
        		$output .= "\t</TD>\n";
        		$output .= "\t<TD ALIGN=\"left\" VALIGN=\"middle\" NOWRAP>\n";
                	$output .= "\t\t<FONT SIZE=2>\n";
			foreach $val (@vals) {
				if ($val eq $CANDIDATE{$cnd}) {
					$output .= "\t\t\t<INPUT TYPE=\"RADIO\" NAME=\"$cnd\" VALUE=\"$val\" CHECKED$flag> $val<BR>\n";
				} else {
					$output .= "\t\t\t<INPUT TYPE=\"RADIO\" NAME=\"$cnd\" VALUE=\"$val\"$flag> $val<BR>\n";
				}
			}
                	$output .= "\t\t</FONT>\n";
        		$output .= "\t</TD>\n";
		} else {
			### Print select box based on clcnd values
        		$output .= "\t<TD ALIGN=\"right\" VALIGN=\"middle\" NOWRAP>\n";
                	$output .= "\t\t<FONT SIZE=2>\n";
                	$output .= "\t\t\t$CLIENT{$clcnd}&nbsp;\n";
                	$output .= "\t\t</FONT>\n";
        		$output .= "\t</TD>\n";
        		$output .= "\t<TD ALIGN=\"left\" VALIGN=\"middle\" NOWRAP>\n";
                	$output .= "\t\t<FONT SIZE=2>\n";
			unshift(@vals, "");
			$output .= "\t\t\t<SELECT NAME=\"$cnd\"$flag>\n";
			foreach $val (@vals) {
				if ($val eq $CANDIDATE{$cnd}) {
					$output .= "\t\t\t\t<OPTION value=\"$val\" SELECTED>$val</OPTION>\n";
				} else {
					$output .= "\t\t\t\t<OPTION value=\"$val\">$val</OPTION>\n";
				}
			}
			$output .= "\t\t\t</SELECT>\n";
                	$output .= "\t\t</FONT>\n";
        		$output .= "\t</TD>\n";
		}
	} else {
		### Print regular input box 
		$output .= "\t<TD ALIGN=\"right\" VALIGN=\"middle\" NOWRAP>\n";
		$output .= "\t\t<FONT SIZE=2>\n";
		$output .= "\t\t\t$CLIENT{$clcnd}&nbsp;\n";
		$output .= "\t\t</FONT>\n";
		$output .= "\t</TD>\n";
		$output .= "\t<TD ALIGN=\"left\" VALIGN=\"middle\" NOWRAP>\n";
		$output .= "\t\t<FONT SIZE=2>\n";
		$output .= "<INPUT TYPE=TEXT NAME=\"$cnd\" SIZE=30 MAXLENGTH=30 VALUE=\"$CANDIDATE{$cnd}\"$flag>\n";
		$output .= "\t\t</FONT>\n";
		$output .= "\t</TD>\n";
	}
	$output .= "</TR>\n";
	if ($print) {
		print $output;
	} else {
		return $output;
	}
}


sub makecndhash {		#makes an md5hash out of some info. Takes 2 
				#arguments, each part of the source to generate 				#the hash. Returns the hash value.

				#Example: &makecndhash('paul', '67847');
	use Digest::MD5;

	my $length = 16;
	my $tempstring = 'j0Hx4b2uXx8';

	my $data = "$_[0]:$tempstring:$_[1]";
	my $ctx = Digest::MD5->new;
	$ctx->add($data);
	my $digest = $ctx->hexdigest;
	my $fragment = substr $digest, 0, $length;
	$fragment =~ s/..../$&-/g;
	$fragment =~ s/-$//g;
	return $fragment;
}

sub popEmlAcl {
	my $clid = $_[0];
	my $tempstring;
	my @searching = get_data("$clid.emlacl");
	foreach (@searching) {
		chomp($_);
		$tempstring .= $_ . "," unless /^(#|\n|\s|$)/;#gets out comments and blank lines
	}
	$tempstring =~ s/\,$//g;
	my @returnarray = split(/\,/, $tempstring);

	return @returnarray;
}

sub pushEmlAcl {
	my $clid = $_[0];
	my $recstr = $_[1];
	my $tempstring;
	my @searching = get_data("$clid.emlacl");
	foreach (@searching) {	#First we keep comments 
		chomp($_);
		if (/^(#|$)/) {
			$tempstring .= "$_,";
		}
	}
	$tempstring .= $recstr;
	my @pusharray = split(/\,/, $tempstring);

	$trash = join( $pathsep, $dataroot, "$clid.emlacl");
	open( EMLACLFILE, ">$trash" ) or die "$trash not found! $!";

	foreach (@pusharray) {
		print EMLACLFILE "$_\n";
	}
	close EMLACLFILE;
}

sub get_data_hash {
# Read a data file, and return a hash of the file.
# Parameters are the file name, and a flag for using a lock file.
# Return an unnamed hash of hashes.
# The keys of the first hash are the ids.
# The values of the first hash is a hash with one line's data.
#    This next hash has the field ids for keys.
	my ($file, $lock) = @_;
	my @data_lines = get_data($file, $lock) ;
	my $bFirst = 1 ;
	my %DATA = () ;
	my %FIELDS = () ;
	my %ROWS = () ;
  foreach $datadef (@data_lines) {
    chop ($datadef);
    if ($bFirst eq 1) {
			# First line only.
      @flds = split(/&/, $datadef);
			# Validate field ids, no duplicates.
			foreach $fld (@flds) {
				if ($FIELDS{$fld}) {
					warn "Duplicate field id, $fld, in file $file ." ;
				} else {
					$FIELDS{$fld} = 1 ;
				}
			}
      $bFirst = 0;
    } else {
			# Second and later lines.
      my ($id) = split(/&/, $datadef);
			if ($ROWS{$id}) {
   			warn "Duplicate row id value $id, in file $file ." ;
			} else {
				$ROWS{$id} = 1 ;
			}
			# warn "ID $id DATALINE $datadef X\n" ;
      @rowdata = split(/&/, $datadef);
			if ($#rowdata > $#flds) {
				warn "More data fields than field ids, in file $file ." ;
			}
      $counter = 0;
      foreach $fld (@flds) {
				$DATA{$id}->{$fld} = $rowdata[$counter] ;
				$counter ++ ;
      }
		} # End of if $bFirst.
	} # foreach
	return \%DATA ;
}

# end with True because this is a require file
1