survey-manager/survey-nginx/cgi-bin/smilib.pl

#!/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 ;
my $HBI_Debug_smilib_template_file = 0 ;
my $Debug_HBI_PreSelect_Test = 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));
    my $HBI_Debug_Form = 1 ;

    # parse request parameters into variables
    $query = new CGI;
    %FORM = $query->Vars;
    if ($HBI_Debug_Form) {
	my $key ;
	warn "Dump FORM " ;
	foreach $key (sort keys %FORM) {
	    warn "Key ${key} Val $FORM{${key}} X\n" ;
	}
	warn "End Dump FORM " ;
    }

    #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 an un-needed loop. HBI 
	    for (keys %CANDIDATE) {
		my $Opt_Pre_Select = "" ;
		$srch1 = "<%=CANDIDATE.authtestsoptions%>";
		if ($xltline =~ m/$srch1/ ) {
		    if ($CANDIDATE{'inproglist'} eq '') {
			@authtests = split(/\;/, $CANDIDATE{'authlist'});
			warn "Test ID " . __LINE__ . " testid $FORM{'testid'} tstid $FORM{'tstid'}.\n" if ($Debug_HBI_PreSelect_Test) ;
			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";
				warn "Test ID " . __LINE__ . " testid $FORM{'testid'} tstid $FORM{'tstid'} TEST $TEST{'id'}.\n" if ($Debug_HBI_PreSelect_Test) ;
				$repl .= "<OPTION value=\"$TEST{'pwdtag'}$TEST{'popuptag'}$TEST{'id'}\">$TEST{'desc'}\n";
			    }
			}
			#return "";
			$xltline =~ s/$srch1/$repl/eg;
		    } else {
			@authtests = split(/\;/, $CANDIDATE{'inproglist'});
			warn "Test ID " . __LINE__ . " testid $FORM{'testid'} tstid $FORM{'tstid'}.\n" if ($Debug_HBI_PreSelect_Test) ;
			my $repl = "";
			foreach $authtest (@authtests) {
			    &get_test_profile($SESSION{'clid'}, $authtest);
			    #print "<OPTION value=\"$TEST{'pwdtag'}$TEST{'id'}\">$TEST{'desc'}\n";
			    warn "Test ID " . __LINE__ . " testid $FORM{'testid'} tstid $FORM{'tstid'} TEST $TEST{'id'}.\n" if ($Debug_HBI_PreSelect_Test) ;
			    $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);
			}
		    }
		    warn "Test ID " . __LINE__ . " testid $FORM{'testid'} tstid $FORM{'tstid'} repl ${repl}.\n" if ($Debug_HBI_PreSelect_Test) ;
		    $xltline =~ s/$srch1/$repl/eg;
		}
		$srch1 = "<%=CANDIDATE.oldtestsoptions%>";
		if ($xltline =~ m/$srch1/ ) {
		    @authtests = split(/\;/, $CANDIDATE{'completedlist'});
		    my $repl = "";
		    warn "Test ID " . __LINE__ . " testid $FORM{'testid'} tstid $FORM{'tstid'}.\n" if ($Debug_HBI_PreSelect_Test) ;
		    foreach $authtest (@authtests) {
			&get_test_profile($SESSION{'clid'}, $authtest);
			warn "Test ID " . __LINE__ . " testid $FORM{'testid'} tstid $FORM{'tstid'} TEST $TEST{'id'}.\n" if ($Debug_HBI_PreSelect_Test) ;
			$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'};
		    warn "Test ID " . __LINE__ . " testid $FORM{'testid'} tstid $FORM{'tstid'} repl ${repl}.\n" if ($Debug_HBI_PreSelect_Test) ;
		    $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'});
			warn "Test ID " . __LINE__ . " testid $FORM{'testid'} tstid $FORM{'tstid'}.\n" if ($Debug_HBI_PreSelect_Test) ;
			foreach $authtest (@authtests) {
			    &get_test_profile($SESSION{'clid'}, $authtest);
			    warn "Test ID " . __LINE__ . " testid $FORM{'testid'} tstid $FORM{'tstid'} TEST $TEST{'id'}.\n" if ($Debug_HBI_PreSelect_Test) ;
			    print "<OPTION value=\"$TEST{'pwdtag'}$TEST{'popuptag'}$TEST{'id'}\">$TEST{'desc'}";
			}
			return "";
		    } else {
			$repl=&get_selfreg_test_list($SESSION{'clid'}, $CANDIDATE{'completedlist'});
			warn "Test ID " . __LINE__ . " testid $FORM{'testid'} tstid $FORM{'tstid'} repl ${repl}.\n" if ($Debug_HBI_PreSelect_Test) ;
			$xltline =~ s/$srch1/$repl/g;
			$xltline =~ s/\n/<\/option>\n/g;
			$xltline =~ s/\n<\/option>\n/\n/g;
		    }
		}
		# Was end curly brace for loop on keys of %CANDIDATE
	    }
	    # ^ 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;
    if ($HBI_Debug_smilib_template_file) {
	warn "Reading Template file $tmpfile \n";
    }
    # 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
<OPTION VALUE=\"2026\">2026
<OPTION VALUE=\"2027\">2027
<OPTION VALUE=\"2028\">2028
<OPTION VALUE=\"2029\">2029
<OPTION VALUE=\"2030\">2030
";

$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