Cleanup

.gitignore

@@ -1,2 +1,2 @@
 *~
-*/log
+sess.*

survey-nginx/cgi-bin/InMem.pm.bu20110318

@@ -1,287 +0,0 @@
-#!/usr/bin/perl
-
-# Copyright 2011 Hank Ivy
-
-# Package to load data into memory for multiple usage.
-# use strict ;
-# use warnings ;
-# require 'sitecfg.pl' ;
-
-package InMem ;
-use Exporter () ;
-@ISA = qw(Exporter) ;
-@EXPORT = qw(InsertQuesResp InsertQuesComment $GlobalData) ;
-@EXPORT_OK = qw( ) ;
-
-local $GlobalData = {} ;
-my $ValidClientChar = "0\-9a\-zA\-Z\_\-" ;
-my $ValidCandidateChar = "0\-9a\-zA\-Z\\_\\- " ;
-my $ValidTestIDChar = "0\-9a\-zA\-Z\_\-" ;
-my %ValidTestTypes = (complete => 1, pending => 1, inprog => 1 ) ;
-my $InMem_Debug = 0 ;
-
-unless ($GlobalData) {
-	$GlobalData = {'CLIENTS' => {}} ;
-	warn "Init. GlobalData" if ($InMem_Debug) ;
-}
-
-sub ValidateClientStr {
-	# Validate just the characters in the str.
-	# A positive result does not mean the Client exists.
-	# Parameters
-	# $ClientID - Character String.
-	# Returns 1 for a valid string, 0 for invalid.
-	my ($ClientID ) = @_ ;
-	if ((length $ClientID) == 0) {
-		return 0 ;
-	}
-	if ($ClientID =~ m/^[${ValidClientChar}]+$/o ) {
-		return 1 ;
-	} else {
-		return 0 ;
-	}
-}
-
-sub ValidateTestIDStr {
-	# Validate just the characters in the str.
-	# A positive result does not mean the TestID exists.
-	# Parameters
-	# $TestID - Character String.
-	# Returns 1 for a valid string, 0 for invalid.
-	my ($TestID ) = @_ ;
-	if ((length $TestID) == 0) {
-		return 0 ;
-	}
-	if ($TestID =~ m/^[${ValidTestIDChar}]+$/o ) {
-		return 1 ;
-	} else {
-		return 0 ;
-	}
-}
-
-sub ValidateCandidateStr {
-	# Validate just the characters in the str.
-	# A positive result does not mean the Candidate exists.
-	# Parameters
-	# $CandidateID - Character String.
-	# Returns 1 for a valid string, 0 for invalid.
-	my ($CandidateID ) = @_ ;
-	if ((length $CandidateID) == 0) {
-		return 0 ;
-	}
-	if ($CandidateID =~ m/^[${ValidCandidateChar}]+$/o ) {
-		return 1 ;
-	} else {
-		return 0 ;
-	}
-}
-
-sub ValidQId {
-	# Validate the scalar as a numeric greater than 0.
-	# A positive result does not mean the Question ID exists.
-	# Parameters
-	# $QuesId - Character String.
-	# Returns 1 for a valid string, 0 for invalid.
-	my ($QuesId ) = @_ ;
-	unless ($QuesId) {
-		return 0 ;
-	}
-	unless ($QuesId =~ m/^\d+$/ ) {
-		warn "Bad $QuesId QuesId" if ($InMem_Debug) ;
-		return 0 ;
-	}
-	unless ($QuesId > 0) {
-		warn "Bad $QuesId QuesId" if ($InMem_Debug) ;
-		return 0 ;
-	}
-	return 1 ;
-}
-
-sub CreateClientSkeleton {
-	# Create a very minimal data structure for a client.
-	# Parameters
-	# $ClientID - Character String.
-	my ($ClientID ) = @_ ;
-	unless ($ClientID) {
-		die "Error: CreateClientSkeleton called with an empty ClientID" ;
-	}
-	unless (&ValidateClientStr($ClientID)) {
-		die "Error: CreateClientSkeleton called with an invalid ClientID character."
-	}
-	unless($GlobalData) {
-		$GlobalData = {'CLIENTS' => {}} ;
-	}
-	unless($GlobalData -> {'CLIENTS'} -> {$ClientID}) {
-		warn "Initialize $ClientID Client" if ($InMem_Debug) ;
-		$GlobalData -> {'CLIENTS'} -> {$ClientID} = {} ;
-	}
-	return 1 ;
-}
-
-sub CreateCandidateSkeleton {
-	# Create a very minimal data structure for a candidate associated with a client.
-	# Parameters
-	# $ClientID - Character String.
-	# $CandidateID - Character String.
-	my ($ClientID, $CandidateID ) = @_ ;
-	unless ( &CreateClientSkeleton($ClientID) ) {
-		warn "Fail $ClientID, $CandidateID CreateCandidateSkeleton" if ($InMem_Debug) ;
-		return 0 ;
-	}
-	unless ($CandidateID) {
-		die "Error: CreateCandidateSkeleton called with an empty CandidateID" ;
-	}
-	unless ($CandidateID =~ m/^[${ValidCandidateChar}]+$/o ) {
-		die "Error: CreateCandidateSkeleton called with an invalid CandidateID character."
-	}
-	unless ($GlobalData -> {'CLIENTS'} -> {$ClientID} -> {'CANDIDATES'} ) {
-		$GlobalData -> {'CLIENTS'} -> {$ClientID} -> {'CANDIDATES'} = {} ;
-		warn "Initialize $CandidateID CandidateID" if ($InMem_Debug) ;
-	}
-	unless ($GlobalData -> {'CLIENTS'} -> {$ClientID} -> {'CANDIDATES'} -> {$CandidateID}) {
-		$GlobalData -> {'CLIENTS'} -> {$ClientID} -> {'CANDIDATES'} -> {$CandidateID} = {} ;
-		warn "Initialize $CandidateID CandidateID" if ($InMem_Debug) ;
-	}
-	return 1 ;
-}
-
-sub GetClientsInMem {
-	# Return an array of the Client Names in Memory.
-	my @Clients ;
-	if ($GlobalData and $GlobalData -> {'CLIENTS'}) {
-		@Clients = keys %{$GlobalData -> {'CLIENTS'}} ;
-	}
-	return @Clients ;
-}
-
-sub ImportAllClientIDs {
-	# Populate the data structure for all clients.
-	# Parameters - No input parms.
-	# Return 0 if there is a problem, 1 if all is OK.
-	my $ClientFile = $main::PATHS{'dataroot'} . $main::pathsep . "clients.dat" ;
-	my $line_cnt = 0 ;
-	my @field_ids = () ;
-}
-
-sub CreateCanTestSkel {
-	# Create a very minimal data structure for a test taken by a candidate.
-	# Parameters
-	# $ClientID - Character String.
-	# $CandidateID - Character String.
-	# $TestID - Character String.
-	# Return 1 for success, 0 for failure.
-	my ($ClientID, $CandidateID, $TestID) = @_ ;
-	unless ( &CreateCandidateSkeleton($ClientID, $CandidateID)) {
-		return 0 ;
-	}
-	unless (&ValidateTestIDStr ($TestID)) {
-		return 0 ;
-	}
-	unless ($GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'} ) {
-		warn "Initialize $ClientID, $CandidateID CandidateID Tests" if ($InMem_Debug) ;
-		$GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'} = {} ;
-	}
-	unless ($GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID} ) {
-		warn "Initialize $ClientID, $CandidateID CandidateID Tests" if ($InMem_Debug) ;
-		$GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID} = {} ;
-	}
-	return 1 ;
-}
-
-sub CreateCanTestTypeSkel {
-	# Create a very minimal data structure for a test type taken by a candidate.
-	# Parameters
-	# $ClientID - Character String.
-	# $CandidateID - Character String.
-	# $TestID - Character String.
-	# $TestType - Character String, limited values.
-	# Return 1 for success, 0 for failure.
-	my ($ClientID, $CandidateID, $TestID, $TestType) = @_ ;
-	unless (&CreateCanTestSkel($ClientID, $CandidateID, $TestID)) {
-		return 0 ;
-	}
-	unless ($ValidTestTypes{$TestType}) {
-		return 0 ;
-	}
-	unless ($GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID} ) {
-		warn "Initialize $ClientID, $CandidateID, $TestType TestType" if ($InMem_Debug) ;
-		$GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID} = {} ;
-	}
-	unless ($GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID}->{$TestType} ) {
-		warn "Initialize $ClientID, $CandidateID, $TestType TestType" if ($InMem_Debug) ;
-		$GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID}->{$TestType} = {} ;
-	}
-	return 1 ;
-}
-
-sub CreateCanTestTypeQIdSkel {
-	# Create a very minimal data structure for a Question in a test taken.
-	# Parameters
-	# $ClientID - Character String.
-	# $CandidateID - Character String.
-	# $TestID - Character String.
-	# $TestType - Character String, limited values.
-	# $QuesID - a one based integer.
-	# Return 1 for success, 0 for failure.
-	my ($ClientID, $CandidateID, $TestID, $TestType, $QuesID) = @_ ;
-	unless (&CreateCanTestTypeSkel($ClientID, $CandidateID, $TestID, $TestType)) {
-		return 0 ;
-	}
-	unless (&ValidQId($QuesID)) {
-		return 0 ;
-	}
-	unless ($GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID}->{$TestType}->{$QuesID} ) {
-		warn "Initialize $ClientID, $CandidateID, $TestType, $QuesID QuesID" if ($InMem_Debug) ;
-		$GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID}->{$TestType}->{$QuesID} = {} ;
-	}
-	return 1 ;
-}
-
-sub InsertQuesComment {
-	# Place a Comment in a data structure for a Question in a test taken.
-	# Parameters
-	# $ClientID - Character String.
-	# $CandidateID - Character String.
-	# $TestID - Character String.
-	# $TestType - Character String, limited values.
-	# $QuesID - a one based integer.
-	# $Comment -  A string.
-	# Return 1 for success, 0 for failure.
-	my ($ClientID, $CandidateID, $TestID, $TestType, $QuesID, $Comment) = @_ ;
-	unless (&CreateCanTestTypeQIdSkel($ClientID, $CandidateID, $TestID, $TestType, $QuesID)) {
-		return 0 ;
-	}
-	# Any Character string, even an empty string is valid.
-	unless ($Comment) {
-		$Comment = "" ;
-	}
-	$GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID}->{$TestType}->{$QuesID}->{'Comment'} = $Comment ;
-	warn "Add Comment CLI $ClientID User $CandidateID Tst $TestID Type $TestType QID $QuesID Text $Comment X" ;
-	return 1 ;
-}
-
-sub InsertQuesResp {
-	# Place a Text Response answer for a Question in a test taken in a data structure.
-	# Parameters
-	# $ClientID - Character String.
-	# $CandidateID - Character String.
-	# $TestID - Character String.
-	# $TestType - Character String, limited values.
-	# $QuesID - a one based integer.
-	# $Resp -  A string.
-	# Return 1 for success, 0 for failure.
-	my ($ClientID, $CandidateID, $TestID, $TestType, $QuesID, $Resp) = @_ ;
-	unless (&CreateCanTestTypeQIdSkel($ClientID, $CandidateID, $TestID, $TestType, $QuesID)) {
-		return 0 ;
-	}
-	# Any Character string, even an empty string is valid.
-	unless ($Resp) {
-		$Resp = "" ;
-	}
-	$GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID}->{$TestType}->{$QuesID}->{'Resp'} = $Resp ;
-	warn "Add Response CLI $ClientID User $CandidateID Tst $TestID Type $TestType QID $QuesID Text $resp X" ;
-	return 1 ;
-}
-
-1 ; # End of a library perl file.
-

survey-nginx/cgi-bin/InMem.pm.bu20110404

@@ -1,287 +0,0 @@
-#!/usr/bin/perl
-
-# Copyright 2011 Hank Ivy
-
-# Package to load data into memory for multiple usage.
-# use strict ;
-# use warnings ;
-# require 'sitecfg.pl' ;
-
-package InMem ;
-use Exporter () ;
-@ISA = qw(Exporter) ;
-@EXPORT = qw(InsertQuesResp InsertQuesComment $GlobalData) ;
-@EXPORT_OK = qw( ) ;
-
-local $GlobalData = {} ;
-my $ValidClientChar = "0\-9a\-zA\-Z\_\-" ;
-my $ValidCandidateChar = "0\-9a\-zA\-Z\\_\\-\@\. " ;
-my $ValidTestIDChar = "0\-9a\-zA\-Z\_\-" ;
-my %ValidTestTypes = (complete => 1, pending => 1, inprog => 1 ) ;
-my $InMem_Debug = 0 ;
-
-unless ($GlobalData) {
-	$GlobalData = {'CLIENTS' => {}} ;
-	warn "Init. GlobalData" if ($InMem_Debug) ;
-}
-
-sub ValidateClientStr {
-	# Validate just the characters in the str.
-	# A positive result does not mean the Client exists.
-	# Parameters
-	# $ClientID - Character String.
-	# Returns 1 for a valid string, 0 for invalid.
-	my ($ClientID ) = @_ ;
-	if ((length $ClientID) == 0) {
-		return 0 ;
-	}
-	if ($ClientID =~ m/^[${ValidClientChar}]+$/o ) {
-		return 1 ;
-	} else {
-		return 0 ;
-	}
-}
-
-sub ValidateTestIDStr {
-	# Validate just the characters in the str.
-	# A positive result does not mean the TestID exists.
-	# Parameters
-	# $TestID - Character String.
-	# Returns 1 for a valid string, 0 for invalid.
-	my ($TestID ) = @_ ;
-	if ((length $TestID) == 0) {
-		return 0 ;
-	}
-	if ($TestID =~ m/^[${ValidTestIDChar}]+$/o ) {
-		return 1 ;
-	} else {
-		return 0 ;
-	}
-}
-
-sub ValidateCandidateStr {
-	# Validate just the characters in the str.
-	# A positive result does not mean the Candidate exists.
-	# Parameters
-	# $CandidateID - Character String.
-	# Returns 1 for a valid string, 0 for invalid.
-	my ($CandidateID ) = @_ ;
-	if ((length $CandidateID) == 0) {
-		return 0 ;
-	}
-	if ($CandidateID =~ m/^[${ValidCandidateChar}]+$/o ) {
-		return 1 ;
-	} else {
-		return 0 ;
-	}
-}
-
-sub ValidQId {
-	# Validate the scalar as a numeric greater than 0.
-	# A positive result does not mean the Question ID exists.
-	# Parameters
-	# $QuesId - Character String.
-	# Returns 1 for a valid string, 0 for invalid.
-	my ($QuesId ) = @_ ;
-	unless ($QuesId) {
-		return 0 ;
-	}
-	unless ($QuesId =~ m/^\d+$/ ) {
-		warn "Bad $QuesId QuesId" if ($InMem_Debug) ;
-		return 0 ;
-	}
-	unless ($QuesId > 0) {
-		warn "Bad $QuesId QuesId" if ($InMem_Debug) ;
-		return 0 ;
-	}
-	return 1 ;
-}
-
-sub CreateClientSkeleton {
-	# Create a very minimal data structure for a client.
-	# Parameters
-	# $ClientID - Character String.
-	my ($ClientID ) = @_ ;
-	unless ($ClientID) {
-		die "Error: CreateClientSkeleton called with an empty ClientID" ;
-	}
-	unless (&ValidateClientStr($ClientID)) {
-		die "Error: CreateClientSkeleton called with an invalid ClientID character."
-	}
-	unless($GlobalData) {
-		$GlobalData = {'CLIENTS' => {}} ;
-	}
-	unless($GlobalData -> {'CLIENTS'} -> {$ClientID}) {
-		warn "Initialize $ClientID Client" if ($InMem_Debug) ;
-		$GlobalData -> {'CLIENTS'} -> {$ClientID} = {} ;
-	}
-	return 1 ;
-}
-
-sub CreateCandidateSkeleton {
-	# Create a very minimal data structure for a candidate associated with a client.
-	# Parameters
-	# $ClientID - Character String.
-	# $CandidateID - Character String.
-	my ($ClientID, $CandidateID ) = @_ ;
-	unless ( &CreateClientSkeleton($ClientID) ) {
-		warn "Fail $ClientID, $CandidateID CreateCandidateSkeleton" if ($InMem_Debug) ;
-		return 0 ;
-	}
-	unless ($CandidateID) {
-		die "Error: CreateCandidateSkeleton called with an empty CandidateID" ;
-	}
-	unless ($CandidateID =~ m/^[${ValidCandidateChar}]+$/o ) {
-		die "Error: CreateCandidateSkeleton called with an invalid CandidateID character" . $CandidateID . "." ;
-	}
-	unless ($GlobalData -> {'CLIENTS'} -> {$ClientID} -> {'CANDIDATES'} ) {
-		$GlobalData -> {'CLIENTS'} -> {$ClientID} -> {'CANDIDATES'} = {} ;
-		warn "Initialize $CandidateID CandidateID" if ($InMem_Debug) ;
-	}
-	unless ($GlobalData -> {'CLIENTS'} -> {$ClientID} -> {'CANDIDATES'} -> {$CandidateID}) {
-		$GlobalData -> {'CLIENTS'} -> {$ClientID} -> {'CANDIDATES'} -> {$CandidateID} = {} ;
-		warn "Initialize $CandidateID CandidateID" if ($InMem_Debug) ;
-	}
-	return 1 ;
-}
-
-sub GetClientsInMem {
-	# Return an array of the Client Names in Memory.
-	my @Clients ;
-	if ($GlobalData and $GlobalData -> {'CLIENTS'}) {
-		@Clients = keys %{$GlobalData -> {'CLIENTS'}} ;
-	}
-	return @Clients ;
-}
-
-sub ImportAllClientIDs {
-	# Populate the data structure for all clients.
-	# Parameters - No input parms.
-	# Return 0 if there is a problem, 1 if all is OK.
-	my $ClientFile = $main::PATHS{'dataroot'} . $main::pathsep . "clients.dat" ;
-	my $line_cnt = 0 ;
-	my @field_ids = () ;
-}
-
-sub CreateCanTestSkel {
-	# Create a very minimal data structure for a test taken by a candidate.
-	# Parameters
-	# $ClientID - Character String.
-	# $CandidateID - Character String.
-	# $TestID - Character String.
-	# Return 1 for success, 0 for failure.
-	my ($ClientID, $CandidateID, $TestID) = @_ ;
-	unless ( &CreateCandidateSkeleton($ClientID, $CandidateID)) {
-		return 0 ;
-	}
-	unless (&ValidateTestIDStr ($TestID)) {
-		return 0 ;
-	}
-	unless ($GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'} ) {
-		warn "Initialize $ClientID, $CandidateID CandidateID Tests" if ($InMem_Debug) ;
-		$GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'} = {} ;
-	}
-	unless ($GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID} ) {
-		warn "Initialize $ClientID, $CandidateID CandidateID Tests" if ($InMem_Debug) ;
-		$GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID} = {} ;
-	}
-	return 1 ;
-}
-
-sub CreateCanTestTypeSkel {
-	# Create a very minimal data structure for a test type taken by a candidate.
-	# Parameters
-	# $ClientID - Character String.
-	# $CandidateID - Character String.
-	# $TestID - Character String.
-	# $TestType - Character String, limited values.
-	# Return 1 for success, 0 for failure.
-	my ($ClientID, $CandidateID, $TestID, $TestType) = @_ ;
-	unless (&CreateCanTestSkel($ClientID, $CandidateID, $TestID)) {
-		return 0 ;
-	}
-	unless ($ValidTestTypes{$TestType}) {
-		return 0 ;
-	}
-	unless ($GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID} ) {
-		warn "Initialize $ClientID, $CandidateID, $TestType TestType" if ($InMem_Debug) ;
-		$GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID} = {} ;
-	}
-	unless ($GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID}->{$TestType} ) {
-		warn "Initialize $ClientID, $CandidateID, $TestType TestType" if ($InMem_Debug) ;
-		$GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID}->{$TestType} = {} ;
-	}
-	return 1 ;
-}
-
-sub CreateCanTestTypeQIdSkel {
-	# Create a very minimal data structure for a Question in a test taken.
-	# Parameters
-	# $ClientID - Character String.
-	# $CandidateID - Character String.
-	# $TestID - Character String.
-	# $TestType - Character String, limited values.
-	# $QuesID - a one based integer.
-	# Return 1 for success, 0 for failure.
-	my ($ClientID, $CandidateID, $TestID, $TestType, $QuesID) = @_ ;
-	unless (&CreateCanTestTypeSkel($ClientID, $CandidateID, $TestID, $TestType)) {
-		return 0 ;
-	}
-	unless (&ValidQId($QuesID)) {
-		return 0 ;
-	}
-	unless ($GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID}->{$TestType}->{$QuesID} ) {
-		warn "Initialize $ClientID, $CandidateID, $TestType, $QuesID QuesID" if ($InMem_Debug) ;
-		$GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID}->{$TestType}->{$QuesID} = {} ;
-	}
-	return 1 ;
-}
-
-sub InsertQuesComment {
-	# Place a Comment in a data structure for a Question in a test taken.
-	# Parameters
-	# $ClientID - Character String.
-	# $CandidateID - Character String.
-	# $TestID - Character String.
-	# $TestType - Character String, limited values.
-	# $QuesID - a one based integer.
-	# $Comment -  A string.
-	# Return 1 for success, 0 for failure.
-	my ($ClientID, $CandidateID, $TestID, $TestType, $QuesID, $Comment) = @_ ;
-	unless (&CreateCanTestTypeQIdSkel($ClientID, $CandidateID, $TestID, $TestType, $QuesID)) {
-		return 0 ;
-	}
-	# Any Character string, even an empty string is valid.
-	unless ($Comment) {
-		$Comment = "" ;
-	}
-	$GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID}->{$TestType}->{$QuesID}->{'Comment'} = $Comment ;
-	warn "Add Comment CLI $ClientID User $CandidateID Tst $TestID Type $TestType QID $QuesID Text $Comment X" ;
-	return 1 ;
-}
-
-sub InsertQuesResp {
-	# Place a Text Response answer for a Question in a test taken in a data structure.
-	# Parameters
-	# $ClientID - Character String.
-	# $CandidateID - Character String.
-	# $TestID - Character String.
-	# $TestType - Character String, limited values.
-	# $QuesID - a one based integer.
-	# $Resp -  A string.
-	# Return 1 for success, 0 for failure.
-	my ($ClientID, $CandidateID, $TestID, $TestType, $QuesID, $Resp) = @_ ;
-	unless (&CreateCanTestTypeQIdSkel($ClientID, $CandidateID, $TestID, $TestType, $QuesID)) {
-		return 0 ;
-	}
-	# Any Character string, even an empty string is valid.
-	unless ($Resp) {
-		$Resp = "" ;
-	}
-	$GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID}->{$TestType}->{$QuesID}->{'Resp'} = $Resp ;
-	# warn "Add Response CLI $ClientID User $CandidateID Tst $TestID Type $TestType QID $QuesID Text $resp X" ;
-	return 1 ;
-}
-
-1 ; # End of a library perl file.
-

survey-nginx/cgi-bin/InMem.pm.bu20131217

@@ -1,287 +0,0 @@
-#!/usr/bin/perl
-
-# Copyright 2011 Hank Ivy
-
-# Package to load data into memory for multiple usage.
-# use strict ;
-# use warnings ;
-# require 'sitecfg.pl' ;
-
-package InMem ;
-use Exporter () ;
-@ISA = qw(Exporter) ;
-@EXPORT = qw(InsertQuesResp InsertQuesComment $GlobalData) ;
-@EXPORT_OK = qw( ) ;
-
-local $GlobalData = {} ;
-my $ValidClientChar = "0\-9a\-zA\-Z\_\-" ;
-my $ValidCandidateChar = "0\-9a\-zA\-Z\\_\\-\@\., " ;
-my $ValidTestIDChar = "0\-9a\-zA\-Z\_\-" ;
-my %ValidTestTypes = (complete => 1, pending => 1, inprog => 1 ) ;
-my $InMem_Debug = 0 ;
-
-unless ($GlobalData) {
-	$GlobalData = {'CLIENTS' => {}} ;
-	warn "Init. GlobalData" if ($InMem_Debug) ;
-}
-
-sub ValidateClientStr {
-	# Validate just the characters in the str.
-	# A positive result does not mean the Client exists.
-	# Parameters
-	# $ClientID - Character String.
-	# Returns 1 for a valid string, 0 for invalid.
-	my ($ClientID ) = @_ ;
-	if ((length $ClientID) == 0) {
-		return 0 ;
-	}
-	if ($ClientID =~ m/^[${ValidClientChar}]+$/o ) {
-		return 1 ;
-	} else {
-		return 0 ;
-	}
-}
-
-sub ValidateTestIDStr {
-	# Validate just the characters in the str.
-	# A positive result does not mean the TestID exists.
-	# Parameters
-	# $TestID - Character String.
-	# Returns 1 for a valid string, 0 for invalid.
-	my ($TestID ) = @_ ;
-	if ((length $TestID) == 0) {
-		return 0 ;
-	}
-	if ($TestID =~ m/^[${ValidTestIDChar}]+$/o ) {
-		return 1 ;
-	} else {
-		return 0 ;
-	}
-}
-
-sub ValidateCandidateStr {
-	# Validate just the characters in the str.
-	# A positive result does not mean the Candidate exists.
-	# Parameters
-	# $CandidateID - Character String.
-	# Returns 1 for a valid string, 0 for invalid.
-	my ($CandidateID ) = @_ ;
-	if ((length $CandidateID) == 0) {
-		return 0 ;
-	}
-	if ($CandidateID =~ m/^[${ValidCandidateChar}]+$/o ) {
-		return 1 ;
-	} else {
-		return 0 ;
-	}
-}
-
-sub ValidQId {
-	# Validate the scalar as a numeric greater than 0.
-	# A positive result does not mean the Question ID exists.
-	# Parameters
-	# $QuesId - Character String.
-	# Returns 1 for a valid string, 0 for invalid.
-	my ($QuesId ) = @_ ;
-	unless ($QuesId) {
-		return 0 ;
-	}
-	unless ($QuesId =~ m/^\d+$/ ) {
-		warn "Bad $QuesId QuesId" if ($InMem_Debug) ;
-		return 0 ;
-	}
-	unless ($QuesId > 0) {
-		warn "Bad $QuesId QuesId" if ($InMem_Debug) ;
-		return 0 ;
-	}
-	return 1 ;
-}
-
-sub CreateClientSkeleton {
-	# Create a very minimal data structure for a client.
-	# Parameters
-	# $ClientID - Character String.
-	my ($ClientID ) = @_ ;
-	unless ($ClientID) {
-		die "Error: CreateClientSkeleton called with an empty ClientID" ;
-	}
-	unless (&ValidateClientStr($ClientID)) {
-		die "Error: CreateClientSkeleton called with an invalid ClientID character."
-	}
-	unless($GlobalData) {
-		$GlobalData = {'CLIENTS' => {}} ;
-	}
-	unless($GlobalData -> {'CLIENTS'} -> {$ClientID}) {
-		warn "Initialize $ClientID Client" if ($InMem_Debug) ;
-		$GlobalData -> {'CLIENTS'} -> {$ClientID} = {} ;
-	}
-	return 1 ;
-}
-
-sub CreateCandidateSkeleton {
-	# Create a very minimal data structure for a candidate associated with a client.
-	# Parameters
-	# $ClientID - Character String.
-	# $CandidateID - Character String.
-	my ($ClientID, $CandidateID ) = @_ ;
-	unless ( &CreateClientSkeleton($ClientID) ) {
-		warn "Fail $ClientID, $CandidateID CreateCandidateSkeleton" if ($InMem_Debug) ;
-		return 0 ;
-	}
-	unless ($CandidateID) {
-		die "Error: CreateCandidateSkeleton called with an empty CandidateID" ;
-	}
-	unless ($CandidateID =~ m/^[${ValidCandidateChar}]+$/o ) {
-		die "Error: CreateCandidateSkeleton called with an invalid CandidateID character" . $CandidateID . "." ;
-	}
-	unless ($GlobalData -> {'CLIENTS'} -> {$ClientID} -> {'CANDIDATES'} ) {
-		$GlobalData -> {'CLIENTS'} -> {$ClientID} -> {'CANDIDATES'} = {} ;
-		warn "Initialize $CandidateID CandidateID" if ($InMem_Debug) ;
-	}
-	unless ($GlobalData -> {'CLIENTS'} -> {$ClientID} -> {'CANDIDATES'} -> {$CandidateID}) {
-		$GlobalData -> {'CLIENTS'} -> {$ClientID} -> {'CANDIDATES'} -> {$CandidateID} = {} ;
-		warn "Initialize $CandidateID CandidateID" if ($InMem_Debug) ;
-	}
-	return 1 ;
-}
-
-sub GetClientsInMem {
-	# Return an array of the Client Names in Memory.
-	my @Clients ;
-	if ($GlobalData and $GlobalData -> {'CLIENTS'}) {
-		@Clients = keys %{$GlobalData -> {'CLIENTS'}} ;
-	}
-	return @Clients ;
-}
-
-sub ImportAllClientIDs {
-	# Populate the data structure for all clients.
-	# Parameters - No input parms.
-	# Return 0 if there is a problem, 1 if all is OK.
-	my $ClientFile = $main::PATHS{'dataroot'} . $main::pathsep . "clients.dat" ;
-	my $line_cnt = 0 ;
-	my @field_ids = () ;
-}
-
-sub CreateCanTestSkel {
-	# Create a very minimal data structure for a test taken by a candidate.
-	# Parameters
-	# $ClientID - Character String.
-	# $CandidateID - Character String.
-	# $TestID - Character String.
-	# Return 1 for success, 0 for failure.
-	my ($ClientID, $CandidateID, $TestID) = @_ ;
-	unless ( &CreateCandidateSkeleton($ClientID, $CandidateID)) {
-		return 0 ;
-	}
-	unless (&ValidateTestIDStr ($TestID)) {
-		return 0 ;
-	}
-	unless ($GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'} ) {
-		warn "Initialize $ClientID, $CandidateID CandidateID Tests" if ($InMem_Debug) ;
-		$GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'} = {} ;
-	}
-	unless ($GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID} ) {
-		warn "Initialize $ClientID, $CandidateID CandidateID Tests" if ($InMem_Debug) ;
-		$GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID} = {} ;
-	}
-	return 1 ;
-}
-
-sub CreateCanTestTypeSkel {
-	# Create a very minimal data structure for a test type taken by a candidate.
-	# Parameters
-	# $ClientID - Character String.
-	# $CandidateID - Character String.
-	# $TestID - Character String.
-	# $TestType - Character String, limited values.
-	# Return 1 for success, 0 for failure.
-	my ($ClientID, $CandidateID, $TestID, $TestType) = @_ ;
-	unless (&CreateCanTestSkel($ClientID, $CandidateID, $TestID)) {
-		return 0 ;
-	}
-	unless ($ValidTestTypes{$TestType}) {
-		return 0 ;
-	}
-	unless ($GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID} ) {
-		warn "Initialize $ClientID, $CandidateID, $TestType TestType" if ($InMem_Debug) ;
-		$GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID} = {} ;
-	}
-	unless ($GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID}->{$TestType} ) {
-		warn "Initialize $ClientID, $CandidateID, $TestType TestType" if ($InMem_Debug) ;
-		$GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID}->{$TestType} = {} ;
-	}
-	return 1 ;
-}
-
-sub CreateCanTestTypeQIdSkel {
-	# Create a very minimal data structure for a Question in a test taken.
-	# Parameters
-	# $ClientID - Character String.
-	# $CandidateID - Character String.
-	# $TestID - Character String.
-	# $TestType - Character String, limited values.
-	# $QuesID - a one based integer.
-	# Return 1 for success, 0 for failure.
-	my ($ClientID, $CandidateID, $TestID, $TestType, $QuesID) = @_ ;
-	unless (&CreateCanTestTypeSkel($ClientID, $CandidateID, $TestID, $TestType)) {
-		return 0 ;
-	}
-	unless (&ValidQId($QuesID)) {
-		return 0 ;
-	}
-	unless ($GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID}->{$TestType}->{$QuesID} ) {
-		warn "Initialize $ClientID, $CandidateID, $TestType, $QuesID QuesID" if ($InMem_Debug) ;
-		$GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID}->{$TestType}->{$QuesID} = {} ;
-	}
-	return 1 ;
-}
-
-sub InsertQuesComment {
-	# Place a Comment in a data structure for a Question in a test taken.
-	# Parameters
-	# $ClientID - Character String.
-	# $CandidateID - Character String.
-	# $TestID - Character String.
-	# $TestType - Character String, limited values.
-	# $QuesID - a one based integer.
-	# $Comment -  A string.
-	# Return 1 for success, 0 for failure.
-	my ($ClientID, $CandidateID, $TestID, $TestType, $QuesID, $Comment) = @_ ;
-	unless (&CreateCanTestTypeQIdSkel($ClientID, $CandidateID, $TestID, $TestType, $QuesID)) {
-		return 0 ;
-	}
-	# Any Character string, even an empty string is valid.
-	unless ($Comment) {
-		$Comment = "" ;
-	}
-	$GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID}->{$TestType}->{$QuesID}->{'Comment'} = $Comment ;
-	warn "Add Comment CLI $ClientID User $CandidateID Tst $TestID Type $TestType QID $QuesID Text $Comment X" ;
-	return 1 ;
-}
-
-sub InsertQuesResp {
-	# Place a Text Response answer for a Question in a test taken in a data structure.
-	# Parameters
-	# $ClientID - Character String.
-	# $CandidateID - Character String.
-	# $TestID - Character String.
-	# $TestType - Character String, limited values.
-	# $QuesID - a one based integer.
-	# $Resp -  A string.
-	# Return 1 for success, 0 for failure.
-	my ($ClientID, $CandidateID, $TestID, $TestType, $QuesID, $Resp) = @_ ;
-	unless (&CreateCanTestTypeQIdSkel($ClientID, $CandidateID, $TestID, $TestType, $QuesID)) {
-		return 0 ;
-	}
-	# Any Character string, even an empty string is valid.
-	unless ($Resp) {
-		$Resp = "" ;
-	}
-	$GlobalData->{'CLIENTS'}->{$ClientID}->{'CANDIDATES'}->{$CandidateID}->{'Tests'}->{$TestID}->{$TestType}->{$QuesID}->{'Resp'} = $Resp ;
-	# warn "Add Response CLI $ClientID User $CandidateID Tst $TestID Type $TestType QID $QuesID Text $resp X" ;
-	return 1 ;
-}
-
-1 ; # End of a library perl file.
-

survey-nginx/cgi-bin/IntegroLib.pm.bu20100610

@@ -1,503 +0,0 @@
-package IntegroLib;
-
-# A collection of functions used for custom reports for Integro.
-# Most data processing functions.
-#
-# $Id: IntegroLib.pm,v 1.5 2005/10/31 17:03:34 ddoughty Exp $
-
-use FileHandle;
-use Time::Local;
-use Data::Dumper;
-
-use vars qw(%FORM %SESSION %CLIENT %TEST_SESSION %SUBTEST_QUESTIONS %TEST
-	    %SUBTEST_SUMMARY %CANDIDATE %SUBTEST_ANSWERS %SYSTEM %REPORT
-	    %SUBTEST_RESPONSES);
-use vars qw($testcomplete $cgiroot $pathsep $dataroot );
-require 'sitecfg.pl';
-require 'testlib.pl';
-require 'tstatlib.pl';
-
-require Exporter;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-@ISA = qw(Exporter);
-# Items to export into callers namespace by default. Note: do not export
-# names by default without a very good reason. Use EXPORT_OK instead.
-# Do not simply export all your public functions/methods/constants.
-@EXPORT = qw(get_survey_results CommEffectData TrustLevelData ValuesData diversityData KindsOfPeopleData);
-@EXPORT_OK = qw();
-$VERSION = '0.01';
-
-sub get_survey_results {
-    my ($client,$user,$test) = @_;
-    &main::get_test_sequence_for_reports($client,$user,$test);
-    #print STDERR Dumper(\%SUBTEST_RESPONSES,\%SUBTEST_QUESTIONS);
-    my (@answers,$i,@comments,@responses);
-    foreach (split(/\&/,$main::SUBTEST_RESPONSES{2})) {
-	my ($response,$comment) = split(/::/,$_);
-	push @responses, $response;
-	push @comments, $comment;
-    }
-    for ($i = 1; $i<=69; $i++) {
-	($responses[$i] =~ /^\D*(\d+)/);
-	$answers[$i] = $1;
-	# Also need to get comments
-    }
-    if ($main::SUBTEST_QUESTIONS{2} =~ /\.057/) {
-	($responses[57] =~ /^\D*(\d+)/);
-	$answers[57] = $1;
-    } else {
-	# Question 57 is suppressed in this survey
-	# Shift the last two questions to their
-	# correct position, and flag 57
-	$comments[60] = $comments[59];
-	$comments[59] = $comments[58];
-	$comments[58] = $comments[57];
-	$comments[57] = -1;
-	$responses[60] = $responses[59];
-	$responses[59] = $responses[58];
-	$responses[58] = $responses[57];
-	$answers[57] = -1;
-    }
-    my ($slug,$steady,$energetic) = (5,5,5);
-    my @tmp = split(/\?/,$responses[58]);
-    for ($i = 1; $i<= 60; $i+=3) {
-	#print STDERR "$i - $tmp[$i] - $slug,\n";
-	if ($tmp[$i] =~ /\d+/) {
-	    last;
-	} else {
-	    $slug += 5;
-	}
-    }
-    if ($slug == 105) {$slug = 0;}
-    foreach ($i = 2; $i<= 60; $i+=3) {
-	#print STDERR "$i - $tmp[$i] - $steady\n";
-	if ($tmp[$i] =~ /\d+/) {
-	    last;
-	} else {
-	    $steady += 5;
-	}
-    }
-    if ($steady == 105) {$steady = 0;}
-    foreach ($i = 3; $i<= 60; $i+=3) {
-	#print STDERR "$i - $tmp[$i] - $energetic\n";
-	if ($tmp[$i] =~ /\d+/) {
-	    last;
-	} else {
-	    $energetic += 5;
-	}
-    }
-    if ($energetic ==105) {$energetic = 0;}
-    if (($slug + $steady + $energetic) == 100) {
-	$answers[58] = [$slug,$steady,$energetic];
-    } else {
-	#print STDERR "$slug, $steady, $energetic\n";
-	$answers[58] = undef;
-    }
-    $answers[59] = $responses[59];
-    #print STDERR Dumper(\@answers);
-    if (wantarray) {
-	return (\@answers,\@comments);
-    } else {
-	return \@answers;
-    }
-}
-
-sub CommEffectData {
-    my ($client,$testid,$idlist,$groups) = @_;
-    my $grpMembership = &main::getGroupMemberships($client);
-    my $config = {'Purpose' => {'Clarity' => [17,25],
-				'Approval' => [21,29]},
-		  'Values' => {'Clarity' => [19,27],
-			       'Approval' => [23,31]},
-		  'Vision' => {'Clarity' => [18,33],
-			       'Approval' => [22,37]},
-		  'Goals' => {'Clarity' => [26,34],
-			      'Approval' => [30,38]},
-		  'Procedures' => {'Clarity' => [20,35],
-				   'Approval' => [24,39]},
-		  'Roles' => {'Clarity' => [28,36],
-			      'Approval' => [32,40]}
-	      };
-    #my (%histograms,$claritysum,$approvalsum);
-    my $res;
-    foreach (keys %$config) {
-	@{$res->{'organization'}->{'histogram'}->{$_}->{'Clarity'}} = (0,0,0,0,0,0,0);
-	foreach my $i (0..6) {
-	    @{$res->{'organization'}->{'histogram'}->{$_}->{'Approval'}->[$i]} = (0,0,0);
-	}
-    }
-    my @filelist = &main::get_test_result_files($main::testcomplete, $client,$testid);
-    foreach my $file (@filelist) {
-	my $user = $file;
-	$user =~ s/.$testid$//;
-	$user =~ s/^$client.//;
-	if (defined $idlist and not $idlist->{$user}) {
-	    next;
-	}
-	my $answers = &get_survey_results( $client, $user, $testid);
-	foreach (keys %$config) {
-	    my ($clarity, $approval);
-	    if (defined $answers->[$config->{$_}->{'Clarity'}->[0]] and
-		defined $answers->[$config->{$_}->{'Clarity'}->[1]] and
-		defined $answers->[$config->{$_}->{'Approval'}->[0]] and 
-		defined $answers->[$config->{$_}->{'Approval'}->[1]]) {
-		$clarity = $answers->[$config->{$_}->{'Clarity'}->[0]] +
-		    $answers->[$config->{$_}->{'Clarity'}->[1]];
-		$res->{'organization'}->{'histogram'}->{$_}->{'Clarity'}->[$clarity]++;
-		$res->{'organization'}->{'claritysum'}->{$_}->{'number'}++;
-		$res->{'organization'}->{'claritysum'}->{$_}->{'value'} += $clarity;
-		$approval = $answers->[$config->{$_}->{'Approval'}->[0]] +
-		    $answers->[$config->{$_}->{'Approval'}->[1]];
-		$res->{'organization'}->{'approvalsum'}->{$_}->{'number'}++;
-		$res->{'organization'}->{'approvalsum'}->{$_}->{'value'} += $approval;
-		my $approvalhist;
-		if ($approval < 3) {$approvalhist = 0;}
-		elsif ($approval < 5) {$approvalhist = 1;}
-		else {$approvalhist = 2;}
-		$res->{'organization'}->{'histogram'}->{$_}->{'Approval'}->[$clarity]->[$approvalhist]++;
-		#if () {
-		if ($grpMembership and exists $grpMembership->{$user}) {
-		    foreach my $group (@{$grpMembership->{$user}}) {
-			if (defined $idlist and not exists $groups->{$group}) {
-			    # a subset of groups was chosen, and this group is not in that list
-			    next;
-			}
-			if (not exists $res->{'groups'}->{$group}) {
-			    foreach my $conf (keys %$config) {
-				@{$res->{'groups'}->{$group}->{'histogram'}->{$conf}->{'Clarity'}} = (0,0,0,0,0,0,0);
-				foreach my $i (0..6) {
-				    @{$res->{'groups'}->{$group}->{'histogram'}->{$conf}->{'Approval'}->[$i]} = (0,0,0);
-				}
-			    }
-			}
-			$res->{'groups'}->{$group}->{'histogram'}->{$_}->{'Clarity'}->[$clarity]++;
-			$res->{'groups'}->{$group}->{'histogram'}->{$_}->{'Approval'}->[$clarity]->[$approvalhist]++;
-			$res->{'groups'}->{$group}->{'claritysum'}->{$_}->{'number'}++;
-			$res->{'groups'}->{$group}->{'claritysum'}->{$_}->{'value'} += $clarity;
-			$res->{'groups'}->{$group}->{'approvalsum'}->{$_}->{'number'}++;
-			$res->{'groups'}->{$group}->{'approvalsum'}->{$_}->{'value'} += $approval;
-		    }
-		}
-	    }
-	}
-    }
-    my @groups = ($res->{'organization'});
-    if (exists $res->{'groups'}) {push @groups, values(%{$res->{'groups'}});}
-    foreach my $group (@groups) {
-	my ($count,$claritytot,$approvaltot) = (scalar(keys(%{$group->{'claritysum'}})),0,0);
-	foreach (values %{$group->{'claritysum'}}) {
-	    $_->{'value'} = 100*$_->{'value'}/(6*$_->{'number'});
-	    $claritytot += $_->{'value'};
-	}
-	foreach (values %{$group->{'approvalsum'}}) {
-	    $_->{'value'} = 100*$_->{'value'}/(6*$_->{'number'});
-	    $approvaltot += $_->{'value'};
-	}
-	$group->{'overallclarity'} = ($count ? $claritytot/$count : undef);
-	$group->{'overallapproval'} = ($count ? $approvaltot/$count : undef);
-    }
-    #print STDERR Dumper($res);
-    return $res;
-}
-
-sub TrustLevelData {
-    my ($client,$testid,$idlist,$groups) = @_;
-    my $grpMembership = &main::getGroupMemberships($client);
-    my %reversed = (2 => 1, 13 => 1, 15 => 1);
-    my %config = ('Openness'    => [1,5,9,13],
-		  'Congruence'  => [2,6,10,14],
-		  'Acceptance'  => [3,7,11,15],
-		  'Reliability' => [4,8,12,16]
-		  );
-    my ($res,%defhistograms);
-    @defhistograms{keys(%config)} = ([0,0,0,0,0,0,0,0,0],
-				  [0,0,0,0,0,0,0,0,0],
-				  [0,0,0,0,0,0,0,0,0],
-				  [0,0,0,0,0,0,0,0,0]);
-    @{$res->{'organization'}->{'histogram'}}{keys(%config)} = ([0,0,0,0,0,0,0,0,0],
-							       [0,0,0,0,0,0,0,0,0],
-							       [0,0,0,0,0,0,0,0,0],
-							       [0,0,0,0,0,0,0,0,0]);
-    my @filelist = &main::get_test_result_files($main::testcomplete, $client,$testid);
-    foreach my $file (@filelist) {
-	my $user = $file;
-	$user =~ s/.$testid$//;
-	$user =~ s/^$client.//;
-	if (defined $idlist and not $idlist->{$user}) {
-	    next;
-	}
-	my $answers = &get_survey_results( $client, $user, $testid);
-	CONFIG: foreach (keys %config) {
-	    my $value;
-	    foreach my $i (@{$config{$_}}) {
-		if (not defined $answers->[$i]) {
-		    # We are missing a response in one of the data points for this category,
-		    # skip the category for this canidate.
-		    $value = 0;
-		    next CONFIG;
-		}
-		if (exists $reversed{$i}) {
-		    $value += (4 - $answers->[$i]);
-		} else {
-		    $value += $answers->[$i];
-		}
-	    }
-	    $res->{'organization'}->{'trust'}->{$_}->{'number'}++;
-	    #print STDERR "$_: ($res->{'organization'}->{'trust'}->{$_}->{'number'}, $value => ";
-	    my $hvalue = $value - 4;
-	    $res->{'organization'}->{'trust'}->{$_}->{'value'}+=$value;
-	    if ($hvalue < 0) {$hvalue = 0;}
-	    if ($hvalue > 8) {$hvalue = 8};
-	    $res->{'organization'}->{'histogram'}->{$_}->[$hvalue]++;
-	    if ($grpMembership and exists $grpMembership->{$user}) {
-		# it isn't clear what by group breakout should be
-		# when the reports are limited by groups, so skip it.
-		foreach my $group (@{$grpMembership->{$user}}) {
-		    if (defined $idlist and not exists $groups->{$group}) {
-			# a subset of groups was chosen, and this group is not in that list
-			next;
-		    }
-		    if (not exists $res->{'groups'}->{$group}) {
-			@{$res->{'groups'}->{$group}->{'histogram'}}{keys(%config)} = ([0,0,0,0,0,0,0,0,0],
-										       [0,0,0,0,0,0,0,0,0],
-										       [0,0,0,0,0,0,0,0,0],
-										       [0,0,0,0,0,0,0,0,0]);
-		    }
-		    $res->{'groups'}->{$group}->{'trust'}->{$_}->{'number'}++;
-		    $res->{'groups'}->{$group}->{'trust'}->{$_}->{'value'}+=$value;
-		    $res->{'groups'}->{$group}->{'histogram'}->{$_}->[$hvalue]++;
-		}
-	    }
-	    $value = 0;
-	    $hvalue = 0;
-	}
-    }
-    #print STDERR Dumper($res->{'organization'});
-    my @groups = ($res->{'organization'});
-    if (exists $res->{'groups'}) {push @groups, values(%{$res->{'groups'}});}
-    foreach my $group (@groups) {
-	my ($count,$overall) = (scalar(keys(%{$group->{'trust'}})),0);
-	foreach (values %{$group->{'trust'}}) {
-	    #print STDERR "($_->{'value'}, $_->{'number'})\n";
-	    $_->{'value'} = 100*$_->{'value'}/(16*$_->{'number'});
-	    $overall += $_->{'value'};
-	}
-	$group->{'overalltrust'} = ($count ? $overall/$count : undef);
-    }
-    #print STDERR Dumper($res->{'organization'});
-    return $res;
-}
-
-sub ValuesData {
-    my ($client,$testid,$idlist,$groups) = @_;
-    my $grpMembership = &main::getGroupMemberships($client);
-    #print STDERR Dumper( $grpMembership );
-    #my @filelist = &main::get_test_result_files($main::testcomplete, $client,$testid);
-		my %config ;
-		if ($testid eq "passion") {
-    %config = ('Straightforwardness' => 21,
-		  'Honesty' => 23,
-		  'Receptivity' => 25,
-		  'Disclosure' => 27,
-		  'Respect' => 29,
-		  'Recognition' => 31,
-		  'Seeks Excellence' => 33,
-		  'Keeps Commitments' => 35,
-		  );
-		} else {
-    %config = ('Straightforwardness' => 41,
-		  'Honesty' => 43,
-		  'Receptivity' => 45,
-		  'Disclosure' => 47,
-		  'Respect' => 49,
-		  'Recognition' => 51,
-		  'Seeks Excellence' => 53,
-		  'Keeps Commitments' => 55,
-		  );
-		}
-    # data is stored [Personal Importance, Work Performance]
-    my %levels = map(($_ => [0,0]), keys(%config));
-    my %count = map(($_ => 0), keys(%config)); # number of responses
-    my @filelist = &main::get_test_result_files($main::testcomplete, $client,$testid);
-    my $res = {};
-    foreach my $file (@filelist) {
-	my $user = $file;
-	$user =~ s/.$testid$//;
-	$user =~ s/^$client.//;
-	if (defined $idlist and not $idlist->{$user}) {
-	    next;
-	}
-	my $answers = &get_survey_results( $client, $user, $testid);
-	foreach (keys %config) {
-	    if (not defined $answers->[$config{$_}] or not defined $answers->[$config{$_}+1]) {
-		next;
-	    }
-	    $res->{'organization'}->{$_}->{'count'}++;
-	    $res->{'organization'}->{$_}->{'Personal Importance'} += $answers->[$config{$_}]+1;
-	    $res->{'organization'}->{$_}->{'Work Performance'} += $answers->[$config{$_}+1]+1;
-	    if ($grpMembership and exists $grpMembership->{$user}) {
-		# it isn't clear what by group breakout should be
-		# when the reports are limited by groups, so skip it.
-		foreach my $group (@{$grpMembership->{$user}}) {
-		    if (defined $idlist and not exists $groups->{$group}) {
-			# a subset of groups was chosen, and this group is not in that list
-			next;
-		    }
-		    $res->{'groups'}->{$group}->{$_}->{'count'}++;
-#my $bob = $answers->[$config{$_}]+1;
-#print STDERR "User: $user Group: $group Value: $_ Answer: $bob\n";
-		    $res->{'groups'}->{$group}->{$_}->{'Personal Importance'} += $answers->[$config{$_}]+1;
-		    $res->{'groups'}->{$group}->{$_}->{'Work Performance'} += $answers->[$config{$_}+1]+1;
-		}
-	    }
-	}
-    }
-    my @tmp = ($res->{'organization'});
-    if (exists $res->{'groups'}) {push @tmp, values(%{$res->{'groups'}});}
-    foreach my $grp (@tmp) {
-	foreach (keys %config) {
-	    if (not $grp->{$_}->{'count'}) {next;}
-	    $grp->{$_}->{'Personal Importance'} /= $grp->{$_}->{'count'};
-	    $grp->{$_}->{'Work Performance'} /= $grp->{$_}->{'count'};
-	    $grp->{'Personal Importance'} += $grp->{$_}->{'Personal Importance'};
-	    $grp->{'Work Performance'} += $grp->{$_}->{'Work Performance'};
-	    $grp->{'gap'} += $grp->{$_}->{'Personal Importance'} - $grp->{$_}->{'Work Performance'};
-	}
-    }
-    return $res;
-}
-
-sub diversityData {
-    my ($client,$testid,$idlist,$groups) = @_;
-#		warn "diversityData called" ; # HBI Debug
-    my $grpMembership = &main::getGroupMemberships($client);
-    #print STDERR Dumper( $grpMembership );
-    #my @filelist = &main::get_test_result_files($main::testcomplete, $client,$testid);
-    my %config = ('Respectfulness' => 60,
-		  'Speaking Up' => 62,
-		  'Divergent Thinking' => 64,
-		  'Freedom from Harassment' => 66,
-		  'Fairness of Decisions' => 68
-		  );
-    # data is stored [Personal Importance, Work Performance]
-    my %levels = map(($_ => [0,0]), keys(%config));
-    my %count = map(($_ => 0), keys(%config)); # number of responses
-    my @filelist = &main::get_test_result_files($main::testcomplete, $client,$testid);
-    my $res = {};
-    foreach my $file (@filelist) {
-	my $user = $file;
-	$user =~ s/.$testid$//;
-	$user =~ s/^$client.//;
-	if (defined $idlist and not $idlist->{$user}) {
-	    next;
-	}
-	my $answers = &get_survey_results( $client, $user, $testid);
-	foreach (keys %config) {
-	    if (not defined $answers->[$config{$_}] or not defined $answers->[$config{$_}+1]) {
-		next;
-	    }
-	    $res->{'organization'}->{$_}->{'count'}++;
-	    $res->{'organization'}->{$_}->{'Personal Importance'} += $answers->[$config{$_}]+1;
-	    $res->{'organization'}->{$_}->{'Work Performance'} += $answers->[$config{$_}+1]+1;
-	    if ($grpMembership and exists $grpMembership->{$user}) {
-		# it isn't clear what by group breakout should be
-		# when the reports are limited by groups, so skip it.
-		foreach my $group (@{$grpMembership->{$user}}) {
-		    if (defined $idlist and not exists $groups->{$group}) {
-			# a subset of groups was chosen, and this group is not in that list
-			next;
-		    }
-		    $res->{'groups'}->{$group}->{$_}->{'count'}++;
-#my $bob = $answers->[$config{$_}]+1;
-#print STDERR "User: $user Group: $group Value: $_ Answer: $bob\n";
-		    $res->{'groups'}->{$group}->{$_}->{'Personal Importance'} += $answers->[$config{$_}]+1;
-		    $res->{'groups'}->{$group}->{$_}->{'Work Performance'} += $answers->[$config{$_}+1]+1;
-		}
-	    }
-	}
-    }
-    my @tmp = ($res->{'organization'});
-    if (exists $res->{'groups'}) {push @tmp, values(%{$res->{'groups'}});}
-    foreach my $grp (@tmp) {
-	foreach (keys %config) {
-	    if (not $grp->{$_}->{'count'}) {next;}
-	    $grp->{$_}->{'Personal Importance'} /= $grp->{$_}->{'count'};
-	    $grp->{$_}->{'Work Performance'} /= $grp->{$_}->{'count'};
-	    $grp->{'Personal Importance'} += $grp->{$_}->{'Personal Importance'};
-	    $grp->{'Work Performance'} += $grp->{$_}->{'Work Performance'};
-	    $grp->{'gap'} += $grp->{$_}->{'Personal Importance'} - $grp->{$_}->{'Work Performance'};
-	}
-    }
-    return $res;
-}
-
-sub KindsOfPeopleData {
-    my ($client,$testid,$idlist,$groups) = @_;
-    my $grpMembership = &main::getGroupMemberships($client);
-    #print STDERR Dumper( $grpMembership );
-    my @filelist = &main::get_test_result_files($main::testcomplete,$client,$testid);
-    my $res = {'self' =>{}};
-    $res->{'self'}->{'count'} = 0;
-    foreach my $file (@filelist) {
-	my $user = $file;
-	$user =~ s/\.$testid$//;
-	$user =~ s/^$client\.//;
-	#print STDERR " $user\n";
-	my $answers = &get_survey_results( $client, $user, $testid);
-	if (defined $idlist and not $idlist->{$user}) {
-	    #print STDERR "Skipping $user\n";
-	    next;
-	}
-	$res->{'Number of Surveys'}++;
-	#print STDERR Dumper($answers);
-	if (exists $res->{'self'} and defined $answers->[57] ) {
-#print STDERR "BOOOO:$user:$answers->[57]:$answers->[57]->[0] $answers->[57]->[1] $answers->[57]->[2]\n";
-	    if ($answers->[57] >= 0) {
-		my @types = ('Rebellious', 'Compliant', 'Self-Directed');
-		$res->{'self'}->{'count'}++;
-		$res->{'self'}->{$types[$answers->[57]]} += 100;
-	    }
-	}
-	if (defined $answers->[58] ) {
-	    #print STDERR "BOOOO::$user $answers->[58]->[0] $answers->[58]->[1] $answers->[58]->[2]\n";
-	    $res->{'organization'}->{'count'}++;
-	    $res->{'organization'}->{'Rebellious'} += $answers->[58]->[0];
-	    $res->{'organization'}->{'Compliant'} += $answers->[58]->[1];
-	    $res->{'organization'}->{'Self-Directed'} += $answers->[58]->[2];
-	    if ($grpMembership and exists $grpMembership->{$user}) {
-		foreach my $group (@{$grpMembership->{$user}}) {
-		    if (defined $idlist and not exists $groups->{$group}) {
-			# a subset of groups was chosen, and this group is not in that list
-			next;
-		    }
-		    $res->{'groups'}->{$group}->{'count'}++;
-		    $res->{'groups'}->{$group}->{'Rebellious'} += $answers->[58]->[0];
-		    $res->{'groups'}->{$group}->{'Compliant'} += $answers->[58]->[1];
-		    $res->{'groups'}->{$group}->{'Self-Directed'} += $answers->[58]->[2];
-		}
-	    }
-	}
-    }
-    if ($res->{'self'}->{'count'} < 1) {
-	delete $res->{'self'};
-    }
-    if (not defined $res) {
-	return undef;
-    }
-    my @tmp = ($res->{'organization'});
-    if (exists $res->{'groups'}) {push @tmp, values(%{$res->{'groups'}});}
-    if (exists $res->{'self'}) {push @tmp, $res->{'self'};}
-    foreach (@tmp) {
-	if (not $_->{'count'}) {
-	    $_ = undef;
-	    next;
-	}
-	$_->{'Rebellious'} /= $_->{'count'};
-	$_->{'Compliant'} /= $_->{'count'};
-	$_->{'Self-Directed'} /= $_->{'count'};
-    }
-    #print STDERR Dumper($res,$idlist);
-    return $res;
-}
-
-1;

survey-nginx/cgi-bin/IntegroTeam.pl.bu20131217

@@ -1,623 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: IntegroTeam.pl,v 1.13 2006/04/12 19:18:47 ddoughty Exp $
-#
-# Source File: Integro.pl
-
-# Get config
-use FileHandle;
-use Time::Local;
-use Data::Dumper;
-use IntegroLib;
-require 'sitecfg.pl';
-require 'testlib.pl';
-require 'tstatlib.pl';
-
-use strict;
-use vars qw(%FORM %SESSION %CLIENT %TEST_SESSION %SUBTEST_QUESTIONS %TEST
-	    %SUBTEST_SUMMARY %CANDIDATE %SUBTEST_ANSWERS %SYSTEM %REPORT
-	    %SUBTEST_RESPONSES);
-use vars qw($testcomplete $testinprog $testcomplete $testpending $cgiroot $pathsep $dataroot @rptparams);
-
-&app_initialize;
-
-$FORM{"idlist"} =~ tr/\000/,/ ; # Change separator for multiple values from NULL to comma.  HBI
-
-&LanguageSupportInit();
-&get_client_profile($SESSION{'clid'});
-
-if ($FORM{'tstid'}) {
-        &get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
-} elsif (!$rptparams[0]) {
-        # Check for multiple tests
-        my @trecs = &get_test_list($CLIENT{'clid'});    #tests in an array
-        my @tmptrecs = ();
-        for (1 .. $#trecs) {
-                my ($id, $desc) = split(/&/, $trecs[$_]);       #id=testid, descr=test description
-                if ($id =~ "^TAQ") {push @tmptrecs, join('&', "$desc", "$id");}
-        }
-        @trecs = sort @tmptrecs;
-        if ($#trecs > 0) { 
-                # show test chooser
-                &print_test_chooser(@trecs);
-        } 
-}
-
-
-# Make sure we have a valid session, and exit if we don't
-if (not &get_session($FORM{'tid'})) {
-    exit(0);
-}
-
-# Get the group filters, if any
-my ($idlist,$groups);
-if (exists $FORM{'grouping'} and $FORM{'grouping'} eq 'subset') {
-    #my @tmp = split(/,/,$FORM{'idlist'});
-    my @tmp = param('idlist');
-    $FORM{'idlist'} = join(',', @tmp);
-    @{$groups}{@tmp} = @tmp;
-    $idlist = &getIdlist($CLIENT{'clid'},$FORM{'idlist'});
-}
-
-# Get the time stamp style
-my $timestamp;
-if ($FORM{'timestamp'} eq 'currenttime') {
-    $timestamp = scalar(localtime(time));
-} elsif ($FORM{"timestamp"} eq 'custom' and $FORM{'customtime'} ne '') {
-    $timestamp = $FORM{'customtime'};
-} elsif ($FORM{'timestamp'} eq 'mostrecent' and $FORM{'tstid'}) {
-    my $file = join($pathsep,$testcomplete,"$CLIENT{'clid'}.$FORM{'tstid'}.history");
-    my $fh = new FileHandle;
-    if ($fh->open($file)) {
-	my @history = map([split(/(?:<<>>|&)/,$_,4)],<$fh>);
-	#print "<pre>".Dumper(\@history)."</pre>";
-	if (defined $idlist) {
-	    foreach (reverse @history) {
-		if (exists $idlist->{$_->[2]}) {
-		    $timestamp = scalar(localtime(toGMSeconds($_->[0])));
-		    last;
-		}
-	    }
-	} else {
-	    $timestamp = scalar(localtime(toGMSeconds($history[$#history]->[0])));
-	}
-    } else {
-	print STDERR "Could not open $file in Integro.pl\n";
-    }
-}
-if (defined $timestamp) {
-    $timestamp = "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$timestamp</b></font><br><BR>\n";
-} else {
-    $timestamp = "<br>\n";
-}
-
-# Is this report for a specific canidate?
-my $cndid;
-#print STDERR "$FORM{'specificuser'} $FORM{'cndid'}\n";
-if ($FORM{'specificuser'} and (not $idlist or $idlist->{$FORM{'cndid'}})) {
-    $cndid = $FORM{'cndid'};
-}
-
-# Generate the reports
-if ($FORM{'reportname'} eq 'commeffect') {
-    &CommEffectReport($idlist, $groups, $timestamp, $cndid);
-} elsif ($FORM{'reportname'} eq 'commeffectsummary') {
-    &CommEffectSummary($idlist, $groups, $timestamp);
-} elsif ($FORM{'reportname'} eq 'trustlevel') {
-    &TrustLevelReport($idlist, $groups, $timestamp, $cndid);
-} elsif ($FORM{'reportname'} eq 'trustlevelsummary') {
-    &TrustLevelSummary($idlist, $groups, $timestamp);
-} elsif ($FORM{'reportname'} eq 'comments') {
-    &CommentsReport($idlist, $timestamp, 0);
-} elsif ($FORM{'reportname'} eq 'comments2') {
-    &CommentsReport($idlist, $timestamp, 1);
-} else {
-    &ReportChooser();
-}
-
-# There should only be function definitions beyond this point.
-exit(0);
-
-sub HTMLHeader {
-    return "<html>\n<head>\n<title>$_[0]</title>\n".
-	"<script language=\"JavaScript\">\n<!-- \n$_[1]\n -->\n</script>\n".
-	"</head>\n".
-	"<BODY BACKGROUND=\"$SYSTEM{'BACKGROUND'}\" BGCOLOR=\"$SYSTEM{'BGCOLOR'}\"".
-	" TEXT=\"$SYSTEM{'TEXT'}\" LINK=\"$SYSTEM{'LINK'}\"".
-	" VLINK=\"$SYSTEM{'VLINK'}\" ALINK=\"$SYSTEM{'ALINK'}\">\n";
-}
-
-sub HTMLHeaderPlain {
-    return "<html>\n<head>\n<title>$_[0]</title>\n".
-	"<script language=\"JavaScript\">\n<!-- \n$_[1]\n -->\n</script>\n</head>\n".
-	"<BODY>\n";
-}
-
-sub HTMLFooter {
-    my $year = `date +%Y`;
-    return "<br><center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">Copyright (c) 2004-$year, Integro Leadership Institute<center></font></body>\n</html>\n";
-}
-
-sub ReportChooser {
-    # Links w/javascript for chosing report
-    # Radio button to choose between all and select group(s)
-    # Menu box to chose one or more groups
-    my $groups = &getGroups($CLIENT{'clid'});
-    my $js = "function parmsIntegro(oform,rpt) {\n\t".
-	"oform.reportname.value=rpt;\n\t".
-	"oform.action='/cgi-bin/creports.pl';\n\t".
-	"oform.submit();\n};\n";
-    $js .= "\nfunction commIntegro(oform) {\n\t".
-	"oform.rptid.value='ACT-C-004';\n\t".
-	"oform.rptdesc.value='Test Statistics by Test'\n\t".
-	"oform.action='/cgi-bin/IntegroTS.pl';\n\t".
-	"oform.submit();\n};\n";
-    
-    my $orgname = $CLIENT{'clnmc'};
-    my $uberheader;
-    my $test;
-    if ($FORM{'tstid'}) {
-	    $test = $FORM{'tstid'};
-    } elsif ($rptparams[0]) {
-	    $test = $rptparams[0];
-    } else {
-	    $test = "TAQ01";
-    }
-    my ($tstid) = grep((/($test\s*)&/ && ($_=$1)),get_data("tests.$CLIENT{'clid'}"));
-    if (not $tstid) {
-	print HTMLHeader("Error! No Team Alignment Questionnaire Found.");
-	print "<h1>Error! No Team Alignment Questionnaire Found.</h1>\n";
-	print HTMLFooter();
-    }
-
-    my $grplist = getGroups($CLIENT{'clid'});
-    my @grplist = keys(%$grplist);
-    my $grplistlen = $#grplist + 2;
-    $js .= "var groups = new Array($grplistlen)\;\n";
-    foreach my $grp (@grplist) {
-        my $gidlist = getIdlist($CLIENT{'clid'}, $grp);
-        my @gidklist = keys(%$gidlist);
-	$js .= "groups[\"$grp\"] = [";
-	foreach my $cnd (@gidklist) {
-		$js .= "\"$cnd\", ";
-	}
-	if ($#gidklist > -1) { $js = substr($js,0,-2); }
-	$js .= "]\;\n";
-	$js .= "groups[\"$grp\"] = groups[\"$grp\"].sort()\;\n";
-    }
-    $js .= "groups[\"all\"] = [";
-    my $users = get_users($CLIENT{'clid'},"$tstid");
-    my @users = keys(%$users);
-    foreach my $cnd (@users) {
-		$js .= "\"$cnd\", ";
-    }
-    if ($#users + 1) { $js = substr($js,0,-2); }
-    $js .= "]\;\n";
-    $js .= "groups[\"all\"] = groups[\"all\"].sort()\;\n";
-    $js .= "function removeOptions(optionMenu) { \
-	var oml = optionMenu.options.length; \
-	for (var i=0; i < oml; i++) { \
-		optionMenu.remove(0); \
-	} \
-} \
- \
-function addOptions(optionList, optionMenu) { \
-	var oml = optionMenu.options.length; \
-	for (var i=0; i < optionList.length; i++) { \
-		optionMenu[oml+i] = new Option(optionList[i], optionList[i]); \
-	} \
-} ";
-    $js .= "function buildGroupList(optionListArray, optionListMenu, optionMenu) {\n\t".
-	   "	removeOptions(optionMenu);".
-	   " 	for (var i=0; i<optionListMenu.options.length; i++) {".
-	   "		if (optionListMenu.options[i].selected) {".
-	   "			addOptions(optionListArray[optionListMenu.options[i].value], optionMenu);".
-	   "		}".
-	   "	}".
-	"};\n";
-
-    print HTMLHeader("Team Alignment Reports",$js);
-    print "<form name=\"integrorpt\" action=\"/cgi-bin/creports.pl\" method=\"Post\" target=\"rptwindow\" enctype=\"multipart/form-data\" >\n";
-    print "<input type=\"hidden\" name=\"tid\" value=\"$SESSION{'tid'}\">\n";
-    # For development purposes we hardcode the survey id.
-    # Fix this before production
-    print "<input type=hidden name=\"tstid\" value=\"$tstid\">\n";
-    print "<input type=hidden name=\"rptno\" value=\"$FORM{'rptno'}\">\n";
-    print "<input type=hidden name=\"rptdesc\" value=\"$REPORT{'rptdesc'}\">\n";
-    print "<input type=hidden name=\"rptid\" value=\"$REPORT{'rptid'}\">\n";
-    print "<input type=\"hidden\" name=\"reportname\" value=\"\">\n";
-    
-    print "<center>\n<table border=\"1\">\n<caption>Team Alignment Reports</Caption>\n".
-	"<tr><td valign=\"top\"><input type=\"radio\" name=\"grouping\" value=\"all\" checked onClick=\"removeOptions(document.integrorpt.cndid); addOptions(groups['all'], this.form.cndid);\">All Groups</td>\n".
-	"<td valign=\"top\"><input type=\"radio\" name=\"grouping\" value=\"subset\" onClick=\"buildGroupList(groups, this.form.idlist, this.form.cndid)\">Choose Groups<br>\n".
-        "<select name=\"idlist\" onchange='this.form.grouping[1].click();' multiple>\n";
-    foreach (sort {$a->{'grpnme'} cmp $b->{'grpnme'}} values %$groups) {
-	print "<option value=\"$_->{'grpid'}\">$_->{'grpnme'}</option>\n";
-    }
-    print "</td><td valign=\"top\"><input type=\"checkbox\" name=\"specificuser\">Specific User<br>";
-    print "<select name=\"cndid\" onchange='this.form.specificuser.checked=true;'>\n";
-    #my $users = get_users($CLIENT{'clid'},"$tstid");
-    #print map("<option value=\"$_\">$_</option>\n",sort(keys(%$users)));
-    print "</select></td></tr>\n";
-    print "<tr><td colspan=\"3\"><table border=0><tr><td>Organization Name:</td><td><input type=\"text\" name=\"orgname\" value=\"$orgname\"></td></tr>\n";
-    print "<tr><td>Header Override:</td><td><input type=\"text\" name=\"uberheader\" value=\"$uberheader\"></td></tr></table></tr></td>\n";
-    print "<tr><td colspan=\"3\">Time Stamp:<ul style=\"list-style: none\">".
-	"<li><input type=\"radio\" name=\"timestamp\" value=\"mostrecent\" checked>Most Recent Survey Taken</li>".
-	"<li><input type=\"radio\" name=\"timestamp\" value=\"currenttime\">Current Time</li>".
-	"<li><input type=\"radio\" name=\"timestamp\" value=\"custom\">Custom Value: ".
-	"<input type=\"text\" name=\"customtime\"></li></tr></td>";
-    print "</table></center>\n";
-    print "<hr>\n";
-    print "<input type=\"checkbox\" name=\"pdf\">Display reports as PDF\n";
-    print "<p> <ul style=\"list-style: none\"><li><a href=\"javascript:parmsIntegro(document.integrorpt,'trustlevel');\">Team Trust Level Report</a></li>".
-	"<!--<li><a href=\"javascript:parmsIntegro(document.integrorpt,'trustlevelsummary');\">Team Trust Level Summary</a></li>--></ul></p>\n";
-    print "<p><ul style=\"list-style: none\"><li><a href=\"javascript:parmsIntegro(document.integrorpt,'commeffect');\">Team Alignment Report</a></li>".
-	"<!--<li><a href=\"javascript:parmsIntegro(document.integrorpt,'commeffectsummary');\">Team Alignment Summary</a></li>--></ul></p>\n";
-    print "<p>General Reports<ul style=\"list-style: none\"><li><a href=\"javascript:parmsIntegro(document.integrorpt,'comments');\">Comments</a></li>";
-    print "<li><a href=\"javascript:parmsIntegro(document.integrorpt,'comments2');\">Comments by Category</a></li>";
-    print "<input type=hidden name=\"testsummary\" value=\"composite\">\n";
-    print "<input type=hidden name=\"showcmts\" value=\"donot\">\n";
-    #my $commurl = "/cgi-bin/teststats.pl?tstid=SAS01".
-#	"&tid=$FORM{'tid'}&rptid=ACT-C-004&rptdesc=Test%20Statistics%20by%20Test".
-#	"&testsummary=composite&showcmts=donot";
-    print "<li><a href=\"javascript:commIntegro(document.integrorpt);\">Question Statistics</a></li></p>\n";
-    print "</form>";
-    print "<script language=\"JavaScript\">\n<!-- \n";
-    print "if (document.integrorpt.grouping[0].checked) { addOptions(groups['all'], document.integrorpt.cndid);} else { buildGroupList(groups, document.integrorpt.idlist, document.integrorpt.cndid)}";
-    print "\n -->\n</script>\n";
-    print HTMLFooter();
-}
-
-# Also known as the Group Alignment report
-sub CommEffectReport {
-    my ($idlist,$groups,$timestamp,$cndid) = @_;
-    my $data = &CommEffectData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups);
-    my $user;
-    if ($cndid) {$user = &CommEffectData($CLIENT{'clid'},$TEST{'id'},{$cndid => 1},$groups);&get_candidate_profile($CLIENT{'clid'},$cndid);}
-    my $claritysum = $data->{'organization'}->{'claritysum'};
-    my $approvalsum = $data->{'organization'}->{'approvalsum'};
-    my $histograms = $data->{'organization'}->{'histogram'};
-    print HTMLHeaderPlain("Team Alignment Report");
-    print "<Center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\"><b>Team Alignment Questionnaire<br>Team Alignment Report </b><br>$CANDIDATE{'sal'} $CANDIDATE{'nmf'} $CANDIDATE{'nmm'} $CANDIDATE{'nml'}</font><br>\n";
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>The Degree to which Team Members are in Alignment</b></font><br>\n";
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$FORM{'orgname'}</b></font><br>\n";
-    if ($FORM{'uberheader'} ne "") {
-        print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>".$FORM{'uberheader'}."</b></font><br>\n";
-    } elsif (defined $idlist) {
-	my $groups = getGroups($CLIENT{'clid'});
-	print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Groups: "
-	    .join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n";
-    } else {
-	#print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Organization-wide Report</b></font><br>\n";
-	print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b></b></font><br>\n";
-    }
-    print $timestamp;
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b><table border><tr><th>&nbsp;&nbsp;&nbsp;&nbsp;</th><th><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b>Very Unclear</b></font></th><th>&nbsp;&nbsp;&nbsp;&nbsp;</th>".
-	"<th><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b>Moderately Unclear</b></font></th><th>&nbsp;&nbsp;&nbsp;&nbsp;</th><th><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b>Moderately Clear</b></font></th>".
-	"<th>&nbsp;&nbsp;&nbsp;&nbsp;</th><th><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b>Very Clear</b></font></th><th><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b>Team Clarity</b></font></th>".
-	"<th><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b>Team Approval</b></font></th></tr>\n";
-    # fill in the rows
-    my $overall = {'clarity' => 0, 'approval' => 0};
-    foreach my $row (qw(Purpose Values Vision Goals Procedures Roles)) {
-	print "<tr><th>$row</th>";
-	for my $i (0..6) {
-	    print "<td align=\"center\">";
-	    if ($histograms->{$row}->{'Clarity'}->[$i]) {
-		if ($histograms->{$row}->{'Approval'}->[$i]->[2]) {
-		    my $img = "/graphic/face-smile.gif";
-		    if ($user and $user->{'organization'}->{'histogram'}->{$row}->{'Approval'}->[$i]->[2]) {
-			$img = "/graphic/face-smile-green.gif";
-		    }
-		    print "<img src=\"$img\"><sub>$histograms->{$row}->{'Approval'}->[$i]->[2]</sub><br>";
-		}
-		if ($histograms->{$row}->{'Approval'}->[$i]->[1]) {
-		    my $img = "/graphic/face-red.gif";
-		    if ($user and $user->{'organization'}->{'histogram'}->{$row}->{'Approval'}->[$i]->[1]) {
-			$img = "/graphic/face-red-green.gif";
-		    }
-		    print "<img src=\"$img\"><sub>$histograms->{$row}->{'Approval'}->[$i]->[1]</sub><br>";
-		}
-		if ($histograms->{$row}->{'Approval'}->[$i]->[0]) {
-		    my $img = "/graphic/face-blue.gif";
-		    if ($user and $user->{'organization'}->{'histogram'}->{$row}->{'Approval'}->[$i]->[0]) {
-			$img = "/graphic/face-blue-green.gif";
-		    }
-		    print "<img src=\"$img\"><sub>$histograms->{$row}->{'Approval'}->[$i]->[0]</sub>";
-		}
-	    } else {
-		print "&nbsp;";
-	    }
-	    print "</td>";
-	}
-	printf "<td align=\"center\">%.1f %%</td>\n", $claritysum->{$row}->{'value'};
-	printf "<td align=\"center\">%.1f %%</td>\n", $approvalsum->{$row}->{'value'};
-	print "</tr>\n";
-    }
-    print "</table>\n<p>Position = Team Clarity</p>\n<p>Countenance = Personal Approval</p>\n";
-    #print "<table border><caption><b>Overall Team Alignment</b></caption>\n";
-    #printf "<tr><th>Clarity</th><td>%.1f %%</td></tr>\n", $data->{'organization'}->{'overallclarity'};
-    #printf "<tr><th>Approval</th><td>%.1f %%</td></tr>\n", $data->{'organization'}->{'overallapproval'};
-    #print "</table></b></font>\n";
-    print HTMLFooter();
-}
-
-sub CommEffectSummary {
-    my ($idlist,$groups,$timestamp) = @_;
-    my $data = &CommEffectData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups);
-    $groups = getGroups($CLIENT{'clid'});
-    print HTMLHeaderPlain("Team Alignment Summary");
-    print "<Center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\"><b>Team Alignment Questionnaire<br>Team Alignment Summary</i></b></font><br><br>\n";
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>The degree to which Employees are Aligned with the Organization</b></font><br>\n";
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$FORM{'orgname'}</b></font><br>\n";
-    if (defined $idlist) {
-	my $groups = getGroups($CLIENT{'clid'});
-	print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Summary for Groups: "
-	    .join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n";
-    } else {
-	#print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Organization-wide Report</b></font><br>\n";
-	print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b></b></font><br>\n";
-    }
-    print $timestamp;
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b><table border>\n";
-    print "<tr><td>&nbsp;</th><th>Clarity</th><th>Approval</th></tr>\n";
-    print "<tr><td>Overall</td>";
-    printf "<td>%.1f %%</td>",$data->{'organization'}->{'overallclarity'};
-    printf "<td>%.1f %%</td></tr>\n", $data->{'organization'}->{'overallapproval'};
-    if (exists $data->{'groups'}) {
-	print "<tr><th colspan=3 align=\"left\">Group Breakdown</th></tr>\n";
-	print "<tr><th>Group</th><th>Clarity</th><th>Approval</th></tr>\n";
-	foreach my $grp (sort keys %{$data->{'groups'}}) {
-	    print "<tr><td>$groups->{$grp}->{'grpnme'}</td>";
-	    printf "<td>%.1f %%</td>", $data->{'groups'}->{$grp}->{'overallclarity'};
-	    printf "<td>%.1f %%</td></tr>\n", $data->{'groups'}->{$grp}->{'overallapproval'};
-	}
-    }
-    print "</table></b></font>\n";
-    print HTMLFooter();
-}
-
-sub TrustLevelReport {
-    my ($idlist,$groups,$timestamp,$cndid) = @_;
-    my $data = &TrustLevelData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups);
-    my $user;
-    if ($cndid) {$user = &TrustLevelData($CLIENT{'clid'},$TEST{'id'},{$cndid => 1},$groups);&get_candidate_profile($CLIENT{'clid'},$cndid);}
-    my $histograms = $data->{'organization'}->{'histogram'};
-    my $trust = $data->{'organization'}->{'trust'};
-    print HTMLHeaderPlain("Team Trust Level Report");
-    print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\"><b>Team Alignment Questionnaire<br>Team Trust Level Report</b><br>$CANDIDATE{'sal'} $CANDIDATE{'nmf'} $CANDIDATE{'nmm'} $CANDIDATE{'nml'} </font><br>\n";
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>The level of Trust Building behaviors</b></font><br>\n";
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$FORM{'orgname'}</b></font><br>\n";
-    if ($FORM{'uberheader'} ne "") {
-	print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>".$FORM{'uberheader'}."</b></font><br>\n";
-    } elsif (defined $idlist) {
-	my $groups = getGroups($CLIENT{'clid'});
-	print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Groups: "
-	    .join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n";
-    } else {
-	#print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Organization-wide Report</b></font><br>\n";
-	print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b></b></font><br>\n";
-    }
-    print $timestamp;
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b><table border=\"1\"><tr><th>&nbsp;</th><th>&nbsp;</th><th>Team Trust Level</th></tr>\n";
-    my $baseurl;
-    if (defined($ENV{'SSL_PROTOCOL'})) {
-        $baseurl = "https://";
-    } else {
-        $baseurl = "http://";
-    }
-    $baseurl .= $ENV{'HTTP_HOST'};
-
-    $baseurl .= "/cgi-bin/bargraph.pl?labels=Low::::Medium::::High&title=Trust%20Level&ylabel=Respondents";
-    $baseurl .= "&xdim=500&ydim=150";
-    foreach my $row (qw(Congruence Openness Acceptance Reliability)) {
-	my $url;
-	if (not $user) {
-	    $url = "$baseurl&values=".join(":",@{$histograms->{$row}});
-	} else {
-	    my (@values,@values2);
-	    for (my $i=0; $i < @{$histograms->{$row}}; $i++) {
-		if ($user->{'organization'}->{'histogram'}->{$row}->[$i]) {
-		    push @values ,'';
-		    push @values2 , $histograms->{$row}->[$i];
-		} else {
-		    push @values2 ,'';
-		    push @values , $histograms->{$row}->[$i];
-		}
-	    }
-	    $url = "$baseurl&values=".join(":",@values)."&values2=".join(":",@values2);
-	}
-	print "<tr><th>$row</th>";
-	print "<td><img src=\"$url\"></td>";
-	printf "<td align=\"center\">%.1f%% </td></tr>\n", $trust->{$row}->{'value'};
-    }
-    print "</table></b></font>\n";
-    #printf "<P><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"2\"><b>Overall Team Level of Trust</b></font> = %.1f %%.</p>\n",$data->{'organization'}->{'overalltrust'};
-    print HTMLFooter();
-}
-
-sub TrustLevelSummary {
-    my ($idlist,$groups,$timestamp) = @_;
-    my $data = TrustLevelData($CLIENT{'clid'},$TEST{'id'},$idlist,$groups);
-    $groups = getGroups($CLIENT{'clid'});
-    print HTMLHeaderPlain("Team Trust Level Summary");
-    print "<Center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\"><b>Team Alignment Questionnaire<br>Team Trust Level Summary</b></font><br><br>\n";
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>The level of Trust Building behaviors</b></font><br>\n";
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$FORM{'orgname'}</b></font><br>\n";
-   if ($FORM{'uberheader'} ne "") {
-        print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>".$FORM{'uberheader'}."</b></font><br>\n";
-    } elsif (defined $idlist) {
-	my $groups = getGroups($CLIENT{'clid'});
-	print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Summary for Groups: "
-	    .join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n";
-    } else {
-	#print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Organization-wide Summary</b></font><br>\n";
-	print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b></b></font><br>\n";
-    }
-    print $timestamp;
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\"><b><table border>\n";
-    print "<tr><td>&nbsp;</th><th>Team Trust Level</th></tr>\n";
-    print "<tr><td>Overall</td>";
-    printf "<td>%.1f %%</td></tr>\n", $data->{'organization'}->{'overalltrust'};
-    if (exists $data->{'groups'}) {
-	print "<tr><th colspan=2 align=\"left\">Group Breakdown</th></tr>\n";
-	print "<tr><th>Group</th><th>Team Trust Level</th></tr>\n";
-	foreach my $grp (sort keys %{$data->{'groups'}}) {
-	    print "<tr><td>$groups->{$grp}->{'grpnme'}</td>";
-	    printf "<td>%.1f %%</td></tr>\n", $data->{'groups'}->{$grp}->{'overalltrust'};
-	}
-    }
-    print "</table></b></font>\n";
-    print HTMLFooter();
-}
-
-sub CommentsReport {
-    my ($idlist, $timestamp, $bycat)  = @_;
-    my @filelist = &get_test_result_files($testcomplete, $CLIENT{'clid'},$TEST{'id'});
-    my @comments;
-    for (my $i=0; $i<=59; $i++) {$comments[$i] = [];}
-    my @questions = map([split(/&/,$_)],&get_question_list($TEST{'id'},$CLIENT{'clid'}));
-    foreach (@questions) {$_->[4] =~ s/:::.*$//;}
-    foreach my $file (@filelist) {
-	my $user = $file;
-	$user =~ s/.$TEST{'id'}$//;
-	$user =~ s/^$CLIENT{'clid'}.//;
-	if (defined $idlist and not $idlist->{$user}) {
-	    next;
-	}
-	my ($answers,$usercomm) = &get_survey_results( $CLIENT{'clid'}, $user, $TEST{'id'});
-	for (my $i=1; $i<=58; $i++) {
-	    if ($usercomm->[$i] == -1) {
-		$comments[$i] = -1;
-	    } elsif ($usercomm->[$i]) {
-		push @{$comments[$i]},$usercomm->[$i];
-	    }
-	}
-	if ($answers->[59]) {
-	    push @{$comments[59]},$answers->[59];
-	}
-    }
-    print HTMLHeaderPlain("Comments Report");
-    print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\"><b>Team Alignment Questionnaire<br>Comments Report</b></font><br><br>\n";
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$FORM{'orgname'}</b></font><br>\n";
-    if ($FORM{'uberheader'} ne "") {
-        print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>".$FORM{'uberheader'}."</b></font><br>\n";
-    } elsif (defined $idlist) {
-	my $groups = getGroups($CLIENT{'clid'});
-	print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Groups: "
-	    .join(", ",map($groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n";
-    } else {
-	#print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Organization-wide Report</b></font><br>\n";
-	print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b></b></font><br>\n";
-    }
-    print $timestamp;
-    print "</center>\n";
-    print "<blockquote>\n";
-
-    my @outary = ();
-    for (my $i=1; $i <=40; $i++) {
-	if ($comments[$i] == -1) {
-	    # inactive question
-	    next;
-	}
-	$outary[$i] = "<hr width=\"100%\"><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"2\"><b>\n";
-	$outary[$i] .= "$questions[$i]->[0] - $questions[$i]->[4]<p>\n";
-	if (@{$comments[$i]}) {
-	    $outary[$i] .= "<ul>\n";
-	    foreach (@{$comments[$i]}) {
-		$outary[$i] .= "<li>$_</li>\n";
-	    }
-	    $outary[$i] .= "</ul>\n";
-	} else {
-	    $outary[$i] .= "<ul><li><small><i>No Comments</i></small></li></ul>\n";
-	}
-	$outary[$i] .= "</b></font>\n";
-    }
-
-    # Read in .rgo file which defines question presentation order
-    my $out;
-    my $lookupfile = join($pathsep,$dataroot,"IntegroTAQ.rgo");
-    if ($bycat && -e $lookupfile) {
-	my $fh = new FileHandle;
-	if ($fh->open($lookupfile)) {
-		$out = "";
-		my @lines = <$fh>;
-		$fh->close();
-		shift @lines;
-		foreach (@lines) {
-			chomp;
-			my @line = split(/\&/,$_);
-			my $section = shift @line;
-			if ($section ne "") {
-				$out .= "<tr><td colspan=6><hr width=\"100\%\"></td></tr>\n";
-				$out .= "<tr><td colspan=6><font size=+1><b>$section</b></font></td></tr>\n";
-			}
-			foreach my $sub (@line) {
-				my ($subheader, $quess) = split(/:/,$sub);
-				if ($subheader ne "") {
-					$out .= "<hr width=100%><tr><td colspan=6><b>$subheader:</b></td></tr>\n";
-				}
-				my @ques = split(/\,/,$quess);
-				foreach my $quesid (@ques) {
-					$out .= $outary[$quesid];
-				}
-			}
-		}
-		print $out;
-	}
-    } else {
-	for (1 .. $#outary) {
-		print $outary[$_];
-	}
-    }
-
-    print "<hr width=\"100%\">\n";
-    print "</blockquote>\n";
-    #print "<pre>".Dumper(\@questions,\@comments)."</pre>\n";
-    print "<center>".HTMLFooter();
-}
-
-sub print_test_chooser {
-	my @trecs = @_;
-	my ($testscompleted, $testsinprogress, $testspending, $href, $tstoption, $tstoptions);
-	my $js = "function setTest(oform,test) {\n\t".
-		"oform.tstid.value=test;\n\t".
-		"oform.submit();\n};\n";
-	for (0 .. $#trecs) {
-		my ($desc,$id) = split(/&/, $trecs[$_]);
-		$testscompleted = CountTestFiles($testcomplete,$CLIENT{'clid'},$id);
-		$testsinprogress = CountTestFiles($testinprog, $CLIENT{'clid'},$id);
-		$testspending = CountTestFiles($testpending, $CLIENT{'clid'},$id);
-		$href="javascript:setTest(document.testform1,\'$id\')\;";
-		$tstoption ="	<TR>
-		<TD valign=top><FONT SIZE=2><a href=\"$href\">$id</a></FONT></TD>
-		<TD valign=top><FONT SIZE=2>$desc</FONT></TD>
-		<TD align=right valign=top><FONT SIZE=2>$testscompleted</FONT></TD>
-		<TD align=right valign=top><FONT SIZE=2>$testsinprogress</FONT></TD>
-		<TD align=right valign=top><FONT SIZE=2>$testspending</FONT></TD>
-	</TR>\n";
-		$tstoptions = join('', $tstoptions, $tstoption); 
-	}
-	print HTMLHeader("Integro Learning Custom Reports", $js);
-	print "<CENTER><B>Please choose the survey for which you would like reports:</B><br>
-	<form name=\"testform1\" action=\"/cgi-bin/creports.pl\" method=\"Post\">
-	<input type=\"hidden\" name=\"tid\" value=\"$SESSION{'tid'}\">
-	<input type=\"hidden\" name=\"tstid\" value=\"\">
-	<input type=hidden name=\"rptno\" value=\"$FORM{'rptno'}\">
-	</form>
-<TABLE cellpadding=1 cellspacing=1 border=0 width=\"100\%\">
-	<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>
-	<TR>
-		<TD valign=top><B><FONT SIZE=1>Test ID</FONT></B></TD>
-		<TD valign=top><B><FONT SIZE=1>Description</FONT></B></TD>
-		<TD align=right valign=top><B><FONT SIZE=1>Cmp</FONT></B></TD>
-		<TD align=right valign=top><B><FONT SIZE=1>InP</FONT></B></TD>
-		<TD align=right valign=top><B><FONT SIZE=1>Pnd</FONT></B></TD>
-	</TR>
-	<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>
-	$tstoptions
-	<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>
-</TABLE>
-";
-	print HTMLFooter();
-	exit();
-}

survey-nginx/cgi-bin/LikertData.pl.bu20100506

@@ -1,449 +0,0 @@
-#!/usr/bin/perl
-
-# Source - LikertData.pl
-
-# Svn Keywords
-# $Date$
-# $Revision$
-# $Author$
-# $HeadURL$
-# $Id$
-
-use FileHandle;
-use Time::Local;
-use Data::Dumper;
-
-require 'questionslib.pl';
-require Exporter;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-@ISA = qw(Exporter);
-# Items to export into callers namespace by default. Note: do not export
-# names by default without a very good reason. Use EXPORT_OK instead.
-# Do not simply export all your public functions/methods/constants.
-@EXPORT = qw(GetLikertData);
-@EXPORT_OK = qw();
-$VERSION = '0.01';
-
-sub GetLikertData {
-# Parameters
-# $client - required String, client id.
-# $testid - required String, test id.
-# $idlist - optional Hash reference, keys are candidate ids, values are true for desired candidates.
-# Returned value.
-# $ret - reference to a Hash of a Hash.  The keys of the first hash are the supercategories
-#   of the likert questions in the test.  The keys of the second hash are 'PointsAvail', 
-#   'Responses', 'NoResponses', 'PointsEarned', and 'ScoreCount'.  The values of the first 
-#   four keys are numeric counts, or score totals.  The value of the 'ScoreCount' is 
-#   another hash.  Its keys are the scores, and the values are the counts of the number
-#   of times each score was a response.
-  my ($client, $testid, $idlist) = @_ ;
-	my $ret = {} ;
-	my %supercat_found = () ; # hash of categories found and initialized in the hash of hashes.
-	&get_test_profile($client, $testid) ; # Populates %TEST
-	my @filelist = &main::get_test_result_files($main::testcomplete, $client,$testid);
-	unless (defined $idlist) {
-		# warn "In GetLikertData and idlist is undefined." ;
-	}
-	foreach my $file (@filelist) {
-		my $user = $file;
-		$user =~ s/.$testid$//;  # Strip the test id off the end of the file name.
-		$user =~ s/^$client.//;  # Strip the client id off the start of the file name.
-		if (defined $idlist and %{$idlist} and  not $idlist->{$user}) {
-			# warn "Skipped completed test for $user ." ;
-			# warn "Reference " . ref $idlist . " value." ;
-      next;
-  	}
-		my $inact_ques = 0 ; # This is an offset for the inactive questions.
-		# The inactive questions are still listed, but without an answer.
-		# warn "Process completed test for $user ." ;
-		# Process this desired candidate's test answers.
-		&get_test_sequence_for_reports($client, $user, $testid) ;
-		# populates the Assoc. arrays %TEST_SESSION, %SUBTEST_QUESTIONS, 
-		#		%SUBTEST_ANSWERS, %SUBTEST_RESPONSES, and %SUBTEST_SUMMARY.
-  	my $QUESTIONS_AH = get_question_definitions ($CLIENT{'clid'}, $FORM{'tstid'});
-			# Populates an array of hashs that contains all of the questions and the answers.
-			#   $QUESTIONS_AH is a reference to the arrays of hashs.
-		my $last_index = $#{$QUESTIONS_AH} ; # Last index of the Array of Hashs of the Q&A.
-  	my $points, $weight, @scores, @correct_ans, @incorrect_ans, @all_ans ;
-  	my $ques_type, $supercat, $scores, @responses, $responses ;
-		$responses = $SUBTEST_RESPONSES{2} ;
-		# warn "user $user testid $testid resp $responses .\n" ;
-		@responses = split (/\&/, $responses) ;
-		shift @responses ; # Drop the empty element in front of the list.
-    foreach $index1 (0 .. $last_index) {
-			# Skip the question if it is inactive.
-			if (${$QUESTIONS_AH}[$index1]->{'qil'} eq "Y") {$inact_ques++ ; next ;}
-      # Get the data for a single question.
-      $points = ${$QUESTIONS_AH}[$index1]->{'pts'} ;
-      $weight = ${$QUESTIONS_AH}[$index1]->{'wght'} ;
-      $ques_type = ${$QUESTIONS_AH}[$index1]->{'qtp'} ;
-      $scores = ${$QUESTIONS_AH}[$index1]->{'scores'} ;
-			unless ($ques_type eq "lik") {next ;}
-      @scores = split (/\,/ , $scores) ;
-      $supercat = ${$QUESTIONS_AH}[$index1]->{'supercat'} ;
-			unless ($supercat_found{$supercat}) {
-				# Initialize counters.
-				$ret->{$supercat}->{'PointsAvail'} = 0 ;
-				$ret->{$supercat}->{'NoResponses'} = 0 ;
-				$ret->{$supercat}->{'Responses'} = 0 ;
-				$ret->{$supercat}->{'PointsEarned'} = 0 ;
-				$ret->{$supercat}->{'ScoreCount'} = {} ;
-				$supercat_found{$supercat} = 1 ;
-			}
-			$responses = $responses[$index1-$inact_ques] ;
-      @individ = split(/\?/, $responses) ;
-      shift @individ ;
-		  # warn "2user $user testid $testid resp $responses index1 $index1 prev $responses[$index1-1] next $responses[$index1+1] .\n" ;
-			my $no_response = 1 ;
-			$ret->{$supercat}->{'PointsAvail'} += $points ;
-			foreach $index2 (0 .. $#scores) {
-				# Add the key for the score count to the hash.
-				unless (exists $ret->{$supercat}->{'ScoreCount'}->{$scores[$index2]}) {
-					$ret->{$supercat}->{'ScoreCount'}->{$scores[$index2]} = 0 ;
-				}
-			}
-			foreach $index2 (0 .. $#scores) {
-				# warn "index2 $index2 individ $individ[$index2] .\n" ;
-				if ($individ[$index2] ne "xxx" and $individ[$index2] ne "" and $individ[$index2] == $index2) {
-					# Answered this question.
-					$ret->{$supercat}->{'PointsEarned'} += $scores[$index2] ;
-					$ret->{$supercat}->{'ScoreCount'}->{$scores[$index2]} ++ ;
-					# warn "Likert Answer supercat $supercat index2 $index2 scores $scores[$index2] \n" ;
-					$no_response = 0 ;
-				} # If answered.
-			} # foreach $index2
-			if ($no_response) {
-				# Add to the no response count.
-				$ret->{$supercat}->{'NoResponses'} ++ ;
-				# warn "Likert Answer supercat $supercat No Response \n" ;
-			} else {
-				# Add to the response count.
-				$ret->{$supercat}->{'Responses'} ++ ;
-				# warn "Likert Answer supercat $supercat Response \n" ;
-			}
-		} # foreach question.
-	} # foreach file (i.e. candidate)
-	$ret ; # Return reference.
-} # End of GetLikertData
-
-sub GetLikertGrpData {
-# Parameters
-# $client - required String, client id.
-# $testid - required String, test id.
-# $idlist - required Hash reference, keys are candidate ids, values are group id for desired candidates.
-# Returned values - $ret_all, $ret_grp
-# $ret_all - reference to a Hash of a Hash.  The keys of the first hash are the supercategories
-#   of the likert questions in the test.  The keys of the second hash are 'PointsAvail', 
-#   'Responses', 'NoResponses', 'PointsEarned', and 'ScoreCount'.  The values of the first 
-#   four keys are numeric counts, or score totals.  The value of the 'ScoreCount' is 
-#   another hash.  Its keys are the scores, and the values are the counts of the number
-#   of times each score was a response.  Values for candidates will be counted here regardless of 
-#   group membership.
-# $ret_grp - reference to a Hash of a Hash of a Hash.  The keys of the first hash are
-#   the group ids.  The values are structured like $ret_all.
-  my ($client, $testid, $idlist) = @_ ;
-	my $ret_all = {} ; my $ret_grp = {} ;
-	my %supercat_found = () ; # hash of categories found and initialized in the hash of hashes.
-	my $inact_ques = 0; # Count of the inactive questions found.
-	&get_test_profile($client, $testid) ; # Populates %TEST
-	my @filelist = &main::get_test_result_files($main::testcomplete, $client,$testid);
-	unless (defined $idlist ) {
-		warn "In GetLikertData and idlist is undefined." ;
-	}
-	foreach my $file (@filelist) {
-		my $user = $file;
-		$user =~ s/.$testid$//;  # Strip the test id off the end of the file name.
-		$user =~ s/^$client.//;  # Strip the client id off the start of the file name.
-		my $user_grp = undef ;
-		# Process this desired candidate's test answers.
-		&get_test_sequence_for_reports($client, $user, $testid) ;
-		# populates the Assoc. arrays %TEST_SESSION, %SUBTEST_QUESTIONS, 
-		#		%SUBTEST_ANSWERS, %SUBTEST_RESPONSES, and %SUBTEST_SUMMARY.
-  	my $QUESTIONS_AH = get_question_definitions ($CLIENT{'clid'}, $FORM{'tstid'});
-			# Populates an array of hashs that contains all of the questions and the answers.
-			#   $QUESTIONS_AH is a reference to the arrays of hashs.
-		my $last_index = $#{$QUESTIONS_AH} ; # Last index of the Array of Hashs of the Q&A.
-  	my $points, $weight, @scores, @correct_ans, @incorrect_ans, @all_ans ;
-  	my $ques_type, $supercat, $scores, @responses, $responses ;
-		$responses = $SUBTEST_RESPONSES{2} ;
-		@responses = split (/\&/, $responses) ;
-		shift @responses ; # Drop the empty element in front of the list.
-    foreach $index1 (0 .. $last_index) {
-			# Skip the question if it is inactive.
-			if (${$QUESTIONS_AH}[$index1]->{'qil'} eq "Y") {$inact_ques++ ; next ;}
-      # Get the data for a single question.
-      $points = ${$QUESTIONS_AH}[$index1]->{'pts'} ;
-      $weight = ${$QUESTIONS_AH}[$index1]->{'wght'} ;
-      $ques_type = ${$QUESTIONS_AH}[$index1]->{'qtp'} ;
-      $scores = ${$QUESTIONS_AH}[$index1]->{'scores'} ;
-			unless ($ques_type eq "lik") {next ;}
-      @scores = split (/\,/ , $scores) ;
-      $supercat = ${$QUESTIONS_AH}[$index1]->{'supercat'} ;
-			unless ($supercat_found{$supercat}) {
-				# Initialize counters.
-				# warn "Init all Cat $supercat" if $supercat eq "Employee Passion" ;
-				$ret->{$supercat}->{'PointsAvail'} = 0 ;
-				$ret->{$supercat}->{'NoResponses'} = 0 ;
-				$ret->{$supercat}->{'Responses'} = 0 ;
-				$ret->{$supercat}->{'PointsEarned'} = 0 ;
-				$ret->{$supercat}->{'ScoreCount'} = {} ;
-				$supercat_found{$supercat} = 1 ;
-			}
-		  if (defined $idlist and %{$idlist} and $idlist->{$user}) {
-        unless (defined $ret_grp->{$idlist->{$user}}->{$supercat}) {
-					# warn "Init grp Cat $supercat user $user Grp $idlist->{$user}" if $supercat eq "Employee Passion" ;
-					$ret_grp->{$idlist->{$user}}->{$supercat}->{'PointsAvail'} = 0 ;
-					$ret_grp->{$idlist->{$user}}->{$supercat}->{'NoResponses'} = 0 ;
-					$ret_grp->{$idlist->{$user}}->{$supercat}->{'Responses'} = 0 ;
-					$ret_grp->{$idlist->{$user}}->{$supercat}->{'PointsEarned'} = 0 ;
-					$ret_grp->{$idlist->{$user}}->{$supercat}->{'ScoreCount'} = {} ;
-				}
-			}
-			$responses = $responses[$index1-$inact_ques] ;
-      @individ = split(/\?/, $responses) ;
-      shift @individ ;
-			my $no_response = 1 ;
-			$ret->{$supercat}->{'PointsAvail'} += $points ;
-			$ret_grp->{$idlist->{$user}}->{$supercat}->{'PointsAvail'} += $points ;
-			# warn "ADD USER $user GRP $idlist->{$user} PNTS $points TOT $ret_grp->{$idlist->{$user}}->{$supercat}->{'PointsAvail'}" if $supercat eq "Employee Passion" ;
-			foreach $index2 (0 .. $#scores) {
-				# Add the key for the score count to the hash.
-				unless (exists $ret->{$supercat}->{'ScoreCount'}->{$scores[$index2]}) {
-					$ret->{$supercat}->{'ScoreCount'}->{$scores[$index2]} = 0 ;
-				}
-				unless (exists $ret_grp->{$idlist->{$user}}->{$supercat}->{'ScoreCount'}->{$scores[$index2]}) {
-					$ret_grp->{$idlist->{$user}}->{$supercat}->{'ScoreCount'}->{$scores[$index2]} = 0 ;
-				}
-			}
-			# warn "CHECKING CAT $supercat USER $user GRP $idlist->{$user}" if $supercat eq "Employee Passion" ;
-			foreach $index2 (0 .. $#scores) {
-				if ($individ[$index2] ne "xxx" and $individ[$index2] ne "" and $individ[$index2] == $index2) {
-					# Answered this question.
-					# warn "Scored CAT $supercat POINTS $scores[$index2] USER $user GRP $idlist->{$user}" if $supercat eq "Employee Passion" ;
-					$ret->{$supercat}->{'PointsEarned'} += $scores[$index2] ;
-					$ret->{$supercat}->{'ScoreCount'}->{$scores[$index2]} ++ ;
-					$ret_grp->{$idlist->{$user}}->{$supercat}->{'PointsEarned'} += $scores[$index2] ;
-					$ret_grp->{$idlist->{$user}}->{$supercat}->{'ScoreCount'}->{$scores[$index2]} ++ ;
-					$no_response = 0 ;
-				} # If answered.
-			} # foreach $index2
-			if ($no_response) {
-				# Add to the no response count.
-				$ret->{$supercat}->{'NoResponses'} ++ ;
-				$ret_grp->{$idlist->{$user}}->{$supercat}->{'NoResponses'} ++ ;
-			} else {
-				# Add to the response count.
-				$ret->{$supercat}->{'Responses'} ++ ;
-				$ret_grp->{$idlist->{$user}}->{$supercat}->{'Responses'} ++ ;
-			}
-		} # foreach question.
-	} # foreach file (i.e. candidate)
-	return ($ret, $ret_grp) ; # Return reference.
-} # End of GetLikertGrpData
-
-sub GetFullLikertGrpData {
-# Parameters
-# $client - required String, client id.
-# $testid - required String, test id.
-# $grplist - optional Hash reference, keys are group ids, values are like getGroups function.
-#            if undef. then only one returned value.
-# $grp_req - optional boolean, default is false. If true, then $ret_all only includes results 
-#            for users in the $grplist, and $grplist must be provided to get any results.
-
-# Returned values - $ret_all, $ret_grp
-# $ret_all - reference to a Hash of a Hash.  The keys of the first hash are the supercategories
-#   of the likert questions in the test.  The keys of the second hash are 'PointsAvail', 
-#   'Responses', 'NoResponses', 'PointsEarned', 'ScoreCount', and 'Questions'.  The values of the first 
-#   four keys are numeric counts, or score totals.  The value of the 'ScoreCount' is 
-#   another hash.  Its keys are the scores, and the values are the counts of the number
-#   of times each score was a response.  Values for candidates will be counted here regardless of 
-#   group membership.  The value of 'Questions' is an un-named hash.  The keys of the un-named 
-#   hash are the question numbers for the supercategory.  The value is always 1.
-# $ret_grp - reference to a Hash of a Hash of a Hash.  The keys of the first hash are
-#   the group ids.  The values are structured like $ret_all.  This is not returned if
-#   the parameter $grplist is not provided, or undef.
-
-  my ($client, $testid, $grplist,$grp_req) = @_ ;
-	# warn "grplist" ;
-	# warn &Dumper(\$grplist) ;
-  # warn "grp_req $grp_req X\n" ;
-	my $ret_all = {} ; my $ret_grp = {} ;
-	my %Group_Xref = () ; # List of groups that each member belongs to.
-		# The hash key is a member id, the value is an array of the groups he is in.
-		# Build the cross reference.
-	my $Group = "" ; my $Member = "" ;
-	foreach $Group (keys %{${grplist}}) {
-		foreach $Member (@{${grplist}->{$Group}->{'grplist'}}) {
-			push @{$Group_Xref->{$Member}} , $Group ;
-		}
-	}
-	# warn Dumper(\%Group_Xref) ;
-	my %supercat_found = () ; # hash of categories found and initialized in the hash of hashes.
-	&get_test_profile($client, $testid) ; # Populates %TEST
-  my $QUESTIONS_AH = get_question_definitions ($CLIENT{'clid'}, $FORM{'tstid'});
-	# Populates an array of hashs that contains all of the questions and the answers.
-	#   $QUESTIONS_AH is a reference to the arrays of hashs.
-	my $last_index = $#{$QUESTIONS_AH} ; # Last index of the Array of Hashs of the Q&A.
-	my @filelist = &main::get_test_result_files($main::testcomplete, $client,$testid);
-	foreach my $file (@filelist) {
-		my $user = $file;
-		$user =~ s/.$testid$//;  # Strip the test id off the end of the file name.
-		$user =~ s/^$client.//;  # Strip the client id off the start of the file name.
-		my $user_grp = undef ;
-		my $inact_ques = 0; # Count of the inactive questions found.
-		# Do not process this user if group membership is required and not a member.
-		if ($grp_req and not $Group_Xref->{$user}) { 
-			# warn "Skipped User $user X" ;
-			next ; 
-		}
-		# Process this desired candidate's test answers.
-		# warn "Process User $user X" ;
-		&get_test_sequence_for_reports($client, $user, $testid) ;
-		# populates the Assoc. arrays %TEST_SESSION, %SUBTEST_QUESTIONS, 
-		#		%SUBTEST_ANSWERS, %SUBTEST_RESPONSES, and %SUBTEST_SUMMARY.
-  	my $points, $weight, @scores, @correct_ans, @incorrect_ans, @all_ans ;
-  	my $ques_type, $supercat, $scores, @responses, $responses ;
-		$responses = $SUBTEST_RESPONSES{2} ;
-		@responses = split (/\&/, $responses) ;
-		shift @responses ; # Drop the empty element in front of the list.
-    foreach $index1 (0 .. $last_index) {
-			# Skip the question if it is inactive.
-			if (${$QUESTIONS_AH}[$index1]->{'qil'} eq "Y") {$inact_ques++ ; next ;}
-      # Get the data for a single question.
-      $points = ${$QUESTIONS_AH}[$index1]->{'pts'} ;
-      $weight = ${$QUESTIONS_AH}[$index1]->{'wght'} ;
-      $ques_type = ${$QUESTIONS_AH}[$index1]->{'qtp'} ;
-      $scores = ${$QUESTIONS_AH}[$index1]->{'scores'} ;
-			unless ($ques_type eq "lik") {next ;}
-      @scores = split (/\,/ , $scores) ;
-      $supercat = ${$QUESTIONS_AH}[$index1]->{'supercat'} ;
-			unless ($supercat_found{$supercat}) {
-				# Initialize counters.
-				# warn "Init all Cat $supercat" if $supercat eq "Employee Passion" ;
-				$ret->{$supercat}->{'PointsAvail'} = 0 ;
-				$ret->{$supercat}->{'NoResponses'} = 0 ;
-				$ret->{$supercat}->{'Responses'} = 0 ;
-				$ret->{$supercat}->{'PointsEarned'} = 0 ;
-				$ret->{$supercat}->{'ScoreCount'} = {} ;
-				$ret->{$supercat}->{'Questions'}->{$index1-$inact_ques} = 1 ;
-				$supercat_found{$supercat} = 1 ;
-			}
-			my @Groups = @{$Group_Xref->{$user}} ;
-			foreach $group (@Groups) {
-       	unless (defined $ret_grp->{$group}->{$supercat}) {
-					# warn "Init all Cat $supercat Group $group.\n" if $supercat eq "Improvement" ;
-					$ret_grp->{$group}->{$supercat}->{'PointsAvail'} = 0 ;
-					$ret_grp->{$group}->{$supercat}->{'NoResponses'} = 0 ;
-					$ret_grp->{$group}->{$supercat}->{'Responses'} = 0 ;
-					$ret_grp->{$group}->{$supercat}->{'PointsEarned'} = 0 ;
-					$ret_grp->{$group}->{$supercat}->{'ScoreCount'} = {} ;
-				}
-			} # foreach $group
-			$responses = $responses[$index1-$inact_ques] ;
-      @individ = split(/\?/, $responses) ;
-      shift @individ ;
-			my $no_response = 1 ;
-			$ret->{$supercat}->{'PointsAvail'} += $points ;
-			foreach $group (@Groups) {
-				$ret_grp->{$group}->{$supercat}->{'PointsAvail'} += $points ;
-			}
-			foreach $index2 (0 .. $#scores) {
-				# Add the key for the score count to the hash.
-				unless (exists $ret->{$supercat}->{'ScoreCount'}->{$scores[$index2]}) {
-					$ret->{$supercat}->{'ScoreCount'}->{$scores[$index2]} = 0 ;
-				}
-				unless (exists $ret_grp->{$group}->{$supercat}->{'ScoreCount'}->{$scores[$index2]}) {
-					$ret_grp->{$group}->{$supercat}->{'ScoreCount'}->{$scores[$index2]} = 0 ;
-				}
-			}
-			# warn "CHECKING CAT $supercat USER $user GRP @group RESP $responses \n" if $supercat eq "Improvement" ;
-			foreach $index2 (0 .. $#scores) {
-				if ($individ[$index2] ne "xxx" and $individ[$index2] ne "" and $individ[$index2] == $index2) {
-					# Answered this question.
-					# warn "Scored CAT $supercat POINTS $scores[$index2] USER $user GRP @group \n" if $supercat eq "Improvement" ;
-					$ret->{$supercat}->{'PointsEarned'} += $scores[$index2] ;
-					$ret->{$supercat}->{'ScoreCount'}->{$scores[$index2]} ++ ;
-					foreach $group (@Groups) {
-						$ret_grp->{$group}->{$supercat}->{'PointsEarned'} += $scores[$index2] ;
-						$ret_grp->{$group}->{$supercat}->{'ScoreCount'}->{$scores[$index2]} ++ ;
-					}
-					$no_response = 0 ;
-				} # If answered.
-			} # foreach $index2
-			if ($no_response) {
-				# Add to the no response count.
-				$ret->{$supercat}->{'NoResponses'} ++ ;
-				foreach $group (@Groups) {
-					$ret_grp->{$group}->{$supercat}->{'NoResponses'} ++ ;
-				}
-			} else {
-				# Add to the response count.
-				$ret->{$supercat}->{'Responses'} ++ ;
-				foreach $group (@Groups) {
-					$ret_grp->{$group}->{$supercat}->{'Responses'} ++ ;
-				}
-			}
-		} # foreach question.
-	} # foreach file (i.e. candidate)
-	return ($ret, $ret_grp) ; # Return reference.
-} # End of GetFullLikertGrpData
-
-sub BuildBarGraph {
-# This subroutine builds the HTML to get an image from an URL.
-# The URL is a cgi-bin PERL script, with several parameters.
-# The list parameters are: labels, values, and values2.
-# The scalar parameters are: xdim, ydim, hbar, title, xlabel, ylabel, ymax, ymin, yticknum, colorscheme, $t_margin, $b_margin, $l_margin, $r_margin
-
-# The first 3 parameters are references to three lists, which are mandatory.
-#   The values2 list may be an empty list. (and ignored.)
-# The rest of the parameters are optional, but are order specific.
-# Any parameter that is an empty string will be effectively ignored,
-# but may be required to fill the list of parameters to a needed parm.
-    my @label_names, @value_points, @value2_points ;
-    my $labels_ref, $values_ref, $values2_ref ;
-		my $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum ;
-		my $colorscheme ;
-    my $t_margin, $b_margin, $l_margin, $r_margin ;
-    $labels_ref = $_[0] ;
-    @label_names = @{$labels_ref} ;
-# @label_names is an array of character strings of the names of the bars on the graph.
-		$values_ref = $_[1] ;
-		@value_points = @{$values_ref} ;
-# @value_points is an array of numeric values for each of the names in the first array.
-#    The sizes of the two arrays should be the same.
-		$values2_ref = $_[2] ;
-		@value2_points = @{$values2_ref} ;
-    shift ; shift ; shift ; # Remove the first 3 parms, to set up the next statement.
-		($xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, $colorscheme, $t_margin, $b_margin, $l_margin, $r_margin) = @_ ;
-		my $labels, $values, $values2 ;
-		# print '<br> label_names ' . "@label_names" . ' <br>' ;
-		# print '<br> value_points ' . "@value_points" . ' <br>' ;
-		if ($#label_names != $#value_points) {
-			print '<br>ERROR BuildBarGraph has different number of labels and data values.<br>' ;
-		}
-		$labels = join (":", map {munge($_)} @label_names ) ;
-		$values = join (":", map {munge($_)} @value_points ) ;
-		$values2 = join (":", map {munge($_)} @value2_points ) ;
-    # my $baseurl = "/cgi-bin/bargraph.pl?labels=$labels&title=Trust%20Level&ylabel=Respondents";
-    my $baseurl = "/cgi-bin/bargraph.pl?labels=$labels&values=$values" ;
-    if ($xdim or $xdim == 0) { $baseurl .= "&xdim=" . $xdim ; }
-    if ($ydim or $ydim == 0) { $baseurl .= "&ydim=" . $ydim ; }
-    if ($hbar or $hbar == 0) { $baseurl .= "&hbar=" . $hbar ; }
-    if ($title or $title == 0) { $baseurl .= "&title=" . munge( $title) ; }
-    if ($xlabel or $xlabel == 0) { $baseurl .= "&xlabel=" . munge( $xlabel) ; }
-    if ($ylabel or $ylabel == 0) { $baseurl .= "&ylabel=" . munge( $ylabel) ; }
-    if ($ymax or $ymax == 0) { $baseurl .= "&ymax=" . $ymax ; }
-    if ($ymin or $ymin == 0) { $baseurl .= "&ymin=" . $ymin ; }
-    if ($t_margin or $t_margin == 0) { $baseurl .= "&t_margin=" . $t_margin ; }
-    if ($b_margin or $b_margin == 0) { $baseurl .= "&b_margin=" . $b_margin ; }
-    if ($l_margin or $l_margin == 0) { $baseurl .= "&l_margin=" . $l_margin ; }
-    if ($r_margin or $r_margin == 0) { $baseurl .= "&r_margin=" . $r_margin ; }
-		if ($colorscheme) { $baseurl .= "&colorscheme=" . $colorscheme ; }
-    if ($yticknum or $yticknum == 0) { $baseurl .= "&yticknum=" . $yticknum ; }
-	  return  "<img src=\"$baseurl&values2=$values2\">";
-}
-
-
-
-1 ; # End of Perl Library file
-

survey-nginx/cgi-bin/LikertData.pl.bu20131217

@@ -1,449 +0,0 @@
-#!/usr/bin/perl
-
-# Source - LikertData.pl
-
-# Svn Keywords
-# $Date$
-# $Revision$
-# $Author$
-# $HeadURL$
-# $Id$
-
-use FileHandle;
-use Time::Local;
-use Data::Dumper;
-
-require 'questionslib.pl';
-require Exporter;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-@ISA = qw(Exporter);
-# Items to export into callers namespace by default. Note: do not export
-# names by default without a very good reason. Use EXPORT_OK instead.
-# Do not simply export all your public functions/methods/constants.
-@EXPORT = qw(GetLikertData);
-@EXPORT_OK = qw();
-$VERSION = '0.01';
-
-sub GetLikertData {
-# Parameters
-# $client - required String, client id.
-# $testid - required String, test id.
-# $idlist - optional Hash reference, keys are candidate ids, values are true for desired candidates.
-# Returned value.
-# $ret - reference to a Hash of a Hash.  The keys of the first hash are the supercategories
-#   of the likert questions in the test.  The keys of the second hash are 'PointsAvail', 
-#   'Responses', 'NoResponses', 'PointsEarned', and 'ScoreCount'.  The values of the first 
-#   four keys are numeric counts, or score totals.  The value of the 'ScoreCount' is 
-#   another hash.  Its keys are the scores, and the values are the counts of the number
-#   of times each score was a response.
-  my ($client, $testid, $idlist) = @_ ;
-	my $ret = {} ;
-	my %supercat_found = () ; # hash of categories found and initialized in the hash of hashes.
-	&get_test_profile($client, $testid) ; # Populates %TEST
-	my @filelist = &main::get_test_result_files($main::testcomplete, $client,$testid);
-	unless (defined $idlist) {
-		# warn "In GetLikertData and idlist is undefined." ;
-	}
-	foreach my $file (@filelist) {
-		my $user = $file;
-		$user =~ s/.$testid$//;  # Strip the test id off the end of the file name.
-		$user =~ s/^$client.//;  # Strip the client id off the start of the file name.
-		if (defined $idlist and %{$idlist} and  not $idlist->{$user}) {
-			# warn "Skipped completed test for $user ." ;
-			# warn "Reference " . ref $idlist . " value." ;
-      next;
-  	}
-		my $inact_ques = 0 ; # This is an offset for the inactive questions.
-		# The inactive questions are still listed, but without an answer.
-		# warn "Process completed test for $user ." ;
-		# Process this desired candidate's test answers.
-		&get_test_sequence_for_reports($client, $user, $testid) ;
-		# populates the Assoc. arrays %TEST_SESSION, %SUBTEST_QUESTIONS, 
-		#		%SUBTEST_ANSWERS, %SUBTEST_RESPONSES, and %SUBTEST_SUMMARY.
-  	my $QUESTIONS_AH = get_question_definitions ($CLIENT{'clid'}, $FORM{'tstid'});
-			# Populates an array of hashs that contains all of the questions and the answers.
-			#   $QUESTIONS_AH is a reference to the arrays of hashs.
-		my $last_index = $#{$QUESTIONS_AH} ; # Last index of the Array of Hashs of the Q&A.
-  	my $points, $weight, @scores, @correct_ans, @incorrect_ans, @all_ans ;
-  	my $ques_type, $supercat, $scores, @responses, $responses ;
-		$responses = $SUBTEST_RESPONSES{2} ;
-		# warn "user $user testid $testid resp $responses .\n" ;
-		@responses = split (/\&/, $responses) ;
-		shift @responses ; # Drop the empty element in front of the list.
-    foreach $index1 (0 .. $last_index) {
-			# Skip the question if it is inactive.
-			if (${$QUESTIONS_AH}[$index1]->{'qil'} eq "Y") {$inact_ques++ ; next ;}
-      # Get the data for a single question.
-      $points = ${$QUESTIONS_AH}[$index1]->{'pts'} ;
-      $weight = ${$QUESTIONS_AH}[$index1]->{'wght'} ;
-      $ques_type = ${$QUESTIONS_AH}[$index1]->{'qtp'} ;
-      $scores = ${$QUESTIONS_AH}[$index1]->{'scores'} ;
-			unless ($ques_type eq "lik") {next ;}
-      @scores = split (/\,/ , $scores) ;
-      $supercat = ${$QUESTIONS_AH}[$index1]->{'supercat'} ;
-			unless ($supercat_found{$supercat}) {
-				# Initialize counters.
-				$ret->{$supercat}->{'PointsAvail'} = 0 ;
-				$ret->{$supercat}->{'NoResponses'} = 0 ;
-				$ret->{$supercat}->{'Responses'} = 0 ;
-				$ret->{$supercat}->{'PointsEarned'} = 0 ;
-				$ret->{$supercat}->{'ScoreCount'} = {} ;
-				$supercat_found{$supercat} = 1 ;
-			}
-			$responses = $responses[$index1-$inact_ques] ;
-      @individ = split(/\?/, $responses) ;
-      shift @individ ;
-		  # warn "2user $user testid $testid resp $responses index1 $index1 prev $responses[$index1-1] next $responses[$index1+1] .\n" ;
-			my $no_response = 1 ;
-			$ret->{$supercat}->{'PointsAvail'} += $points ;
-			foreach $index2 (0 .. $#scores) {
-				# Add the key for the score count to the hash.
-				unless (exists $ret->{$supercat}->{'ScoreCount'}->{$scores[$index2]}) {
-					$ret->{$supercat}->{'ScoreCount'}->{$scores[$index2]} = 0 ;
-				}
-			}
-			foreach $index2 (0 .. $#scores) {
-				# warn "index2 $index2 individ $individ[$index2] .\n" ;
-				if ($individ[$index2] ne "xxx" and $individ[$index2] ne "" and $individ[$index2] == $index2) {
-					# Answered this question.
-					$ret->{$supercat}->{'PointsEarned'} += $scores[$index2] ;
-					$ret->{$supercat}->{'ScoreCount'}->{$scores[$index2]} ++ ;
-					# warn "Likert Answer supercat $supercat index2 $index2 scores $scores[$index2] \n" ;
-					$no_response = 0 ;
-				} # If answered.
-			} # foreach $index2
-			if ($no_response) {
-				# Add to the no response count.
-				$ret->{$supercat}->{'NoResponses'} ++ ;
-				# warn "Likert Answer supercat $supercat No Response \n" ;
-			} else {
-				# Add to the response count.
-				$ret->{$supercat}->{'Responses'} ++ ;
-				# warn "Likert Answer supercat $supercat Response \n" ;
-			}
-		} # foreach question.
-	} # foreach file (i.e. candidate)
-	$ret ; # Return reference.
-} # End of GetLikertData
-
-sub GetLikertGrpData {
-# Parameters
-# $client - required String, client id.
-# $testid - required String, test id.
-# $idlist - required Hash reference, keys are candidate ids, values are group id for desired candidates.
-# Returned values - $ret_all, $ret_grp
-# $ret_all - reference to a Hash of a Hash.  The keys of the first hash are the supercategories
-#   of the likert questions in the test.  The keys of the second hash are 'PointsAvail', 
-#   'Responses', 'NoResponses', 'PointsEarned', and 'ScoreCount'.  The values of the first 
-#   four keys are numeric counts, or score totals.  The value of the 'ScoreCount' is 
-#   another hash.  Its keys are the scores, and the values are the counts of the number
-#   of times each score was a response.  Values for candidates will be counted here regardless of 
-#   group membership.
-# $ret_grp - reference to a Hash of a Hash of a Hash.  The keys of the first hash are
-#   the group ids.  The values are structured like $ret_all.
-  my ($client, $testid, $idlist) = @_ ;
-	my $ret_all = {} ; my $ret_grp = {} ;
-	my %supercat_found = () ; # hash of categories found and initialized in the hash of hashes.
-	my $inact_ques = 0; # Count of the inactive questions found.
-	&get_test_profile($client, $testid) ; # Populates %TEST
-	my @filelist = &main::get_test_result_files($main::testcomplete, $client,$testid);
-	unless (defined $idlist ) {
-		warn "In GetLikertData and idlist is undefined." ;
-	}
-	foreach my $file (@filelist) {
-		my $user = $file;
-		$user =~ s/.$testid$//;  # Strip the test id off the end of the file name.
-		$user =~ s/^$client.//;  # Strip the client id off the start of the file name.
-		my $user_grp = undef ;
-		# Process this desired candidate's test answers.
-		&get_test_sequence_for_reports($client, $user, $testid) ;
-		# populates the Assoc. arrays %TEST_SESSION, %SUBTEST_QUESTIONS, 
-		#		%SUBTEST_ANSWERS, %SUBTEST_RESPONSES, and %SUBTEST_SUMMARY.
-  	my $QUESTIONS_AH = get_question_definitions ($CLIENT{'clid'}, $FORM{'tstid'});
-			# Populates an array of hashs that contains all of the questions and the answers.
-			#   $QUESTIONS_AH is a reference to the arrays of hashs.
-		my $last_index = $#{$QUESTIONS_AH} ; # Last index of the Array of Hashs of the Q&A.
-  	my $points, $weight, @scores, @correct_ans, @incorrect_ans, @all_ans ;
-  	my $ques_type, $supercat, $scores, @responses, $responses ;
-		$responses = $SUBTEST_RESPONSES{2} ;
-		@responses = split (/\&/, $responses) ;
-		shift @responses ; # Drop the empty element in front of the list.
-    foreach $index1 (0 .. $last_index) {
-			# Skip the question if it is inactive.
-			if (${$QUESTIONS_AH}[$index1]->{'qil'} eq "Y") {$inact_ques++ ; next ;}
-      # Get the data for a single question.
-      $points = ${$QUESTIONS_AH}[$index1]->{'pts'} ;
-      $weight = ${$QUESTIONS_AH}[$index1]->{'wght'} ;
-      $ques_type = ${$QUESTIONS_AH}[$index1]->{'qtp'} ;
-      $scores = ${$QUESTIONS_AH}[$index1]->{'scores'} ;
-			unless ($ques_type eq "lik") {next ;}
-      @scores = split (/\,/ , $scores) ;
-      $supercat = ${$QUESTIONS_AH}[$index1]->{'supercat'} ;
-			unless ($supercat_found{$supercat}) {
-				# Initialize counters.
-				# warn "Init all Cat $supercat" if $supercat eq "Employee Passion" ;
-				$ret->{$supercat}->{'PointsAvail'} = 0 ;
-				$ret->{$supercat}->{'NoResponses'} = 0 ;
-				$ret->{$supercat}->{'Responses'} = 0 ;
-				$ret->{$supercat}->{'PointsEarned'} = 0 ;
-				$ret->{$supercat}->{'ScoreCount'} = {} ;
-				$supercat_found{$supercat} = 1 ;
-			}
-		  if (defined $idlist and %{$idlist} and $idlist->{$user}) {
-        unless (defined $ret_grp->{$idlist->{$user}}->{$supercat}) {
-					# warn "Init grp Cat $supercat user $user Grp $idlist->{$user}" if $supercat eq "Employee Passion" ;
-					$ret_grp->{$idlist->{$user}}->{$supercat}->{'PointsAvail'} = 0 ;
-					$ret_grp->{$idlist->{$user}}->{$supercat}->{'NoResponses'} = 0 ;
-					$ret_grp->{$idlist->{$user}}->{$supercat}->{'Responses'} = 0 ;
-					$ret_grp->{$idlist->{$user}}->{$supercat}->{'PointsEarned'} = 0 ;
-					$ret_grp->{$idlist->{$user}}->{$supercat}->{'ScoreCount'} = {} ;
-				}
-			}
-			$responses = $responses[$index1-$inact_ques] ;
-      @individ = split(/\?/, $responses) ;
-      shift @individ ;
-			my $no_response = 1 ;
-			$ret->{$supercat}->{'PointsAvail'} += $points ;
-			$ret_grp->{$idlist->{$user}}->{$supercat}->{'PointsAvail'} += $points ;
-			# warn "ADD USER $user GRP $idlist->{$user} PNTS $points TOT $ret_grp->{$idlist->{$user}}->{$supercat}->{'PointsAvail'}" if $supercat eq "Employee Passion" ;
-			foreach $index2 (0 .. $#scores) {
-				# Add the key for the score count to the hash.
-				unless (exists $ret->{$supercat}->{'ScoreCount'}->{$scores[$index2]}) {
-					$ret->{$supercat}->{'ScoreCount'}->{$scores[$index2]} = 0 ;
-				}
-				unless (exists $ret_grp->{$idlist->{$user}}->{$supercat}->{'ScoreCount'}->{$scores[$index2]}) {
-					$ret_grp->{$idlist->{$user}}->{$supercat}->{'ScoreCount'}->{$scores[$index2]} = 0 ;
-				}
-			}
-			# warn "CHECKING CAT $supercat USER $user GRP $idlist->{$user}" if $supercat eq "Employee Passion" ;
-			foreach $index2 (0 .. $#scores) {
-				if ($individ[$index2] ne "xxx" and $individ[$index2] ne "" and $individ[$index2] == $index2) {
-					# Answered this question.
-					# warn "Scored CAT $supercat POINTS $scores[$index2] USER $user GRP $idlist->{$user}" if $supercat eq "Employee Passion" ;
-					$ret->{$supercat}->{'PointsEarned'} += $scores[$index2] ;
-					$ret->{$supercat}->{'ScoreCount'}->{$scores[$index2]} ++ ;
-					$ret_grp->{$idlist->{$user}}->{$supercat}->{'PointsEarned'} += $scores[$index2] ;
-					$ret_grp->{$idlist->{$user}}->{$supercat}->{'ScoreCount'}->{$scores[$index2]} ++ ;
-					$no_response = 0 ;
-				} # If answered.
-			} # foreach $index2
-			if ($no_response) {
-				# Add to the no response count.
-				$ret->{$supercat}->{'NoResponses'} ++ ;
-				$ret_grp->{$idlist->{$user}}->{$supercat}->{'NoResponses'} ++ ;
-			} else {
-				# Add to the response count.
-				$ret->{$supercat}->{'Responses'} ++ ;
-				$ret_grp->{$idlist->{$user}}->{$supercat}->{'Responses'} ++ ;
-			}
-		} # foreach question.
-	} # foreach file (i.e. candidate)
-	return ($ret, $ret_grp) ; # Return reference.
-} # End of GetLikertGrpData
-
-sub GetFullLikertGrpData {
-# Parameters
-# $client - required String, client id.
-# $testid - required String, test id.
-# $grplist - optional Hash reference, keys are group ids, values are like getGroups function.
-#            if undef. then only one returned value.
-# $grp_req - optional boolean, default is false. If true, then $ret_all only includes results 
-#            for users in the $grplist, and $grplist must be provided to get any results.
-
-# Returned values - $ret_all, $ret_grp
-# $ret_all - reference to a Hash of a Hash.  The keys of the first hash are the supercategories
-#   of the likert questions in the test.  The keys of the second hash are 'PointsAvail', 
-#   'Responses', 'NoResponses', 'PointsEarned', 'ScoreCount', and 'Questions'.  The values of the first 
-#   four keys are numeric counts, or score totals.  The value of the 'ScoreCount' is 
-#   another hash.  Its keys are the scores, and the values are the counts of the number
-#   of times each score was a response.  Values for candidates will be counted here regardless of 
-#   group membership.  The value of 'Questions' is an un-named hash.  The keys of the un-named 
-#   hash are the question numbers for the supercategory.  The value is always 1.
-# $ret_grp - reference to a Hash of a Hash of a Hash.  The keys of the first hash are
-#   the group ids.  The values are structured like $ret_all.  This is not returned if
-#   the parameter $grplist is not provided, or undef.
-
-  my ($client, $testid, $grplist,$grp_req) = @_ ;
-	# warn "grplist" ;
-	# warn &Dumper(\$grplist) ;
-  # warn "grp_req $grp_req X\n" ;
-	my $ret_all = {} ; my $ret_grp = {} ;
-	my %Group_Xref = () ; # List of groups that each member belongs to.
-		# The hash key is a member id, the value is an array of the groups he is in.
-		# Build the cross reference.
-	my $Group = "" ; my $Member = "" ;
-	foreach $Group (keys %{${grplist}}) {
-		foreach $Member (@{${grplist}->{$Group}->{'grplist'}}) {
-			push @{$Group_Xref->{$Member}} , $Group ;
-		}
-	}
-	# warn Dumper(\%Group_Xref) ;
-	my %supercat_found = () ; # hash of categories found and initialized in the hash of hashes.
-	&get_test_profile($client, $testid) ; # Populates %TEST
-  my $QUESTIONS_AH = get_question_definitions ($CLIENT{'clid'}, $FORM{'tstid'});
-	# Populates an array of hashs that contains all of the questions and the answers.
-	#   $QUESTIONS_AH is a reference to the arrays of hashs.
-	my $last_index = $#{$QUESTIONS_AH} ; # Last index of the Array of Hashs of the Q&A.
-	my @filelist = &main::get_test_result_files($main::testcomplete, $client,$testid);
-	foreach my $file (@filelist) {
-		my $user = $file;
-		$user =~ s/.$testid$//;  # Strip the test id off the end of the file name.
-		$user =~ s/^$client.//;  # Strip the client id off the start of the file name.
-		my $user_grp = undef ;
-		my $inact_ques = 0; # Count of the inactive questions found.
-		# Do not process this user if group membership is required and not a member.
-		if ($grp_req and not $Group_Xref->{$user}) { 
-			# warn "Skipped User $user X" ;
-			next ; 
-		}
-		# Process this desired candidate's test answers.
-		# warn "Process User $user X" ;
-		&get_test_sequence_for_reports($client, $user, $testid) ;
-		# populates the Assoc. arrays %TEST_SESSION, %SUBTEST_QUESTIONS, 
-		#		%SUBTEST_ANSWERS, %SUBTEST_RESPONSES, and %SUBTEST_SUMMARY.
-  	my $points, $weight, @scores, @correct_ans, @incorrect_ans, @all_ans ;
-  	my $ques_type, $supercat, $scores, @responses, $responses ;
-		$responses = $SUBTEST_RESPONSES{2} ;
-		@responses = split (/\&/, $responses) ;
-		shift @responses ; # Drop the empty element in front of the list.
-    foreach $index1 (0 .. $last_index) {
-			# Skip the question if it is inactive.
-			if (${$QUESTIONS_AH}[$index1]->{'qil'} eq "Y") {$inact_ques++ ; next ;}
-      # Get the data for a single question.
-      $points = ${$QUESTIONS_AH}[$index1]->{'pts'} ;
-      $weight = ${$QUESTIONS_AH}[$index1]->{'wght'} ;
-      $ques_type = ${$QUESTIONS_AH}[$index1]->{'qtp'} ;
-      $scores = ${$QUESTIONS_AH}[$index1]->{'scores'} ;
-			unless ($ques_type eq "lik") {next ;}
-      @scores = split (/\,/ , $scores) ;
-      $supercat = ${$QUESTIONS_AH}[$index1]->{'supercat'} ;
-			unless ($supercat_found{$supercat}) {
-				# Initialize counters.
-				# warn "Init all Cat $supercat" if $supercat eq "Employee Passion" ;
-				$ret->{$supercat}->{'PointsAvail'} = 0 ;
-				$ret->{$supercat}->{'NoResponses'} = 0 ;
-				$ret->{$supercat}->{'Responses'} = 0 ;
-				$ret->{$supercat}->{'PointsEarned'} = 0 ;
-				$ret->{$supercat}->{'ScoreCount'} = {} ;
-				$supercat_found{$supercat} = 1 ;
-			}
-			$ret->{$supercat}->{'Questions'}->{$index1-$inact_ques} = 1 ;
-			my @Groups = @{$Group_Xref->{$user}} ;
-			foreach $group (@Groups) {
-       	unless (defined $ret_grp->{$group}->{$supercat}) {
-					# warn "Init all Cat $supercat Group $group.\n" if $supercat eq "Improvement" ;
-					$ret_grp->{$group}->{$supercat}->{'PointsAvail'} = 0 ;
-					$ret_grp->{$group}->{$supercat}->{'NoResponses'} = 0 ;
-					$ret_grp->{$group}->{$supercat}->{'Responses'} = 0 ;
-					$ret_grp->{$group}->{$supercat}->{'PointsEarned'} = 0 ;
-					$ret_grp->{$group}->{$supercat}->{'ScoreCount'} = {} ;
-				}
-			} # foreach $group
-			$responses = $responses[$index1-$inact_ques] ;
-      @individ = split(/\?/, $responses) ;
-      shift @individ ;
-			my $no_response = 1 ;
-			$ret->{$supercat}->{'PointsAvail'} += $points ;
-			foreach $group (@Groups) {
-				$ret_grp->{$group}->{$supercat}->{'PointsAvail'} += $points ;
-			}
-			foreach $index2 (0 .. $#scores) {
-				# Add the key for the score count to the hash.
-				unless (exists $ret->{$supercat}->{'ScoreCount'}->{$scores[$index2]}) {
-					$ret->{$supercat}->{'ScoreCount'}->{$scores[$index2]} = 0 ;
-				}
-				unless (exists $ret_grp->{$group}->{$supercat}->{'ScoreCount'}->{$scores[$index2]}) {
-					$ret_grp->{$group}->{$supercat}->{'ScoreCount'}->{$scores[$index2]} = 0 ;
-				}
-			}
-			# warn "CHECKING CAT $supercat USER $user GRP @group RESP $responses \n" if $supercat eq "Improvement" ;
-			foreach $index2 (0 .. $#scores) {
-				if ($individ[$index2] ne "xxx" and $individ[$index2] ne "" and $individ[$index2] == $index2) {
-					# Answered this question.
-					# warn "Scored CAT $supercat POINTS $scores[$index2] USER $user GRP @group \n" if $supercat eq "Improvement" ;
-					$ret->{$supercat}->{'PointsEarned'} += $scores[$index2] ;
-					$ret->{$supercat}->{'ScoreCount'}->{$scores[$index2]} ++ ;
-					foreach $group (@Groups) {
-						$ret_grp->{$group}->{$supercat}->{'PointsEarned'} += $scores[$index2] ;
-						$ret_grp->{$group}->{$supercat}->{'ScoreCount'}->{$scores[$index2]} ++ ;
-					}
-					$no_response = 0 ;
-				} # If answered.
-			} # foreach $index2
-			if ($no_response) {
-				# Add to the no response count.
-				$ret->{$supercat}->{'NoResponses'} ++ ;
-				foreach $group (@Groups) {
-					$ret_grp->{$group}->{$supercat}->{'NoResponses'} ++ ;
-				}
-			} else {
-				# Add to the response count.
-				$ret->{$supercat}->{'Responses'} ++ ;
-				foreach $group (@Groups) {
-					$ret_grp->{$group}->{$supercat}->{'Responses'} ++ ;
-				}
-			}
-		} # foreach question.
-	} # foreach file (i.e. candidate)
-	return ($ret, $ret_grp) ; # Return reference.
-} # End of GetFullLikertGrpData
-
-sub BuildBarGraph {
-# This subroutine builds the HTML to get an image from an URL.
-# The URL is a cgi-bin PERL script, with several parameters.
-# The list parameters are: labels, values, and values2.
-# The scalar parameters are: xdim, ydim, hbar, title, xlabel, ylabel, ymax, ymin, yticknum, colorscheme, $t_margin, $b_margin, $l_margin, $r_margin
-
-# The first 3 parameters are references to three lists, which are mandatory.
-#   The values2 list may be an empty list. (and ignored.)
-# The rest of the parameters are optional, but are order specific.
-# Any parameter that is an empty string will be effectively ignored,
-# but may be required to fill the list of parameters to a needed parm.
-    my @label_names, @value_points, @value2_points ;
-    my $labels_ref, $values_ref, $values2_ref ;
-		my $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum ;
-		my $colorscheme ;
-    my $t_margin, $b_margin, $l_margin, $r_margin ;
-    $labels_ref = $_[0] ;
-    @label_names = @{$labels_ref} ;
-# @label_names is an array of character strings of the names of the bars on the graph.
-		$values_ref = $_[1] ;
-		@value_points = @{$values_ref} ;
-# @value_points is an array of numeric values for each of the names in the first array.
-#    The sizes of the two arrays should be the same.
-		$values2_ref = $_[2] ;
-		@value2_points = @{$values2_ref} ;
-    shift ; shift ; shift ; # Remove the first 3 parms, to set up the next statement.
-		($xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, $colorscheme, $t_margin, $b_margin, $l_margin, $r_margin) = @_ ;
-		my $labels, $values, $values2 ;
-		# print '<br> label_names ' . "@label_names" . ' <br>' ;
-		# print '<br> value_points ' . "@value_points" . ' <br>' ;
-		if ($#label_names != $#value_points) {
-			print '<br>ERROR BuildBarGraph has different number of labels and data values.<br>' ;
-		}
-		$labels = join (":", map {munge($_)} @label_names ) ;
-		$values = join (":", map {munge($_)} @value_points ) ;
-		$values2 = join (":", map {munge($_)} @value2_points ) ;
-    # my $baseurl = "/cgi-bin/bargraph.pl?labels=$labels&title=Trust%20Level&ylabel=Respondents";
-    my $baseurl = "/cgi-bin/bargraph.pl?labels=$labels&values=$values" ;
-    if ($xdim or $xdim == 0) { $baseurl .= "&xdim=" . $xdim ; }
-    if ($ydim or $ydim == 0) { $baseurl .= "&ydim=" . $ydim ; }
-    if ($hbar or $hbar == 0) { $baseurl .= "&hbar=" . $hbar ; }
-    if ($title or $title == 0) { $baseurl .= "&title=" . munge( $title) ; }
-    if ($xlabel or $xlabel == 0) { $baseurl .= "&xlabel=" . munge( $xlabel) ; }
-    if ($ylabel or $ylabel == 0) { $baseurl .= "&ylabel=" . munge( $ylabel) ; }
-    if ($ymax or $ymax == 0) { $baseurl .= "&ymax=" . $ymax ; }
-    if ($ymin or $ymin == 0) { $baseurl .= "&ymin=" . $ymin ; }
-    if ($t_margin or $t_margin == 0) { $baseurl .= "&t_margin=" . $t_margin ; }
-    if ($b_margin or $b_margin == 0) { $baseurl .= "&b_margin=" . $b_margin ; }
-    if ($l_margin or $l_margin == 0) { $baseurl .= "&l_margin=" . $l_margin ; }
-    if ($r_margin or $r_margin == 0) { $baseurl .= "&r_margin=" . $r_margin ; }
-		if ($colorscheme) { $baseurl .= "&colorscheme=" . $colorscheme ; }
-    if ($yticknum or $yticknum == 0) { $baseurl .= "&yticknum=" . $yticknum ; }
-	  return  "<img src=\"$baseurl&values2=$values2\">";
-}
-
-
-
-1 ; # End of Perl Library file
-

survey-nginx/cgi-bin/Likert_Gen_Groups.pl.bu20100506

@@ -1,488 +0,0 @@
-#!/usr/bin/perl
-#
-# Source File: Likert_Gen_Groups.pl
-
-# Get config
-use FileHandle;
-use Time::Local;
-use Data::Dumper;
-use IntegroLib;
-require 'sitecfg.pl';
-require 'testlib.pl';
-require 'tstatlib.pl';
-require 'LikertData.pl' ;
-require 'grepa.pm' ;
-
-use strict;
-use vars qw(%FORM %SESSION %CLIENT %TEST_SESSION %SUBTEST_QUESTIONS %TEST
-	    %SUBTEST_SUMMARY %CANDIDATE %SUBTEST_ANSWERS %SYSTEM %REPORT
-	    %SUBTEST_RESPONSES @xlatphrase);
-use vars qw($testcomplete $cgiroot $pathsep $dataroot @rptparams );
-use vars qw($testinprog $testpending) ;
-
-# &app_initialize;
-
-$FORM{"idlist"} =~ tr/\000/,/ ; # Change separator for multiple values from NULL to comma.  HBI
-
-&LanguageSupportInit();
-# print STDERR Dumper(\%FORM);
-&get_client_profile($SESSION{'clid'});
-# warn "Tstid $FORM{'tstid'}\n" ;
-&get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
-
-# Make sure we have a valid session, and exit if we don't
-if (not &get_session($FORM{'tid'})) {
-    exit(0);
-}
-
-# Get the group filters, if any
-my ($idlist,$groups);
-if (exists $FORM{'grouping'} and $FORM{'grouping'} eq 'subset') {
-    #my @tmp = split(/,/,$FORM{'idlist'});
-    my @tmp = param('idlist');
-    $FORM{'idlist'} = join(',', @tmp);
-    @{$groups}{@tmp} = @tmp;
-    $idlist = &getIdlist($CLIENT{'clid'},$FORM{'idlist'});
-}
-
-# Get the time stamp style
-my $timestamp;
-if ($FORM{'timestamp'} eq 'currenttime') {
-    $timestamp = scalar(localtime(time));
-} elsif ($FORM{"timestamp"} eq 'custom' and $FORM{'customtime'} ne '') {
-    $timestamp = $FORM{'customtime'};
-} elsif ($FORM{'timestamp'} eq 'mostrecent' and $FORM{'tstid'}) {
-    my $file = join($pathsep,$testcomplete,"$CLIENT{'clid'}.$FORM{'tstid'}.history");
-    my $fh = new FileHandle;
-    if ($fh->open($file)) {
-	my @history = map([split(/(?:<<>>|&)/,$_,4)],<$fh>);
-	# print "<pre>".Dumper(\@history)."</pre>";
-	if (defined $idlist) {
-	    foreach (reverse @history) {
-		if (exists $idlist->{$_->[2]}) {
-		    $timestamp = scalar(localtime(toGMSeconds($_->[0])));
-		    last;
-		}
-	    }
-	} else {
-	    $timestamp = scalar(localtime(toGMSeconds($history[$#history]->[0])));
-	}
-    } else {
-	print STDERR "Could not open $file in Integro.pl\n";
-    }
-}
-if (defined $timestamp) {
-    $timestamp = "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$timestamp</b></font><br><BR>\n";
-} else {
-    $timestamp = "<br>\n";
-}
-
-# Generate the reports
-if ($FORM{'reportname'} eq 'LikertWQ') {
-    &LikertWQ($idlist, $groups, $timestamp);
-	} elsif ($FORM{'reportname'} eq 'LikertWQG') {
-		&LikertWQG($idlist, $groups, $timestamp);
-	} else {
-    &ReportChooser();
-	}
-
-# There should only be function definitions beyond this point.
-exit(0);
-
-sub HTMLHeader {
-	return "<html>\n<head>\n<title>$_[0]</title>\n".
-	"<!--Integro3.pl-->\n".
-	"<script language=\"JavaScript\">\n<!-- \n$_[1]\n -->\n</script>\n</head>\n".
-	"<BODY BACKGROUND=\"$SYSTEM{'BACKGROUND'}\" BGCOLOR=\"$SYSTEM{'BGCOLOR'}\"".
-	" TEXT=\"$SYSTEM{'TEXT'}\" LINK=\"$SYSTEM{'LINK'}\"".
-	" VLINK=\"$SYSTEM{'VLINK'}\" ALINK=\"$SYSTEM{'ALINK'}\">\n";
-}
-
-sub HTMLHeaderPlain {
-    return "<html>\n<head>\n<title>$_[0]</title>\n".
-	"<script language=\"JavaScript\">\n<!-- \n$_[1]\n -->\n</script>\n</head>\n".
-	"<BODY>\n";
-}
-
-sub HTMLFooter {
-    my $year = `date +%Y`;
-    my $ionline;
-    if ($ENV{'SERVER_NAME'} =~ "integroonline.com") {
-	$ionline = "<br>Copyright (c) $year, Integro Learning Company";
-    }
-    return "<br><center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">Copyright (c) $year, ACTS Corporation$ionline<center></font></body>\n</html>\n";
-}
-
-sub ReportChooser {
-    # Links w/javascript for chosing report
-    # Radio button to choose between all and select group(s)
-    # Menu box to chose one or more groups
-    my $groups = &getGroups($CLIENT{'clid'});
-    my $js = "function parmsIntegro(oform,rpt) {\n\t".
-	"oform.reportname.value=rpt;\n\t".
-	"oform.action='/cgi-bin/creports.pl';\n\t".
-	"oform.submit();\n};\n";
-    $js .= "\nfunction commIntegro(oform) {\n\t".
-	"oform.rptid.value='ACT-C-004';\n\t".
-	"oform.rptdesc.value='Test Statistics by Test'\n\t".
-	"oform.action='/cgi-bin/IntegroTS.pl';\n\t".
-	"oform.submit();\n};\n";
-    my $organizationname = $CLIENT{'clnmc'};
-    my $uberheader;
-		my $TESTS = get_data_hash ("tests.$CLIENT{'clid'}") ;
-		# print STDERR Dumper($TESTS) ;
-		my %TESTS = %$TESTS ;
-    my @test_list = () ;
-		my $ids ;
-		for $ids (keys %TESTS) {
-			# warn "ID $ids DATADESC $TESTS{$ids}->{'desc'} X" ;
-			push @test_list, [$TESTS{$ids}->{'desc'}, $ids] ;
-		}
-		# warn "test_list count $#test_list X\n" ;
-  	# print STDERR Dumper(\@test_list) ;
-		my ($js1, $test_choice_html) = ret_test_chooser_mod(@test_list) ;
-
-    #print STDERR get_data("tests.$CLIENT{'clid'}");
-    #print STDERR "Test ID = $tstid\n"; 
-    print HTMLHeader("Integro Learning Custom Reports",$js . $js1);
-    print "<form name=\"integrorpt\" action=\"/cgi-bin/creports.pl\" method=\"Post\" target=\"rptwindow\" enctype=\"multipart/form-data\" >\n";
-    print "<input type=\"hidden\" name=\"tid\" value=\"$SESSION{'tid'}\">\n";
-    # For development purposes we hardcode the survey id.
-    # Fix this before production
-    # print "<input type=hidden name=\"tstid\" value=\"\">\n"; # HBI This had a value of $tstid
-    print "<input type=hidden name=\"rptno\" value=\"$FORM{'rptno'}\">\n";
-    print "<input type=hidden name=\"rptdesc\" value=\"$REPORT{'rptdesc'}\">\n";
-    print "<input type=hidden name=\"rptid\" value=\"$REPORT{'rptid'}\">\n";
-    print "<input type=\"hidden\" name=\"reportname\" value=\"\">\n";
-    
-    print "<center>\n<table border>\n<caption>Integro Learning Custom Reports</Caption>\n".
-	"<tr><td valign=\"top\"><input type=\"radio\" name=\"grouping\" value=\"all\" checked>All Groups</td>\n".
-	"<td valign=\"top\"><input type=\"radio\" name=\"grouping\" value=\"subset\">Choose Groups<br>\n".
-        "<select name=\"idlist\" onchange='this.form.grouping[1].click();' multiple>\n";
-    foreach (sort {$a->{'grpnme'} cmp $b->{'grpnme'}} values %$groups) {
-	print "<option value=\"$_->{'grpid'}\">$_->{'grpnme'}</option>\n";
-    }
-    print "</select>\n";
-    #print "<tr><td colspan=\"2\">$xlatphrase[797] $xlatphrase[279]: <input type=\"text\" name=\"orgname\" value=\"$organizationname\"></td></tr>\n";
-    print "<tr><td colspan=\"3\"><table border=0><tr><td>Organization Name:</td><td><input type=\"text\" name=\"orgname\" value=\"$organizationname\"></td></tr>\n";
-    print "<tr><td>Header Override:</td><td><input type=\"text\" name=\"uberheader\" value=\"$uberheader\"></td></tr></table></tr></td>\n";
-    print "<tr><td colspan=\"2\">Time Stamp:<ul style=\"list-style: none\">".
-	"<li><input type=\"radio\" name=\"timestamp\" value=\"mostrecent\" checked>Most Recent Survey Taken</li>".
-	"<li><input type=\"radio\" name=\"timestamp\" value=\"currenttime\">Current Time</li>".
-	"<li><input type=\"radio\" name=\"timestamp\" value=\"custom\">Custom Value: ".
-	"<input type=\"text\" name=\"customtime\"></li></tr></td>";
-    print "</table></center>\n";
-		print $test_choice_html ;
-    print "<p>Likert Scale Report" ;
-		print "<ul style=\"list-style: none\">" ;
-		print "<li><a href=\"javascript:parmsIntegro(document.integrorpt,'LikertWQ');\">Likert Scale</a> - No Response is zero, Question Numbers listed.</li>\n" ;
-		print "<li><a href=\"javascript:parmsIntegro(document.integrorpt,'LikertWQG');\">Likert Scale by Group</a> - No Response is zero, Detail by Groups.</li>\n" ;
-		print "</ul></p>\n" ;
-    print "<input type=hidden name=\"testsummary\" value=\"composite\">\n";
-    print "<input type=hidden name=\"showcmts\" value=\"donot\">\n";
-    print "</form>";
-    print HTMLFooter();
-}
-
-sub LikertWQ {
-	# This does the Summary on the Likert Scale questions,
-	#   for everybody, or the Groups selected.
-	# $idlist is the list of candidate ids to report on.  It is undef when all groups (everyone) is choosen.
-	#    It is a reference to a hash.  The keys are the candidate ids, and the value is 1 for candidates in the choosen groups.
-	# $groups is the hash of groups to report on.  It is undef when all groups (everyone) is choosen.
-	#    It is a reference to a hash.  The keys are the group ids, and the values are the group ids.
-	# $FORM{'idlist'} is a comma separated list of the group ids of the selected groups.
-	# $FORM{'grouping'} is "subset" when the report should only cover the selected groups.
-	# $FORM{'grouping'} is "all" when the report should cover everybody.
-  # HBI - Pick it up here.
-  my ($idlist,$groups,$timestamp) = @_;
-  my $all_groups = getGroups($CLIENT{'clid'}) ;
-	my $group_membership_required ;
-	if ($groups) {
-		$group_membership_required = 1 ;
-		my $group_p ;
-		for $group_p (keys %{$all_groups}) {
-			unless ($groups->{$group_p}) {
-				undef $all_groups->{$group_p} ;
-			}
-		}
-	} else {
-		$group_membership_required = 0 ;
-	}
-	my ($sumdata, $grpdata) = &GetFullLikertGrpData($CLIENT{'clid'},$TEST{'id'},$all_groups, $group_membership_required) ;
-	# warn "sumdata" ;
-	# warn &Dumper(\$sumdata) ;
-  # warn "grpdata" ;
-	# warn &Dumper(\$grpdata) ;
-
-  print HTMLHeaderPlain("Likert Scale General Results");
-  print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\">" ;
-	print "<b>Likert Scale General Results<br>" ;
-	print "Survey/Test $TEST{'desc'}</b></font><br><br>\n";
-  # print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>Improvement as Perceived by Employees</b></font><br>\n";
-  # print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$FORM{'orgname'}</b></font><br>\n";
-  if ($FORM{'uberheader'} ne "") {
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>".$FORM{'uberheader'}."</b></font><br>\n";
-  } elsif (defined $idlist) {
-		print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Summary for Groups: "
-	    .join(", ",map($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n" ;
-  } else {
-		print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
-  }
-  print $timestamp;
-  print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">" ;
-
-	# Print HTML for heading.
-	print "<b><table border>\n";
-
-	# Print first row.
-	print "<tr>" ;
-	print "<th colspan=\"5\">Category Scores</th>" ;
-	print "</tr>\n" ;
-
-	# Print second row. Heading for each column.
-	print "<tr>" ;
-	print "<th>Category</th>" ;
-	print "<th>Questions</th>" ;
-	print "<th>Points Possible</th>" ;
-	print "<th>Points Earned</th>" ;
-	print "<th>% Earned</th>" ;
-	print "</tr>\n" ;
-
-	# Loop for Categories.
-	my $tot_poss = 0 ; my $tot_earned = 0 ;
-  my $supercat ;
-	my @supercats = sort keys %{$sumdata} ;
-	for $supercat (@supercats) {
-		my $questions = "" ;
-		my $possible = 0 ;
-		my $earned = 0 ;
-		$questions = join(", ", sort keys %{$sumdata->{$supercat}->{'Questions'}}) ;
-		$possible = $sumdata->{$supercat}->{'PointsAvail'} ;
-		$earned = $sumdata->{$supercat}->{'PointsEarned'} ;
-		$tot_poss += $possible ;
-		$tot_earned += $earned ;
-		print "<tr>" ;
-		print "<th>$supercat</th>" ;
-		print "<td>$questions</td>" ;
-		print "<td>$possible</td>" ;
-		print &rep_cell_str($earned, $possible) ;
-		print "</tr>\n" ;
-	}
-	
-	# Print Total row.
-	print "<tr>" ;
-	print "<th colspan=\"2\">Total</th>" ;
-	print "<td>$tot_poss</td>" ;
-	print &rep_cell_str($tot_earned, $tot_poss) ;
-	print "</tr>\n" ;
-
-	print "</tr>\n" ;
-	print "</table>\n" ;
-
-  print HTMLFooter();
-}
-
-sub LikertWQG {
-	# This does the Summary on the Likert Scale questions,
-	#   for everybody, or just groups, and lists group results.
-	# $idlist is the list of candidate ids to report on.  It is undef when all groups (everyone) is choosen.
-	#    It is a reference to a hash.  The keys are the candidate ids, and the value is 1 for candidates in the choosen groups.
-	# $groups is the hash of groups to report on.  It is undef when all groups (everyone) is choosen.
-	#    It is a reference to a hash.  The keys are the group ids, and the values are the group ids.
-	# $FORM{'idlist'} is a comma separated list of the group ids of the selected groups.
-	# $FORM{'grouping'} is "subset" when the report should only cover the selected groups.
-	# $FORM{'grouping'} is "all" when the report should cover everybody.
-  # HBI - Pick it up here.
-  my ($idlist,$groups,$timestamp) = @_;
-  my $all_groups = getGroups($CLIENT{'clid'}) ;
-	my $group_membership_required ;
-	if ($groups) {
-		$group_membership_required = 1 ;
-		my $group_p ;
-		for $group_p (keys %{$all_groups}) {
-			unless ($groups->{$group_p}) {
-				undef $all_groups->{$group_p} ;
-			}
-		}
-	} else {
-		$group_membership_required = 0 ;
-	}
-	my ($sumdata, $grpdata) = &GetFullLikertGrpData($CLIENT{'clid'},$TEST{'id'},$all_groups, $group_membership_required) ;
-	# warn "sumdata" ;
-	# warn &Dumper(\$sumdata) ;
-  # warn "grpdata" ;
-	# warn &Dumper(\$grpdata) ;
-
-  print HTMLHeaderPlain("Likert Scale Group Results");
-  print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\">" ;
-	print "<b>Likert Scale Group Results<br>" ;
-	print "Survey/Test $TEST{'desc'}</b></font><br><br>\n";
-  # print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>Improvement as Perceived by Employees</b></font><br>\n";
-  # print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$FORM{'orgname'}</b></font><br>\n";
-  if ($FORM{'uberheader'} ne "") {
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>".$FORM{'uberheader'}."</b></font><br>\n";
-  } elsif (defined $idlist) {
-		print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Summary for Groups: "
-	    .join(", ",map($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n" ;
-  } else {
-		print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
-  }
-  print $timestamp;
-  print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">" ;
-
-	# Print HTML for heading.
-	print "<b><table border>\n";
-
-	my $cat_count = keys %{$sumdata} ; # Number of categories.
-	# Print first row.
-	print "<tr>" ;
-	print "<th ></th>" ;
-  my $supercat ;
-	foreach $supercat (sort keys %{$sumdata}) {
-		print "<th >$supercat</th>\n" ;
-	}
-	print "<th >Total</th>" ;
-	print "</tr>\n" ;
-
-	# Print second row. Heading for each column.
-	# Loop for Categories.
-	my $tot_poss = 0 ; my $tot_earned = 0 ;
-	print "<tr>" ;
-	print "<td >Overall</td >\n" ;
-	my @supercats = sort keys %{$sumdata} ;
-	for $supercat (@supercats) {
-		# my $questions = "" ;
-		my $possible = 0 ;
-		my $earned = 0 ;
-		# $questions = join(", ", sort keys %{$sumdata->{$supercat}->{'Questions'}}) ;
-		$possible = $sumdata->{$supercat}->{'PointsAvail'} ;
-		$earned = $sumdata->{$supercat}->{'PointsEarned'} ;
-		$tot_poss += $possible ;
-		$tot_earned += $earned ;
-		print &rep_cell_str($earned, $possible, 1) ;
-	}
-	print &rep_cell_str($tot_earned, $tot_poss, 1) ;
-	print "</tr>\n" ;
-
-	# Print heading for Groups.
-	my $col_count = $cat_count + 2 ;
-	print "<tr><th colspan=\"${col_count}\">Group Breakdown</th ></tr >\n" ;
-
-	print "<tr><th >Supervisor</th >" ;
-	for $supercat (@supercats) {
-		print "<th >$supercat</th >" ;
-	}
-	print "<th >Total</th ></tr >\n" ;
-
-	unless ($grpdata) {
-		print "<tr><td colspan=\"${col_count}\">Pick Groups for more detail</td ></tr >\n" ;
-	} else {
-		my $group ;
-		foreach $group (sort keys %{$grpdata}) {
-			if ($group) {
-				print "<tr >" ;
-				print "<td >" ;
-				# print "$group " ;
-				print $all_groups->{$group}->{'grpnme'} ;
-				print "</td >" ;
-				my $tot_poss = 0 ; my $tot_earned = 0 ;
-				for $supercat (@supercats) {
-					my $possible = $grpdata->{$group}->{$supercat}->{'PointsAvail'} ;
-					my $earned = $grpdata->{$group}->{$supercat}->{'PointsEarned'} ;
-					$tot_poss += $possible ;
-					$tot_earned += $earned ;
-					print &rep_cell_str($earned, $possible, 1) ;
-				}
-				print &rep_cell_str($tot_earned, $tot_poss, 1) ;
-				print "</tr>\n" ;
-			}
-		}
-	}
-	print "</table>\n" ;
-
-  print HTMLFooter();
-}
-
-sub rep_cell_str {
-	# Parameters
-	# $count - required, number for the cell, integer.
-	# $total - dividend for the percent, integer.
-	# $skip_tot - Optional, default false.
-	#			If true, do not print total.
-	# Returned Value
-	# $html_str - html string to print for the cell.
-	my ($count, $total, $skip_tot) = @_ ;
-	my $html_str ;
-	$html_str .= "<td align=\"center\">" unless ($skip_tot) ;
-	my ($percent, $percent_str, $count_str) ;
-	$count_str = sprintf("%4i", $count) ;
-	if ($total == 0) {
-		# total is 0, percent is undefined.
-		$percent_str = "-&nbsp;&nbsp;&nbsp;-&nbsp;%" ;
-	} else {
-		$percent = 100.0 * $count / $total ;
-		$percent_str = sprintf("%5.1f&nbsp;%%", $percent) ;
-	}
-	$html_str .= "$count_str</td>" unless ($skip_tot) ;
-	$html_str .= "<td align=\"right\">" ;
-	$html_str .= "$percent_str</td>" ;
-	return $html_str ;
-}
-
-sub ret_test_chooser_mod {
-# Return strings of html to pick a survey.
-# The parameter is an array of arrays with test descriptions and ids.
-# The returned value is an array with two strings.
-#   The first string is JavaScript for the test chooser.
-#   The second string is html for the tables to drive the test chooser.
-  my @trecs = @_;
-  # print STDERR Dumper(\@trecs) ;
-  my ($testscompleted, $testsinprogress, $testspending, $href, $tstoption, $tstoptions);
-	my $html_str = "" ;
-  my $js = "function setTest(oform,test) {\n\t".
-    "oform.tstid.value=test;\n\t".
-    "oform.submit();\n};\n";
-  for (0 .. $#trecs) {
-    my ($desc,$id) ;
-		$desc = $trecs[$_][0] ;
-		$id = $trecs[$_][1] ;
-		# warn "RET_TEST_CHOOSER_MOD ID $id DESC $desc X" ;
-    $testscompleted = CountTestFiles($testcomplete,$CLIENT{'clid'},$id);
-    $testsinprogress = CountTestFiles($testinprog, $CLIENT{'clid'},$id);
-    $testspending = CountTestFiles($testpending, $CLIENT{'clid'},$id);
-    $href="javascript:setTest(document.testform1,\'$id\')\;";
-		my $radio_tst_button ;
-		$radio_tst_button = '<input type="radio" name="tstid" value="' . $id .
-			'" > ' . $id ;
-    $tstoption = " <TR>" .
-    # "<TD valign=top><FONT SIZE=2><a href=\"$href\">$id</a></FONT></TD>" .
-    "<TD valign=top><FONT SIZE=2>$radio_tst_button</FONT></TD>" .
-    "<TD valign=top><FONT SIZE=2>$desc</FONT></TD>" .
-    "<TD align=right valign=top><FONT SIZE=2>$testscompleted</FONT></TD>" .
-    "<TD align=right valign=top><FONT SIZE=2>$testsinprogress</FONT></TD>" .
-    "<TD align=right valign=top><FONT SIZE=2>$testspending</FONT></TD> </TR>\n";
-    $tstoptions = join('', $tstoptions, $tstoption);
-  }
-  $html_str = "<CENTER><B>Please choose the survey for which you would like reports:</B><br>" .
-  # "<form name=\"testform1\" action=\"/cgi-bin/creports.pl\" method=\"Post\">" .
-  # "<input type=\"hidden\" name=\"tid\" value=\"$SESSION{'tid'}\">" .
-  # "<input type=\"hidden\" name=\"tstid\" value=\"\">" .
-  # "<input type=hidden name=\"rptno\" value=\"$FORM{'rptno'}\">" .
-  # "</form>" .
-"<TABLE cellpadding=1 cellspacing=1 border=0 width=\"100\%\">" .
-  "<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
-  "<TR>" .
-    "<TD valign=top><B><FONT SIZE=1>Test ID</FONT></B></TD>" .
-    "<TD valign=top><B><FONT SIZE=1>Description</FONT></B></TD>" .
-    "<TD align=right valign=top><B><FONT SIZE=1>Cmp</FONT></B></TD>" .
-    "<TD align=right valign=top><B><FONT SIZE=1>InP</FONT></B></TD>" .
-    "<TD align=right valign=top><B><FONT SIZE=1>Pnd</FONT></B></TD>" .
-  "</TR>" .
-  "<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
-  $tstoptions .
-  "<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
-	"</TABLE> " ;
-  return ($js, $html_str) ;
-}
-

survey-nginx/cgi-bin/Likert_Gen_Groups.pl.bu20100509

@@ -1,508 +0,0 @@
-#!/usr/bin/perl
-#
-# Source File: Likert_Gen_Groups.pl
-
-# Get config
-use FileHandle;
-use Time::Local;
-use Data::Dumper;
-use IntegroLib;
-require 'sitecfg.pl';
-require 'testlib.pl';
-require 'tstatlib.pl';
-require 'LikertData.pl' ;
-require 'grepa.pm' ;
-
-use strict;
-use vars qw(%FORM %SESSION %CLIENT %TEST_SESSION %SUBTEST_QUESTIONS %TEST
-	    %SUBTEST_SUMMARY %CANDIDATE %SUBTEST_ANSWERS %SYSTEM %REPORT
-	    %SUBTEST_RESPONSES @xlatphrase);
-use vars qw($testcomplete $cgiroot $pathsep $dataroot @rptparams );
-use vars qw($testinprog $testpending) ;
-
-# &app_initialize;
-
-$FORM{"idlist"} =~ tr/\000/,/ ; # Change separator for multiple values from NULL to comma.  HBI
-
-&LanguageSupportInit();
-# print STDERR Dumper(\%FORM);
-&get_client_profile($SESSION{'clid'});
-# warn "Tstid $FORM{'tstid'}\n" ;
-&get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
-
-# Make sure we have a valid session, and exit if we don't
-if (not &get_session($FORM{'tid'})) {
-    exit(0);
-}
-
-# Get the group filters, if any
-my ($idlist,$groups);
-if (exists $FORM{'grouping'} and $FORM{'grouping'} eq 'subset') {
-    #my @tmp = split(/,/,$FORM{'idlist'});
-    my @tmp = param('idlist');
-    $FORM{'idlist'} = join(',', @tmp);
-    @{$groups}{@tmp} = @tmp;
-    $idlist = &getIdlist($CLIENT{'clid'},$FORM{'idlist'});
-}
-
-# Get the time stamp style
-my $timestamp;
-if ($FORM{'timestamp'} eq 'currenttime') {
-    $timestamp = scalar(localtime(time));
-} elsif ($FORM{"timestamp"} eq 'custom' and $FORM{'customtime'} ne '') {
-    $timestamp = $FORM{'customtime'};
-} elsif ($FORM{'timestamp'} eq 'mostrecent' and $FORM{'tstid'}) {
-    my $file = join($pathsep,$testcomplete,"$CLIENT{'clid'}.$FORM{'tstid'}.history");
-    my $fh = new FileHandle;
-    if ($fh->open($file)) {
-	my @history = map([split(/(?:<<>>|&)/,$_,4)],<$fh>);
-	# print "<pre>".Dumper(\@history)."</pre>";
-	if (defined $idlist) {
-	    foreach (reverse @history) {
-		if (exists $idlist->{$_->[2]}) {
-		    $timestamp = scalar(localtime(toGMSeconds($_->[0])));
-		    last;
-		}
-	    }
-	} else {
-	    $timestamp = scalar(localtime(toGMSeconds($history[$#history]->[0])));
-	}
-    } else {
-	print STDERR "Could not open $file in Integro.pl\n";
-    }
-}
-if (defined $timestamp) {
-    $timestamp = "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$timestamp</b></font><br><BR>\n";
-} else {
-    $timestamp = "<br>\n";
-}
-
-# Generate the reports
-if ($FORM{'reportname'} eq 'LikertWQ') {
-    &LikertWQ($idlist, $groups, $timestamp);
-	} elsif ($FORM{'reportname'} eq 'LikertWQG') {
-		&LikertWQG($idlist, $groups, $timestamp);
-	} else {
-    &ReportChooser();
-	}
-
-# There should only be function definitions beyond this point.
-exit(0);
-
-sub HTMLHeader {
-	return "<html>\n<head>\n<title>$_[0]</title>\n".
-	"<!--Integro3.pl-->\n".
-	"<script language=\"JavaScript\">\n<!-- \n$_[1]\n -->\n</script>\n</head>\n".
-	"<BODY BACKGROUND=\"$SYSTEM{'BACKGROUND'}\" BGCOLOR=\"$SYSTEM{'BGCOLOR'}\"".
-	" TEXT=\"$SYSTEM{'TEXT'}\" LINK=\"$SYSTEM{'LINK'}\"".
-	" VLINK=\"$SYSTEM{'VLINK'}\" ALINK=\"$SYSTEM{'ALINK'}\">\n";
-}
-
-sub HTMLHeaderPlain {
-    return "<html>\n<head>\n<title>$_[0]</title>\n".
-	"<script language=\"JavaScript\">\n<!-- \n$_[1]\n -->\n</script>\n</head>\n".
-	"<BODY>\n";
-}
-
-sub HTMLFooter {
-    my $year = `date +%Y`;
-    my $ionline;
-    if ($ENV{'SERVER_NAME'} =~ "integroonline.com") {
-	$ionline = "<br>Copyright (c) $year, Integro Learning Company";
-    }
-    return "<br><center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">Copyright (c) $year, ACTS Corporation$ionline<center></font></body>\n</html>\n";
-}
-
-sub ReportChooser {
-    # Links w/javascript for chosing report
-    # Radio button to choose between all and select group(s)
-    # Menu box to chose one or more groups
-    my $groups = &getGroups($CLIENT{'clid'});
-    my $js = "function parmsIntegro(oform,rpt) {\n\t".
-	"oform.reportname.value=rpt;\n\t".
-	"oform.action='/cgi-bin/creports.pl';\n\t".
-	"oform.submit();\n};\n";
-    $js .= "\nfunction commIntegro(oform) {\n\t".
-	"oform.rptid.value='ACT-C-004';\n\t".
-	"oform.rptdesc.value='Test Statistics by Test'\n\t".
-	"oform.action='/cgi-bin/IntegroTS.pl';\n\t".
-	"oform.submit();\n};\n";
-    my $organizationname = $CLIENT{'clnmc'};
-    my $uberheader;
-		my $TESTS = get_data_hash ("tests.$CLIENT{'clid'}") ;
-		# print STDERR Dumper($TESTS) ;
-		my %TESTS = %$TESTS ;
-    my @test_list = () ;
-		my $ids ;
-		for $ids (keys %TESTS) {
-			# warn "ID $ids DATADESC $TESTS{$ids}->{'desc'} X" ;
-			push @test_list, [$TESTS{$ids}->{'desc'}, $ids] ;
-		}
-		# warn "test_list count $#test_list X\n" ;
-  	# print STDERR Dumper(\@test_list) ;
-		my ($js1, $test_choice_html) = ret_test_chooser_mod(@test_list) ;
-
-    #print STDERR get_data("tests.$CLIENT{'clid'}");
-    #print STDERR "Test ID = $tstid\n"; 
-    print HTMLHeader("Integro Learning Custom Reports",$js . $js1);
-    print "<form name=\"integrorpt\" action=\"/cgi-bin/creports.pl\" method=\"Post\" target=\"rptwindow\" enctype=\"multipart/form-data\" >\n";
-    print "<input type=\"hidden\" name=\"tid\" value=\"$SESSION{'tid'}\">\n";
-    # For development purposes we hardcode the survey id.
-    # Fix this before production
-    # print "<input type=hidden name=\"tstid\" value=\"\">\n"; # HBI This had a value of $tstid
-    print "<input type=hidden name=\"rptno\" value=\"$FORM{'rptno'}\">\n";
-    print "<input type=hidden name=\"rptdesc\" value=\"$REPORT{'rptdesc'}\">\n";
-    print "<input type=hidden name=\"rptid\" value=\"$REPORT{'rptid'}\">\n";
-    print "<input type=\"hidden\" name=\"reportname\" value=\"\">\n";
-    
-    print "<center>\n<table border>\n<caption>Integro Learning Custom Reports</Caption>\n".
-	"<tr><td valign=\"top\"><input type=\"radio\" name=\"grouping\" value=\"all\" checked>All Groups</td>\n".
-	"<td valign=\"top\"><input type=\"radio\" name=\"grouping\" value=\"subset\">Choose Groups<br>\n".
-        "<select name=\"idlist\" onchange='this.form.grouping[1].click();' multiple>\n";
-    foreach (sort {$a->{'grpnme'} cmp $b->{'grpnme'}} values %$groups) {
-	print "<option value=\"$_->{'grpid'}\">$_->{'grpnme'}</option>\n";
-    }
-    print "</select>\n";
-    #print "<tr><td colspan=\"2\">$xlatphrase[797] $xlatphrase[279]: <input type=\"text\" name=\"orgname\" value=\"$organizationname\"></td></tr>\n";
-    print "<tr><td colspan=\"3\"><table border=0><tr><td>Organization Name:</td><td><input type=\"text\" name=\"orgname\" value=\"$organizationname\"></td></tr>\n";
-    print "<tr><td>Header Override:</td><td><input type=\"text\" name=\"uberheader\" value=\"$uberheader\"></td></tr></table></tr></td>\n";
-    print "<tr><td colspan=\"2\">Time Stamp:<ul style=\"list-style: none\">".
-	"<li><input type=\"radio\" name=\"timestamp\" value=\"mostrecent\" checked>Most Recent Survey Taken</li>".
-	"<li><input type=\"radio\" name=\"timestamp\" value=\"currenttime\">Current Time</li>".
-	"<li><input type=\"radio\" name=\"timestamp\" value=\"custom\">Custom Value: ".
-	"<input type=\"text\" name=\"customtime\"></li></tr></td>";
-    print "</table></center>\n";
-		print $test_choice_html ;
-    print "<p>Likert Scale Report" ;
-		print "<ul style=\"list-style: none\">" ;
-		print "<li><a href=\"javascript:parmsIntegro(document.integrorpt,'LikertWQ');\">Likert Scale</a> - No Response is zero, Question Numbers listed.</li>\n" ;
-		print "<li><a href=\"javascript:parmsIntegro(document.integrorpt,'LikertWQG');\">Likert Scale by Group</a> - No Response is zero, Detail by Groups.</li>\n" ;
-		print "</ul></p>\n" ;
-    print "<input type=hidden name=\"testsummary\" value=\"composite\">\n";
-    print "<input type=hidden name=\"showcmts\" value=\"donot\">\n";
-    print "</form>";
-    print HTMLFooter();
-}
-
-sub LikertWQ {
-	# This does the Summary on the Likert Scale questions,
-	#   for everybody, or the Groups selected.
-	# $idlist is the list of candidate ids to report on.  It is undef when all groups (everyone) is choosen.
-	#    It is a reference to a hash.  The keys are the candidate ids, and the value is 1 for candidates in the choosen groups.
-	# $groups is the hash of groups to report on.  It is undef when all groups (everyone) is choosen.
-	#    It is a reference to a hash.  The keys are the group ids, and the values are the group ids.
-	# $FORM{'idlist'} is a comma separated list of the group ids of the selected groups.
-	# $FORM{'grouping'} is "subset" when the report should only cover the selected groups.
-	# $FORM{'grouping'} is "all" when the report should cover everybody.
-  # HBI - Pick it up here.
-  my ($idlist,$groups,$timestamp) = @_;
-  my $all_groups = getGroups($CLIENT{'clid'}) ;
-	my $group_membership_required ;
-	if ($groups) {
-		$group_membership_required = 1 ;
-		my $group_p ;
-		for $group_p (keys %{$all_groups}) {
-			unless ($groups->{$group_p}) {
-				undef $all_groups->{$group_p} ;
-			}
-		}
-	} else {
-		$group_membership_required = 0 ;
-	}
-	my ($sumdata, $grpdata) = &GetFullLikertGrpData($CLIENT{'clid'},$TEST{'id'},$all_groups, $group_membership_required) ;
-	# warn "sumdata" ;
-	# warn &Dumper(\$sumdata) ;
-  # warn "grpdata" ;
-	# warn &Dumper(\$grpdata) ;
-
-  print HTMLHeaderPlain("Likert Scale General Results");
-  print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\">" ;
-	print "<b>Likert Scale General Results<br>" ;
-	print "Survey/Test $TEST{'desc'}</b></font><br><br>\n";
-  # print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>Improvement as Perceived by Employees</b></font><br>\n";
-  # print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$FORM{'orgname'}</b></font><br>\n";
-  if ($FORM{'uberheader'} ne "") {
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>".$FORM{'uberheader'}."</b></font><br>\n";
-  } elsif (defined $idlist) {
-		print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Summary for Groups: "
-	    .join(", ",map($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n" ;
-  } else {
-		print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
-  }
-  print $timestamp;
-  print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">" ;
-
-	my (@img_labels, @img_data) ;
-	my (@values2, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum) ;
-	my ($colorscheme, $t_margin, $b_margin, $l_margin, $r_margin ) ;
-	@img_labels = () ; @img_data = () ; @values2 = () ;
-	($t_margin, $b_margin, $l_margin, $r_margin) = (0, 0, 0, 30) ;
-	($xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, $colorscheme) =
-		(800, 100, 1, "$CLIENT{'clnmc'}", "Category", "Percent for Category", 100, 0, 10, 1) ;
-
-	# Print HTML for heading.
-	print "<b><table border>\n";
-
-	# Print first row.
-	print "<tr>" ;
-	print "<th colspan=\"5\">Category Scores</th>" ;
-	print "</tr>\n" ;
-
-	# Print second row. Heading for each column.
-	print "<tr>" ;
-	print "<th>Category</th>" ;
-	print "<th>Questions</th>" ;
-	print "<th>Points Possible</th>" ;
-	print "<th>Points Earned</th>" ;
-	print "<th>% Earned</th>" ;
-	print "</tr>\n" ;
-
-	# Loop for Categories.
-	my $tot_poss = 0 ; my $tot_earned = 0 ;
-  my $supercat ;
-	my @supercats = sort keys %{$sumdata} ;
-	for $supercat (@supercats) {
-		my $questions = "" ;
-		my $possible = 0 ;
-		my $earned = 0 ;
-		$questions = join(", ", sort keys %{$sumdata->{$supercat}->{'Questions'}}) ;
-		$possible = $sumdata->{$supercat}->{'PointsAvail'} ;
-		$earned = $sumdata->{$supercat}->{'PointsEarned'} ;
-		$tot_poss += $possible ;
-		$tot_earned += $earned ;
-		print "<tr>" ;
-		print "<th>$supercat</th>" ;
-		print "<td>$questions</td>" ;
-		print "<td>$possible</td>" ;
-		print &rep_cell_str($earned, $possible) ;
-		push @img_labels, $supercat ;
-		my ($percent) = int ((100.0 * $earned / $possible) +0.5) ;
-		push @img_data, $percent ;
-		$ydim += 15 ; # add length to the chart for another row.
-		print "</tr>\n" ;
-	}
-	
-	# Print Total row.
-	print "<tr>" ;
-	print "<th colspan=\"2\">Total</th>" ;
-	print "<td>$tot_poss</td>" ;
-	print &rep_cell_str($tot_earned, $tot_poss) ;
-	print "</tr>\n" ;
-
-	print "</tr>\n" ;
-	print "</table>\n" ;
-
-	if (@supercats) {
-		print "<br><br>\n" ;
-		print BuildBarGraph(\@img_labels, \@img_data, \@values2, $xdim, 
-			$ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, 
-			$colorscheme, $t_margin, $b_margin, $l_margin, $r_margin) ;
-		print "<br><br>\n" ;
-	}
-
-  print HTMLFooter();
-}
-
-sub LikertWQG {
-	# This does the Summary on the Likert Scale questions,
-	#   for everybody, or just groups, and lists group results.
-	# $idlist is the list of candidate ids to report on.  It is undef when all groups (everyone) is choosen.
-	#    It is a reference to a hash.  The keys are the candidate ids, and the value is 1 for candidates in the choosen groups.
-	# $groups is the hash of groups to report on.  It is undef when all groups (everyone) is choosen.
-	#    It is a reference to a hash.  The keys are the group ids, and the values are the group ids.
-	# $FORM{'idlist'} is a comma separated list of the group ids of the selected groups.
-	# $FORM{'grouping'} is "subset" when the report should only cover the selected groups.
-	# $FORM{'grouping'} is "all" when the report should cover everybody.
-  # HBI - Pick it up here.
-  my ($idlist,$groups,$timestamp) = @_;
-  my $all_groups = getGroups($CLIENT{'clid'}) ;
-	my $group_membership_required ;
-	if ($groups) {
-		$group_membership_required = 1 ;
-		my $group_p ;
-		for $group_p (keys %{$all_groups}) {
-			unless ($groups->{$group_p}) {
-				undef $all_groups->{$group_p} ;
-			}
-		}
-	} else {
-		$group_membership_required = 0 ;
-	}
-	my ($sumdata, $grpdata) = &GetFullLikertGrpData($CLIENT{'clid'},$TEST{'id'},$all_groups, $group_membership_required) ;
-	# warn "sumdata" ;
-	# warn &Dumper(\$sumdata) ;
-  # warn "grpdata" ;
-	# warn &Dumper(\$grpdata) ;
-
-  print HTMLHeaderPlain("Likert Scale Group Results");
-  print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\">" ;
-	print "<b>Likert Scale Group Results<br>" ;
-	print "Survey/Test $TEST{'desc'}</b></font><br><br>\n";
-  # print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>Improvement as Perceived by Employees</b></font><br>\n";
-  # print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$FORM{'orgname'}</b></font><br>\n";
-  if ($FORM{'uberheader'} ne "") {
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>".$FORM{'uberheader'}."</b></font><br>\n";
-  } elsif (defined $idlist) {
-		print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Summary for Groups: "
-	    .join(", ",map($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n" ;
-  } else {
-		print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
-  }
-  print $timestamp;
-  print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">" ;
-
-	# Print HTML for heading.
-	print "<b><table border>\n";
-
-	my $cat_count = keys %{$sumdata} ; # Number of categories.
-	# Print first row.
-	print "<tr>" ;
-	print "<th ></th>" ;
-  my $supercat ;
-	foreach $supercat (sort keys %{$sumdata}) {
-		print "<th >$supercat</th>\n" ;
-	}
-	print "<th >Total</th>" ;
-	print "</tr>\n" ;
-
-	# Print second row. Heading for each column.
-	# Loop for Categories.
-	my $tot_poss = 0 ; my $tot_earned = 0 ;
-	print "<tr>" ;
-	print "<td >Overall</td >\n" ;
-	my @supercats = sort keys %{$sumdata} ;
-	for $supercat (@supercats) {
-		# my $questions = "" ;
-		my $possible = 0 ;
-		my $earned = 0 ;
-		# $questions = join(", ", sort keys %{$sumdata->{$supercat}->{'Questions'}}) ;
-		$possible = $sumdata->{$supercat}->{'PointsAvail'} ;
-		$earned = $sumdata->{$supercat}->{'PointsEarned'} ;
-		$tot_poss += $possible ;
-		$tot_earned += $earned ;
-		print &rep_cell_str($earned, $possible, 1) ;
-	}
-	print &rep_cell_str($tot_earned, $tot_poss, 1) ;
-	print "</tr>\n" ;
-
-	# Print heading for Groups.
-	my $col_count = $cat_count + 2 ;
-	print "<tr><th colspan=\"${col_count}\">Group Breakdown</th ></tr >\n" ;
-
-	print "<tr><th >Supervisor</th >" ;
-	for $supercat (@supercats) {
-		print "<th >$supercat</th >" ;
-	}
-	print "<th >Total</th ></tr >\n" ;
-
-	unless ($grpdata) {
-		print "<tr><td colspan=\"${col_count}\">Pick Groups for more detail</td ></tr >\n" ;
-	} else {
-		my $group ;
-		foreach $group (sort keys %{$grpdata}) {
-			if ($group) {
-				print "<tr >" ;
-				print "<td >" ;
-				# print "$group " ;
-				print $all_groups->{$group}->{'grpnme'} ;
-				print "</td >" ;
-				my $tot_poss = 0 ; my $tot_earned = 0 ;
-				for $supercat (@supercats) {
-					my $possible = $grpdata->{$group}->{$supercat}->{'PointsAvail'} ;
-					my $earned = $grpdata->{$group}->{$supercat}->{'PointsEarned'} ;
-					$tot_poss += $possible ;
-					$tot_earned += $earned ;
-					print &rep_cell_str($earned, $possible, 1) ;
-				}
-				print &rep_cell_str($tot_earned, $tot_poss, 1) ;
-				print "</tr>\n" ;
-			}
-		}
-	}
-	print "</table>\n" ;
-
-  print HTMLFooter();
-}
-
-sub rep_cell_str {
-	# Parameters
-	# $count - required, number for the cell, integer.
-	# $total - dividend for the percent, integer.
-	# $skip_tot - Optional, default false.
-	#			If true, do not print total.
-	# Returned Value
-	# $html_str - html string to print for the cell.
-	my ($count, $total, $skip_tot) = @_ ;
-	my $html_str ;
-	$html_str .= "<td align=\"center\">" unless ($skip_tot) ;
-	my ($percent, $percent_str, $count_str) ;
-	$count_str = sprintf("%4i", $count) ;
-	if ($total == 0) {
-		# total is 0, percent is undefined.
-		$percent_str = "-&nbsp;&nbsp;&nbsp;-&nbsp;%" ;
-	} else {
-		$percent = 100.0 * $count / $total ;
-		$percent_str = sprintf("%5.1f&nbsp;%%", $percent) ;
-	}
-	$html_str .= "$count_str</td>" unless ($skip_tot) ;
-	$html_str .= "<td align=\"right\">" ;
-	$html_str .= "$percent_str</td>" ;
-	return $html_str ;
-}
-
-sub ret_test_chooser_mod {
-# Return strings of html to pick a survey.
-# The parameter is an array of arrays with test descriptions and ids.
-# The returned value is an array with two strings.
-#   The first string is JavaScript for the test chooser.
-#   The second string is html for the tables to drive the test chooser.
-  my @trecs = @_;
-  # print STDERR Dumper(\@trecs) ;
-  my ($testscompleted, $testsinprogress, $testspending, $href, $tstoption, $tstoptions);
-	my $html_str = "" ;
-  my $js = "function setTest(oform,test) {\n\t".
-    "oform.tstid.value=test;\n\t".
-    "oform.submit();\n};\n";
-  for (0 .. $#trecs) {
-    my ($desc,$id) ;
-		$desc = $trecs[$_][0] ;
-		$id = $trecs[$_][1] ;
-		# warn "RET_TEST_CHOOSER_MOD ID $id DESC $desc X" ;
-    $testscompleted = CountTestFiles($testcomplete,$CLIENT{'clid'},$id);
-    $testsinprogress = CountTestFiles($testinprog, $CLIENT{'clid'},$id);
-    $testspending = CountTestFiles($testpending, $CLIENT{'clid'},$id);
-    $href="javascript:setTest(document.testform1,\'$id\')\;";
-		my $radio_tst_button ;
-		$radio_tst_button = '<input type="radio" name="tstid" value="' . $id .
-			'" > ' . $id ;
-    $tstoption = " <TR>" .
-    # "<TD valign=top><FONT SIZE=2><a href=\"$href\">$id</a></FONT></TD>" .
-    "<TD valign=top><FONT SIZE=2>$radio_tst_button</FONT></TD>" .
-    "<TD valign=top><FONT SIZE=2>$desc</FONT></TD>" .
-    "<TD align=right valign=top><FONT SIZE=2>$testscompleted</FONT></TD>" .
-    "<TD align=right valign=top><FONT SIZE=2>$testsinprogress</FONT></TD>" .
-    "<TD align=right valign=top><FONT SIZE=2>$testspending</FONT></TD> </TR>\n";
-    $tstoptions = join('', $tstoptions, $tstoption);
-  }
-  $html_str = "<CENTER><B>Please choose the survey for which you would like reports:</B><br>" .
-  # "<form name=\"testform1\" action=\"/cgi-bin/creports.pl\" method=\"Post\">" .
-  # "<input type=\"hidden\" name=\"tid\" value=\"$SESSION{'tid'}\">" .
-  # "<input type=\"hidden\" name=\"tstid\" value=\"\">" .
-  # "<input type=hidden name=\"rptno\" value=\"$FORM{'rptno'}\">" .
-  # "</form>" .
-"<TABLE cellpadding=1 cellspacing=1 border=0 width=\"100\%\">" .
-  "<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
-  "<TR>" .
-    "<TD valign=top><B><FONT SIZE=1>Test ID</FONT></B></TD>" .
-    "<TD valign=top><B><FONT SIZE=1>Description</FONT></B></TD>" .
-    "<TD align=right valign=top><B><FONT SIZE=1>Cmp</FONT></B></TD>" .
-    "<TD align=right valign=top><B><FONT SIZE=1>InP</FONT></B></TD>" .
-    "<TD align=right valign=top><B><FONT SIZE=1>Pnd</FONT></B></TD>" .
-  "</TR>" .
-  "<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
-  $tstoptions .
-  "<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
-	"</TABLE> " ;
-  return ($js, $html_str) ;
-}
-

survey-nginx/cgi-bin/Likert_Gen_Groups.pl.bu20100513

@@ -1,515 +0,0 @@
-#!/usr/bin/perl
-#
-# Source File: Likert_Gen_Groups.pl
-
-# Get config
-use FileHandle;
-use Time::Local;
-use Data::Dumper;
-use IntegroLib;
-require 'sitecfg.pl';
-require 'testlib.pl';
-require 'tstatlib.pl';
-require 'LikertData.pl' ;
-require 'grepa.pm' ;
-
-use strict;
-use vars qw(%FORM %SESSION %CLIENT %TEST_SESSION %SUBTEST_QUESTIONS %TEST
-	    %SUBTEST_SUMMARY %CANDIDATE %SUBTEST_ANSWERS %SYSTEM %REPORT
-	    %SUBTEST_RESPONSES @xlatphrase);
-use vars qw($testcomplete $cgiroot $pathsep $dataroot @rptparams );
-use vars qw($testinprog $testpending) ;
-
-# &app_initialize;
-
-$FORM{"idlist"} =~ tr/\000/,/ ; # Change separator for multiple values from NULL to comma.  HBI
-
-&LanguageSupportInit();
-# print STDERR Dumper(\%FORM);
-&get_client_profile($SESSION{'clid'});
-# warn "Tstid $FORM{'tstid'}\n" ;
-&get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
-
-# Make sure we have a valid session, and exit if we don't
-if (not &get_session($FORM{'tid'})) {
-    exit(0);
-}
-
-# Get the group filters, if any
-my ($idlist,$groups);
-if (exists $FORM{'grouping'} and $FORM{'grouping'} eq 'subset') {
-    #my @tmp = split(/,/,$FORM{'idlist'});
-    my @tmp = param('idlist');
-    $FORM{'idlist'} = join(',', @tmp);
-    @{$groups}{@tmp} = @tmp;
-    $idlist = &getIdlist($CLIENT{'clid'},$FORM{'idlist'});
-}
-
-# Get the time stamp style
-my $timestamp;
-if ($FORM{'timestamp'} eq 'currenttime') {
-    $timestamp = scalar(localtime(time));
-} elsif ($FORM{"timestamp"} eq 'custom' and $FORM{'customtime'} ne '') {
-    $timestamp = $FORM{'customtime'};
-} elsif ($FORM{'timestamp'} eq 'mostrecent' and $FORM{'tstid'}) {
-    my $file = join($pathsep,$testcomplete,"$CLIENT{'clid'}.$FORM{'tstid'}.history");
-    my $fh = new FileHandle;
-    if ($fh->open($file)) {
-	my @history = map([split(/(?:<<>>|&)/,$_,4)],<$fh>);
-	# print "<pre>".Dumper(\@history)."</pre>";
-	if (defined $idlist) {
-	    foreach (reverse @history) {
-		if (exists $idlist->{$_->[2]}) {
-		    $timestamp = scalar(localtime(toGMSeconds($_->[0])));
-		    last;
-		}
-	    }
-	} else {
-	    $timestamp = scalar(localtime(toGMSeconds($history[$#history]->[0])));
-	}
-    } else {
-	print STDERR "Could not open $file in Integro.pl\n";
-    }
-}
-if (defined $timestamp) {
-    $timestamp = "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$timestamp</b></font><br><BR>\n";
-} else {
-    $timestamp = "<br>\n";
-}
-
-# Generate the reports
-if ($FORM{'reportname'} eq 'LikertWQ') {
-    &LikertWQ($idlist, $groups, $timestamp);
-	} elsif ($FORM{'reportname'} eq 'LikertWQG') {
-		&LikertWQG($idlist, $groups, $timestamp);
-	} else {
-    &ReportChooser();
-	}
-
-# There should only be function definitions beyond this point.
-exit(0);
-
-sub HTMLHeader {
-	return "<html>\n<head>\n<title>$_[0]</title>\n".
-	"<!--Integro3.pl-->\n".
-	"<script language=\"JavaScript\">\n<!-- \n$_[1]\n -->\n</script>\n</head>\n".
-	"<BODY BACKGROUND=\"$SYSTEM{'BACKGROUND'}\" BGCOLOR=\"$SYSTEM{'BGCOLOR'}\"".
-	" TEXT=\"$SYSTEM{'TEXT'}\" LINK=\"$SYSTEM{'LINK'}\"".
-	" VLINK=\"$SYSTEM{'VLINK'}\" ALINK=\"$SYSTEM{'ALINK'}\">\n";
-}
-
-sub HTMLHeaderPlain {
-    return "<html>\n<head>\n<title>$_[0]</title>\n".
-	"<script language=\"JavaScript\">\n<!-- \n$_[1]\n -->\n</script>\n</head>\n".
-	"<BODY>\n";
-}
-
-sub HTMLFooter {
-    my $year = `date +%Y`;
-    my $ionline;
-    if ($ENV{'SERVER_NAME'} =~ "integroonline.com") {
-	$ionline = "<br>Copyright (c) $year, Integro Learning Company";
-    }
-    return "<br><center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">Copyright (c) $year, ACTS Corporation$ionline<center></font></body>\n</html>\n";
-}
-
-sub ReportChooser {
-    # Links w/javascript for chosing report
-    # Radio button to choose between all and select group(s)
-    # Menu box to chose one or more groups
-    my $groups = &getGroups($CLIENT{'clid'});
-    my $js = "function parmsIntegro(oform,rpt) {\n\t".
-	"oform.reportname.value=rpt;\n\t".
-	"oform.action='/cgi-bin/creports.pl';\n\t".
-	"oform.submit();\n};\n";
-    $js .= "\nfunction commIntegro(oform) {\n\t".
-	"oform.rptid.value='ACT-C-004';\n\t".
-	"oform.rptdesc.value='Test Statistics by Test'\n\t".
-	"oform.action='/cgi-bin/IntegroTS.pl';\n\t".
-	"oform.submit();\n};\n";
-    my $organizationname = $CLIENT{'clnmc'};
-    my $uberheader;
-		my $TESTS = get_data_hash ("tests.$CLIENT{'clid'}") ;
-		# print STDERR Dumper($TESTS) ;
-		my %TESTS = %$TESTS ;
-    my @test_list = () ;
-		my $ids ;
-		for $ids (keys %TESTS) {
-			# warn "ID $ids DATADESC $TESTS{$ids}->{'desc'} X" ;
-			push @test_list, [$TESTS{$ids}->{'desc'}, $ids] ;
-		}
-		# warn "test_list count $#test_list X\n" ;
-  	# print STDERR Dumper(\@test_list) ;
-		my ($js1, $test_choice_html) = ret_test_chooser_mod(@test_list) ;
-
-    #print STDERR get_data("tests.$CLIENT{'clid'}");
-    #print STDERR "Test ID = $tstid\n"; 
-    print HTMLHeader("Integro Learning Custom Reports",$js . $js1);
-    print "<form name=\"integrorpt\" action=\"/cgi-bin/creports.pl\" method=\"Post\" target=\"rptwindow\" enctype=\"multipart/form-data\" >\n";
-    print "<input type=\"hidden\" name=\"tid\" value=\"$SESSION{'tid'}\">\n";
-    # For development purposes we hardcode the survey id.
-    # Fix this before production
-    # print "<input type=hidden name=\"tstid\" value=\"\">\n"; # HBI This had a value of $tstid
-    print "<input type=hidden name=\"rptno\" value=\"$FORM{'rptno'}\">\n";
-    print "<input type=hidden name=\"rptdesc\" value=\"$REPORT{'rptdesc'}\">\n";
-    print "<input type=hidden name=\"rptid\" value=\"$REPORT{'rptid'}\">\n";
-    print "<input type=\"hidden\" name=\"reportname\" value=\"\">\n";
-    
-    print "<center>\n<table border>\n<caption>Integro Learning Custom Reports</Caption>\n".
-	"<tr><td valign=\"top\"><input type=\"radio\" name=\"grouping\" value=\"all\" checked>All Groups</td>\n".
-	"<td valign=\"top\"><input type=\"radio\" name=\"grouping\" value=\"subset\">Choose Groups<br>\n".
-        "<select name=\"idlist\" onchange='this.form.grouping[1].click();' multiple>\n";
-    foreach (sort {$a->{'grpnme'} cmp $b->{'grpnme'}} values %$groups) {
-	print "<option value=\"$_->{'grpid'}\">$_->{'grpnme'}</option>\n";
-    }
-    print "</select>\n";
-    #print "<tr><td colspan=\"2\">$xlatphrase[797] $xlatphrase[279]: <input type=\"text\" name=\"orgname\" value=\"$organizationname\"></td></tr>\n";
-    print "<tr><td colspan=\"3\"><table border=0><tr><td>Organization Name:</td><td><input type=\"text\" name=\"orgname\" value=\"$organizationname\"></td></tr>\n";
-    print "<tr><td>Header Override:</td><td><input type=\"text\" name=\"uberheader\" value=\"$uberheader\"></td></tr></table></tr></td>\n";
-    print "<tr><td colspan=\"2\">Time Stamp:<ul style=\"list-style: none\">".
-	"<li><input type=\"radio\" name=\"timestamp\" value=\"mostrecent\" checked>Most Recent Survey Taken</li>".
-	"<li><input type=\"radio\" name=\"timestamp\" value=\"currenttime\">Current Time</li>".
-	"<li><input type=\"radio\" name=\"timestamp\" value=\"custom\">Custom Value: ".
-	"<input type=\"text\" name=\"customtime\"></li></tr></td>";
-    print "</table></center>\n";
-		print $test_choice_html ;
-    print "<p>Likert Scale Report" ;
-		print "<ul style=\"list-style: none\">" ;
-		print "<li><a href=\"javascript:parmsIntegro(document.integrorpt,'LikertWQ');\">Likert Scale</a> - No Response is zero, Question Numbers listed.</li>\n" ;
-		print "<li><a href=\"javascript:parmsIntegro(document.integrorpt,'LikertWQG');\">Likert Scale by Group</a> - No Response is zero, Detail by Groups.</li>\n" ;
-		print "</ul></p>\n" ;
-    print "<input type=hidden name=\"testsummary\" value=\"composite\">\n";
-    print "<input type=hidden name=\"showcmts\" value=\"donot\">\n";
-    print "</form>";
-    print HTMLFooter();
-}
-
-sub LikertWQ {
-	# This does the Summary on the Likert Scale questions,
-	#   for everybody, or the Groups selected.
-	# $idlist is the list of candidate ids to report on.  It is undef when all groups (everyone) is choosen.
-	#    It is a reference to a hash.  The keys are the candidate ids, and the value is 1 for candidates in the choosen groups.
-	# $groups is the hash of groups to report on.  It is undef when all groups (everyone) is choosen.
-	#    It is a reference to a hash.  The keys are the group ids, and the values are the group ids.
-	# $FORM{'idlist'} is a comma separated list of the group ids of the selected groups.
-	# $FORM{'grouping'} is "subset" when the report should only cover the selected groups.
-	# $FORM{'grouping'} is "all" when the report should cover everybody.
-  # HBI - Pick it up here.
-  my ($idlist,$groups,$timestamp) = @_;
-  my $all_groups = getGroups($CLIENT{'clid'}) ;
-	my $group_membership_required ;
-	if ($groups) {
-		$group_membership_required = 1 ;
-		my $group_p ;
-		for $group_p (keys %{$all_groups}) {
-			unless ($groups->{$group_p}) {
-				undef $all_groups->{$group_p} ;
-			}
-		}
-	} else {
-		$group_membership_required = 0 ;
-	}
-	my ($sumdata, $grpdata) = &GetFullLikertGrpData($CLIENT{'clid'},$TEST{'id'},$all_groups, $group_membership_required) ;
-	# warn "sumdata" ;
-	# warn &Dumper(\$sumdata) ;
-  # warn "grpdata" ;
-	# warn &Dumper(\$grpdata) ;
-
-  print HTMLHeaderPlain("Likert Scale General Results");
-  print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\">" ;
-	print "<b>Likert Scale General Results<br>" ;
-	print "Survey/Test $TEST{'desc'}</b></font><br><br>\n";
-  # print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>Improvement as Perceived by Employees</b></font><br>\n";
-  # print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$FORM{'orgname'}</b></font><br>\n";
-  if ($FORM{'uberheader'} ne "") {
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>".$FORM{'uberheader'}."</b></font><br>\n";
-  } elsif (defined $idlist) {
-		print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Summary for Groups: "
-	    .join(", ",map($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n" ;
-  } else {
-		print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
-  }
-  print $timestamp;
-  print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">" ;
-
-	my (@img_labels, @img_data) ;
-	my (@values2, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum) ;
-	my ($colorscheme, $t_margin, $b_margin, $l_margin, $r_margin ) ;
-	@img_labels = () ; @img_data = () ; @values2 = () ;
-	($t_margin, $b_margin, $l_margin, $r_margin) = (0, 0, 0, 30) ;
-	($xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, $colorscheme) =
-		(800, 100, 1, "$CLIENT{'clnmc'}", "Category", "Percent for Category", 100, 0, 10, 1) ;
-
-	# Print HTML for heading.
-	print "<b><table border>\n";
-
-	# Print first row.
-	print "<tr>" ;
-	print "<th colspan=\"5\">Category Scores</th>" ;
-	print "</tr>\n" ;
-
-	# Print second row. Heading for each column.
-	print "<tr>" ;
-	print "<th>Category</th>" ;
-	print "<th>Questions</th>" ;
-	print "<th>Points Possible</th>" ;
-	print "<th>Points Earned</th>" ;
-	print "<th>% Earned</th>" ;
-	print "</tr>\n" ;
-
-	# Loop for Categories.
-	my $tot_poss = 0 ; my $tot_earned = 0 ;
-  my $supercat ; my $text_summ = "<p align=left>Category: Percent<br>\n" ;
-	my @supercats = sort keys %{$sumdata} ;
-	for $supercat (@supercats) {
-		my $questions = "" ;
-		my $possible = 0 ;
-		my $earned = 0 ;
-		$questions = join(", ", sort keys %{$sumdata->{$supercat}->{'Questions'}}) ;
-		$possible = $sumdata->{$supercat}->{'PointsAvail'} ;
-		$earned = $sumdata->{$supercat}->{'PointsEarned'} ;
-		$tot_poss += $possible ;
-		$tot_earned += $earned ;
-		print "<tr>" ;
-		print "<th>$supercat</th>" ;
-		print "<td>$questions</td>" ;
-		print "<td>$possible</td>" ;
-		print &rep_cell_str($earned, $possible) ;
-		push @img_labels, $supercat ;
-		my ($percent) = int ((100.0 * $earned / $possible) +0.5) ;
-		push @img_data, $percent ;
-		$text_summ .= $supercat . ": " . $percent . "<br>\n" ;
-		$ydim += 15 ; # add length to the chart for another row.
-		print "</tr>\n" ;
-	}
-	
-	# Print Total row.
-	print "<tr>" ;
-	print "<th colspan=\"2\">Total</th>" ;
-	print "<td>$tot_poss</td>" ;
-	push @img_labels, "Total" ;
-	my ($percent) = int ((100.0 * $tot_earned / $tot_poss) +0.5) ;
-	push @img_data, $percent ;
-	$text_summ .= "Total" . ": " . $percent . "<br>\n" ;
-	$ydim += 15 ; # add length to the chart for another row.
-	print &rep_cell_str($tot_earned, $tot_poss) ;
-	print "</tr>\n" ;
-
-	print "</tr>\n" ;
-	print "</table>\n" ;
-	print $text_summ ;
-
-	if (@supercats) {
-		print "<br><br>\n" ;
-		print BuildBarGraph(\@img_labels, \@img_data, \@values2, $xdim, 
-			$ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, 
-			$colorscheme, $t_margin, $b_margin, $l_margin, $r_margin) ;
-		print "<br><br>\n" ;
-	}
-
-  print HTMLFooter();
-}
-
-sub LikertWQG {
-	# This does the Summary on the Likert Scale questions,
-	#   for everybody, or just groups, and lists group results.
-	# $idlist is the list of candidate ids to report on.  It is undef when all groups (everyone) is choosen.
-	#    It is a reference to a hash.  The keys are the candidate ids, and the value is 1 for candidates in the choosen groups.
-	# $groups is the hash of groups to report on.  It is undef when all groups (everyone) is choosen.
-	#    It is a reference to a hash.  The keys are the group ids, and the values are the group ids.
-	# $FORM{'idlist'} is a comma separated list of the group ids of the selected groups.
-	# $FORM{'grouping'} is "subset" when the report should only cover the selected groups.
-	# $FORM{'grouping'} is "all" when the report should cover everybody.
-  # HBI - Pick it up here.
-  my ($idlist,$groups,$timestamp) = @_;
-  my $all_groups = getGroups($CLIENT{'clid'}) ;
-	my $group_membership_required ;
-	if ($groups) {
-		$group_membership_required = 1 ;
-		my $group_p ;
-		for $group_p (keys %{$all_groups}) {
-			unless ($groups->{$group_p}) {
-				undef $all_groups->{$group_p} ;
-			}
-		}
-	} else {
-		$group_membership_required = 0 ;
-	}
-	my ($sumdata, $grpdata) = &GetFullLikertGrpData($CLIENT{'clid'},$TEST{'id'},$all_groups, $group_membership_required) ;
-	# warn "sumdata" ;
-	# warn &Dumper(\$sumdata) ;
-  # warn "grpdata" ;
-	# warn &Dumper(\$grpdata) ;
-
-  print HTMLHeaderPlain("Likert Scale Group Results");
-  print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\">" ;
-	print "<b>Likert Scale Group Results<br>" ;
-	print "Survey/Test $TEST{'desc'}</b></font><br><br>\n";
-  # print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>Improvement as Perceived by Employees</b></font><br>\n";
-  # print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$FORM{'orgname'}</b></font><br>\n";
-  if ($FORM{'uberheader'} ne "") {
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>".$FORM{'uberheader'}."</b></font><br>\n";
-  } elsif (defined $idlist) {
-		print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Summary for Groups: "
-	    .join(", ",map($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n" ;
-  } else {
-		print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
-  }
-  print $timestamp;
-  print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">" ;
-
-	# Print HTML for heading.
-	print "<b><table border>\n";
-
-	my $cat_count = keys %{$sumdata} ; # Number of categories.
-	# Print first row.
-	print "<tr>" ;
-	print "<th ></th>" ;
-  my $supercat ;
-	foreach $supercat (sort keys %{$sumdata}) {
-		print "<th >$supercat</th>\n" ;
-	}
-	print "<th >Total</th>" ;
-	print "</tr>\n" ;
-
-	# Print second row. Heading for each column.
-	# Loop for Categories.
-	my $tot_poss = 0 ; my $tot_earned = 0 ;
-	print "<tr>" ;
-	print "<td >Overall</td >\n" ;
-	my @supercats = sort keys %{$sumdata} ;
-	for $supercat (@supercats) {
-		# my $questions = "" ;
-		my $possible = 0 ;
-		my $earned = 0 ;
-		# $questions = join(", ", sort keys %{$sumdata->{$supercat}->{'Questions'}}) ;
-		$possible = $sumdata->{$supercat}->{'PointsAvail'} ;
-		$earned = $sumdata->{$supercat}->{'PointsEarned'} ;
-		$tot_poss += $possible ;
-		$tot_earned += $earned ;
-		print &rep_cell_str($earned, $possible, 1) ;
-	}
-	print &rep_cell_str($tot_earned, $tot_poss, 1) ;
-	print "</tr>\n" ;
-
-	# Print heading for Groups.
-	my $col_count = $cat_count + 2 ;
-	print "<tr><th colspan=\"${col_count}\">Group Breakdown</th ></tr >\n" ;
-
-	print "<tr><th >Supervisor</th >" ;
-	for $supercat (@supercats) {
-		print "<th >$supercat</th >" ;
-	}
-	print "<th >Total</th ></tr >\n" ;
-
-	unless ($grpdata) {
-		print "<tr><td colspan=\"${col_count}\">Pick Groups for more detail</td ></tr >\n" ;
-	} else {
-		my $group ;
-		foreach $group (sort keys %{$grpdata}) {
-			if ($group) {
-				print "<tr >" ;
-				print "<td >" ;
-				# print "$group " ;
-				print $all_groups->{$group}->{'grpnme'} ;
-				print "</td >" ;
-				my $tot_poss = 0 ; my $tot_earned = 0 ;
-				for $supercat (@supercats) {
-					my $possible = $grpdata->{$group}->{$supercat}->{'PointsAvail'} ;
-					my $earned = $grpdata->{$group}->{$supercat}->{'PointsEarned'} ;
-					$tot_poss += $possible ;
-					$tot_earned += $earned ;
-					print &rep_cell_str($earned, $possible, 1) ;
-				}
-				print &rep_cell_str($tot_earned, $tot_poss, 1) ;
-				print "</tr>\n" ;
-			}
-		}
-	}
-	print "</table>\n" ;
-
-  print HTMLFooter();
-}
-
-sub rep_cell_str {
-	# Parameters
-	# $count - required, number for the cell, integer.
-	# $total - dividend for the percent, integer.
-	# $skip_tot - Optional, default false.
-	#			If true, do not print total.
-	# Returned Value
-	# $html_str - html string to print for the cell.
-	my ($count, $total, $skip_tot) = @_ ;
-	my $html_str ;
-	$html_str .= "<td align=\"center\">" unless ($skip_tot) ;
-	my ($percent, $percent_str, $count_str) ;
-	$count_str = sprintf("%4i", $count) ;
-	if ($total == 0) {
-		# total is 0, percent is undefined.
-		$percent_str = "-&nbsp;&nbsp;&nbsp;-&nbsp;%" ;
-	} else {
-		$percent = 100.0 * $count / $total ;
-		$percent_str = sprintf("%5.1f&nbsp;%%", $percent) ;
-	}
-	$html_str .= "$count_str</td>" unless ($skip_tot) ;
-	$html_str .= "<td align=\"right\">" ;
-	$html_str .= "$percent_str</td>" ;
-	return $html_str ;
-}
-
-sub ret_test_chooser_mod {
-# Return strings of html to pick a survey.
-# The parameter is an array of arrays with test descriptions and ids.
-# The returned value is an array with two strings.
-#   The first string is JavaScript for the test chooser.
-#   The second string is html for the tables to drive the test chooser.
-  my @trecs = @_;
-  # print STDERR Dumper(\@trecs) ;
-  my ($testscompleted, $testsinprogress, $testspending, $href, $tstoption, $tstoptions);
-	my $html_str = "" ;
-  my $js = "function setTest(oform,test) {\n\t".
-    "oform.tstid.value=test;\n\t".
-    "oform.submit();\n};\n";
-  for (0 .. $#trecs) {
-    my ($desc,$id) ;
-		$desc = $trecs[$_][0] ;
-		$id = $trecs[$_][1] ;
-		# warn "RET_TEST_CHOOSER_MOD ID $id DESC $desc X" ;
-    $testscompleted = CountTestFiles($testcomplete,$CLIENT{'clid'},$id);
-    $testsinprogress = CountTestFiles($testinprog, $CLIENT{'clid'},$id);
-    $testspending = CountTestFiles($testpending, $CLIENT{'clid'},$id);
-    $href="javascript:setTest(document.testform1,\'$id\')\;";
-		my $radio_tst_button ;
-		$radio_tst_button = '<input type="radio" name="tstid" value="' . $id .
-			'" > ' . $id ;
-    $tstoption = " <TR>" .
-    # "<TD valign=top><FONT SIZE=2><a href=\"$href\">$id</a></FONT></TD>" .
-    "<TD valign=top><FONT SIZE=2>$radio_tst_button</FONT></TD>" .
-    "<TD valign=top><FONT SIZE=2>$desc</FONT></TD>" .
-    "<TD align=right valign=top><FONT SIZE=2>$testscompleted</FONT></TD>" .
-    "<TD align=right valign=top><FONT SIZE=2>$testsinprogress</FONT></TD>" .
-    "<TD align=right valign=top><FONT SIZE=2>$testspending</FONT></TD> </TR>\n";
-    $tstoptions = join('', $tstoptions, $tstoption);
-  }
-  $html_str = "<CENTER><B>Please choose the survey for which you would like reports:</B><br>" .
-  # "<form name=\"testform1\" action=\"/cgi-bin/creports.pl\" method=\"Post\">" .
-  # "<input type=\"hidden\" name=\"tid\" value=\"$SESSION{'tid'}\">" .
-  # "<input type=\"hidden\" name=\"tstid\" value=\"\">" .
-  # "<input type=hidden name=\"rptno\" value=\"$FORM{'rptno'}\">" .
-  # "</form>" .
-"<TABLE cellpadding=1 cellspacing=1 border=0 width=\"100\%\">" .
-  "<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
-  "<TR>" .
-    "<TD valign=top><B><FONT SIZE=1>Test ID</FONT></B></TD>" .
-    "<TD valign=top><B><FONT SIZE=1>Description</FONT></B></TD>" .
-    "<TD align=right valign=top><B><FONT SIZE=1>Cmp</FONT></B></TD>" .
-    "<TD align=right valign=top><B><FONT SIZE=1>InP</FONT></B></TD>" .
-    "<TD align=right valign=top><B><FONT SIZE=1>Pnd</FONT></B></TD>" .
-  "</TR>" .
-  "<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
-  $tstoptions .
-  "<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
-	"</TABLE> " ;
-  return ($js, $html_str) ;
-}
-

survey-nginx/cgi-bin/Likert_Gen_Groups.pl.bu20131217

@@ -1,517 +0,0 @@
-#!/usr/bin/perl
-#
-# Source File: Likert_Gen_Groups.pl
-
-# Get config
-use FileHandle;
-use Time::Local;
-use Data::Dumper;
-use IntegroLib;
-require 'sitecfg.pl';
-require 'testlib.pl';
-require 'tstatlib.pl';
-require 'LikertData.pl' ;
-require 'grepa.pm' ;
-
-use strict;
-use vars qw(%FORM %SESSION %CLIENT %TEST_SESSION %SUBTEST_QUESTIONS %TEST
-	    %SUBTEST_SUMMARY %CANDIDATE %SUBTEST_ANSWERS %SYSTEM %REPORT
-	    %SUBTEST_RESPONSES @xlatphrase);
-use vars qw($testcomplete $cgiroot $pathsep $dataroot @rptparams );
-use vars qw($testinprog $testpending) ;
-
-# &app_initialize;
-
-$FORM{"idlist"} =~ tr/\000/,/ ; # Change separator for multiple values from NULL to comma.  HBI
-
-&LanguageSupportInit();
-# print STDERR Dumper(\%FORM);
-&get_client_profile($SESSION{'clid'});
-# warn "Tstid $FORM{'tstid'}\n" ;
-&get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
-
-# Make sure we have a valid session, and exit if we don't
-if (not &get_session($FORM{'tid'})) {
-    exit(0);
-}
-
-# Get the group filters, if any
-my ($idlist,$groups);
-if (exists $FORM{'grouping'} and $FORM{'grouping'} eq 'subset') {
-    #my @tmp = split(/,/,$FORM{'idlist'});
-    my @tmp = param('idlist');
-    $FORM{'idlist'} = join(',', @tmp);
-    @{$groups}{@tmp} = @tmp;
-    $idlist = &getIdlist($CLIENT{'clid'},$FORM{'idlist'});
-}
-
-# Get the time stamp style
-my $timestamp;
-if ($FORM{'timestamp'} eq 'currenttime') {
-    $timestamp = scalar(localtime(time));
-} elsif ($FORM{"timestamp"} eq 'custom' and $FORM{'customtime'} ne '') {
-    $timestamp = $FORM{'customtime'};
-} elsif ($FORM{'timestamp'} eq 'mostrecent' and $FORM{'tstid'}) {
-    my $file = join($pathsep,$testcomplete,"$CLIENT{'clid'}.$FORM{'tstid'}.history");
-    my $fh = new FileHandle;
-    if ($fh->open($file)) {
-	my @history = map([split(/(?:<<>>|&)/,$_,4)],<$fh>);
-	# print "<pre>".Dumper(\@history)."</pre>";
-	if (defined $idlist) {
-	    foreach (reverse @history) {
-		if (exists $idlist->{$_->[2]}) {
-		    $timestamp = scalar(localtime(toGMSeconds($_->[0])));
-		    last;
-		}
-	    }
-	} else {
-	    $timestamp = scalar(localtime(toGMSeconds($history[$#history]->[0])));
-	}
-    } else {
-	print STDERR "Could not open $file in Integro.pl\n";
-    }
-}
-if (defined $timestamp) {
-    $timestamp = "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$timestamp</b></font><br><BR>\n";
-} else {
-    $timestamp = "<br>\n";
-}
-
-# Generate the reports
-if ($FORM{'reportname'} eq 'LikertWQ') {
-    &LikertWQ($idlist, $groups, $timestamp);
-	} elsif ($FORM{'reportname'} eq 'LikertWQG') {
-		&LikertWQG($idlist, $groups, $timestamp);
-	} else {
-    &ReportChooser();
-	}
-
-# There should only be function definitions beyond this point.
-exit(0);
-
-sub HTMLHeader {
-	return "<html>\n<head>\n<title>$_[0]</title>\n".
-	"<!--Integro3.pl-->\n".
-	"<script language=\"JavaScript\">\n<!-- \n$_[1]\n -->\n</script>\n</head>\n".
-	"<BODY BACKGROUND=\"$SYSTEM{'BACKGROUND'}\" BGCOLOR=\"$SYSTEM{'BGCOLOR'}\"".
-	" TEXT=\"$SYSTEM{'TEXT'}\" LINK=\"$SYSTEM{'LINK'}\"".
-	" VLINK=\"$SYSTEM{'VLINK'}\" ALINK=\"$SYSTEM{'ALINK'}\">\n";
-}
-
-sub HTMLHeaderPlain {
-    return "<html>\n<head>\n<title>$_[0]</title>\n".
-	"<script language=\"JavaScript\">\n<!-- \n$_[1]\n -->\n</script>\n</head>\n".
-	"<BODY>\n";
-}
-
-sub HTMLFooter {
-    my $year = `date +%Y`;
-    my $ionline;
-    if ($ENV{'SERVER_NAME'} =~ "integroonline.com") {
-	$ionline = "<br>Copyright (c) $year, Integro Learning Company";
-    }
-    return "<br><center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">Copyright (c) $year, ACTS Corporation$ionline<center></font></body>\n</html>\n";
-}
-
-sub ReportChooser {
-    # Links w/javascript for chosing report
-    # Radio button to choose between all and select group(s)
-    # Menu box to chose one or more groups
-    my $groups = &getGroups($CLIENT{'clid'});
-    my $js = "function parmsIntegro(oform,rpt) {\n\t".
-	"oform.reportname.value=rpt;\n\t".
-	"oform.action='/cgi-bin/creports.pl';\n\t".
-	"oform.submit();\n};\n";
-    $js .= "\nfunction commIntegro(oform) {\n\t".
-	"oform.rptid.value='ACT-C-004';\n\t".
-	"oform.rptdesc.value='Test Statistics by Test'\n\t".
-	"oform.action='/cgi-bin/IntegroTS.pl';\n\t".
-	"oform.submit();\n};\n";
-    my $organizationname = $CLIENT{'clnmc'};
-    my $uberheader;
-		my $TESTS = get_data_hash ("tests.$CLIENT{'clid'}") ;
-		# print STDERR Dumper($TESTS) ;
-		my %TESTS = %$TESTS ;
-    my @test_list = () ;
-		my $ids ;
-		for $ids (keys %TESTS) {
-			# warn "ID $ids DATADESC $TESTS{$ids}->{'desc'} X" ;
-			push @test_list, [$TESTS{$ids}->{'desc'}, $ids] ;
-		}
-		# warn "test_list count $#test_list X\n" ;
-  	# print STDERR Dumper(\@test_list) ;
-		my ($js1, $test_choice_html) = ret_test_chooser_mod(@test_list) ;
-
-    #print STDERR get_data("tests.$CLIENT{'clid'}");
-    #print STDERR "Test ID = $tstid\n"; 
-    print HTMLHeader("Integro Learning Custom Reports",$js . $js1);
-    print "<form name=\"integrorpt\" action=\"/cgi-bin/creports.pl\" method=\"Post\" target=\"rptwindow\" enctype=\"multipart/form-data\" >\n";
-    print "<input type=\"hidden\" name=\"tid\" value=\"$SESSION{'tid'}\">\n";
-    # For development purposes we hardcode the survey id.
-    # Fix this before production
-    # print "<input type=hidden name=\"tstid\" value=\"\">\n"; # HBI This had a value of $tstid
-    print "<input type=hidden name=\"rptno\" value=\"$FORM{'rptno'}\">\n";
-    print "<input type=hidden name=\"rptdesc\" value=\"$REPORT{'rptdesc'}\">\n";
-    print "<input type=hidden name=\"rptid\" value=\"$REPORT{'rptid'}\">\n";
-    print "<input type=\"hidden\" name=\"reportname\" value=\"\">\n";
-    
-    print "<center>\n<table border>\n<caption>Integro Learning Custom Reports</Caption>\n".
-	"<tr><td valign=\"top\"><input type=\"radio\" name=\"grouping\" value=\"all\" checked>All Groups</td>\n".
-	"<td valign=\"top\"><input type=\"radio\" name=\"grouping\" value=\"subset\">Choose Groups<br>\n".
-        "<select name=\"idlist\" onchange='this.form.grouping[1].click();' multiple>\n";
-    foreach (sort {$a->{'grpnme'} cmp $b->{'grpnme'}} values %$groups) {
-	print "<option value=\"$_->{'grpid'}\">$_->{'grpnme'}</option>\n";
-    }
-    print "</select>\n";
-    #print "<tr><td colspan=\"2\">$xlatphrase[797] $xlatphrase[279]: <input type=\"text\" name=\"orgname\" value=\"$organizationname\"></td></tr>\n";
-    print "<tr><td colspan=\"3\"><table border=0><tr><td>Organization Name:</td><td><input type=\"text\" name=\"orgname\" value=\"$organizationname\"></td></tr>\n";
-    print "<tr><td>Header Override:</td><td><input type=\"text\" name=\"uberheader\" value=\"$uberheader\"></td></tr></table></tr></td>\n";
-    print "<tr><td colspan=\"2\">Time Stamp:<ul style=\"list-style: none\">".
-	"<li><input type=\"radio\" name=\"timestamp\" value=\"mostrecent\" checked>Most Recent Survey Taken</li>".
-	"<li><input type=\"radio\" name=\"timestamp\" value=\"currenttime\">Current Time</li>".
-	"<li><input type=\"radio\" name=\"timestamp\" value=\"custom\">Custom Value: ".
-	"<input type=\"text\" name=\"customtime\"></li></tr></td>";
-    print "</table></center>\n";
-		print $test_choice_html ;
-    print "<p>Likert Scale Report" ;
-		print "<ul style=\"list-style: none\">" ;
-		print "<li><a href=\"javascript:parmsIntegro(document.integrorpt,'LikertWQ');\">Likert Scale</a> - No Response is zero, Question Numbers listed.</li>\n" ;
-		print "<li><a href=\"javascript:parmsIntegro(document.integrorpt,'LikertWQG');\">Likert Scale by Group</a> - No Response is zero, Detail by Groups.</li>\n" ;
-		print "</ul></p>\n" ;
-    print "<input type=hidden name=\"testsummary\" value=\"composite\">\n";
-    print "<input type=hidden name=\"showcmts\" value=\"donot\">\n";
-    print "</form>";
-    print HTMLFooter();
-}
-
-sub LikertWQ {
-	# This does the Summary on the Likert Scale questions,
-	#   for everybody, or the Groups selected.
-	# $idlist is the list of candidate ids to report on.  It is undef when all groups (everyone) is choosen.
-	#    It is a reference to a hash.  The keys are the candidate ids, and the value is 1 for candidates in the choosen groups.
-	# $groups is the hash of groups to report on.  It is undef when all groups (everyone) is choosen.
-	#    It is a reference to a hash.  The keys are the group ids, and the values are the group ids.
-	# $FORM{'idlist'} is a comma separated list of the group ids of the selected groups.
-	# $FORM{'grouping'} is "subset" when the report should only cover the selected groups.
-	# $FORM{'grouping'} is "all" when the report should cover everybody.
-  # HBI - Pick it up here.
-  my ($idlist,$groups,$timestamp) = @_;
-  my $all_groups = getGroups($CLIENT{'clid'}) ;
-	my $group_membership_required ;
-	if ($groups) {
-		$group_membership_required = 1 ;
-		my $group_p ;
-		for $group_p (keys %{$all_groups}) {
-			unless ($groups->{$group_p}) {
-				undef $all_groups->{$group_p} ;
-			}
-		}
-	} else {
-		$group_membership_required = 0 ;
-	}
-	my ($sumdata, $grpdata) = &GetFullLikertGrpData($CLIENT{'clid'},$TEST{'id'},$all_groups, $group_membership_required) ;
-	# warn "sumdata" ;
-	# warn &Dumper(\$sumdata) ;
-  # warn "grpdata" ;
-	# warn &Dumper(\$grpdata) ;
-
-  print HTMLHeaderPlain("Likert Scale General Results");
-  print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\">" ;
-	print "<b>Likert Scale General Results<br>" ;
-	print "Survey/Test $TEST{'desc'}</b></font><br><br>\n";
-  # print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>Improvement as Perceived by Employees</b></font><br>\n";
-  # print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$FORM{'orgname'}</b></font><br>\n";
-  if ($FORM{'uberheader'} ne "") {
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>".$FORM{'uberheader'}."</b></font><br>\n";
-  } elsif (defined $idlist) {
-		print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Summary for Groups: "
-	    .join(", ",map($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n" ;
-  } else {
-		print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
-  }
-  print $timestamp;
-  print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">" ;
-
-	my (@img_labels, @img_data) ;
-	my (@values2, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum) ;
-	my ($colorscheme, $t_margin, $b_margin, $l_margin, $r_margin ) ;
-	@img_labels = () ; @img_data = () ; @values2 = () ;
-	($t_margin, $b_margin, $l_margin, $r_margin) = (0, 0, 0, 30) ;
-	($xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, $colorscheme) =
-		(800, 100, 1, "$CLIENT{'clnmc'}", "Category", "Percent for Category", 100, 0, 10, 1) ;
-
-	# Print HTML for heading.
-	print "<b><table border>\n";
-
-	# Print first row.
-	print "<tr>" ;
-	print "<th colspan=\"5\">Category Scores</th>" ;
-	print "</tr>\n" ;
-
-	# Print second row. Heading for each column.
-	print "<tr>" ;
-	print "<th>Category</th>" ;
-	print "<th>Questions</th>" ;
-	print "<th>Points Possible</th>" ;
-	print "<th>Points Earned</th>" ;
-	print "<th>% Earned</th>" ;
-	print "</tr>\n" ;
-
-	# Loop for Categories.
-	my $tot_poss = 0 ; my $tot_earned = 0 ;
-  my $supercat ; my $text_summ = "<p align=left></b>" ;
-	$text_summ .= '<font face="Times New Roman, Times New Roman, Times New Roman, Times New Roman" size=3>' ;
-	$text_summ .= "Category: Percent<br>\n" ;
-	my @supercats = sort keys %{$sumdata} ;
-	for $supercat (@supercats) {
-		my $questions = "" ;
-		my $possible = 0 ;
-		my $earned = 0 ;
-		$questions = join(", ", sort keys %{$sumdata->{$supercat}->{'Questions'}}) ;
-		$possible = $sumdata->{$supercat}->{'PointsAvail'} ;
-		$earned = $sumdata->{$supercat}->{'PointsEarned'} ;
-		$tot_poss += $possible ;
-		$tot_earned += $earned ;
-		print "<tr>" ;
-		print "<th>$supercat</th>" ;
-		print "<td>$questions</td>" ;
-		print "<td>$possible</td>" ;
-		print &rep_cell_str($earned, $possible) ;
-		push @img_labels, $supercat ;
-		my ($percent) = int ((100.0 * $earned / $possible) +0.5) ;
-		push @img_data, $percent ;
-		$text_summ .= $supercat . ": " . $percent . "&nbsp;%<br>\n" ;
-		$ydim += 15 ; # add length to the chart for another row.
-		print "</tr>\n" ;
-	}
-	
-	# Print Total row.
-	print "<tr>" ;
-	print "<th colspan=\"2\">Total</th>" ;
-	print "<td>$tot_poss</td>" ;
-	push @img_labels, "Total" ;
-	my ($percent) = int ((100.0 * $tot_earned / $tot_poss) +0.5) ;
-	push @img_data, $percent ;
-	$text_summ .= "Total" . ": " . $percent . "&nbsp;%<br>\n" ;
-	$ydim += 15 ; # add length to the chart for another row.
-	print &rep_cell_str($tot_earned, $tot_poss) ;
-	print "</tr>\n" ;
-
-	print "</tr>\n" ;
-	print "</table>\n" ;
-	print $text_summ ;
-
-	if (@supercats) {
-		print "<br><br>\n" ;
-		print BuildBarGraph(\@img_labels, \@img_data, \@values2, $xdim, 
-			$ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, 
-			$colorscheme, $t_margin, $b_margin, $l_margin, $r_margin) ;
-		print "<br><br>\n" ;
-	}
-
-  print HTMLFooter();
-}
-
-sub LikertWQG {
-	# This does the Summary on the Likert Scale questions,
-	#   for everybody, or just groups, and lists group results.
-	# $idlist is the list of candidate ids to report on.  It is undef when all groups (everyone) is choosen.
-	#    It is a reference to a hash.  The keys are the candidate ids, and the value is 1 for candidates in the choosen groups.
-	# $groups is the hash of groups to report on.  It is undef when all groups (everyone) is choosen.
-	#    It is a reference to a hash.  The keys are the group ids, and the values are the group ids.
-	# $FORM{'idlist'} is a comma separated list of the group ids of the selected groups.
-	# $FORM{'grouping'} is "subset" when the report should only cover the selected groups.
-	# $FORM{'grouping'} is "all" when the report should cover everybody.
-  # HBI - Pick it up here.
-  my ($idlist,$groups,$timestamp) = @_;
-  my $all_groups = getGroups($CLIENT{'clid'}) ;
-	my $group_membership_required ;
-	if ($groups) {
-		$group_membership_required = 1 ;
-		my $group_p ;
-		for $group_p (keys %{$all_groups}) {
-			unless ($groups->{$group_p}) {
-				undef $all_groups->{$group_p} ;
-			}
-		}
-	} else {
-		$group_membership_required = 0 ;
-	}
-	my ($sumdata, $grpdata) = &GetFullLikertGrpData($CLIENT{'clid'},$TEST{'id'},$all_groups, $group_membership_required) ;
-	# warn "sumdata" ;
-	# warn &Dumper(\$sumdata) ;
-  # warn "grpdata" ;
-	# warn &Dumper(\$grpdata) ;
-
-  print HTMLHeaderPlain("Likert Scale Group Results");
-  print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\">" ;
-	print "<b>Likert Scale Group Results<br>" ;
-	print "Survey/Test $TEST{'desc'}</b></font><br><br>\n";
-  # print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>Improvement as Perceived by Employees</b></font><br>\n";
-  # print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$FORM{'orgname'}</b></font><br>\n";
-  if ($FORM{'uberheader'} ne "") {
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>".$FORM{'uberheader'}."</b></font><br>\n";
-  } elsif (defined $idlist) {
-		print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Summary for Groups: "
-	    .join(", ",map($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n" ;
-  } else {
-		print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
-  }
-  print $timestamp;
-  print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">" ;
-
-	# Print HTML for heading.
-	print "<b><table border>\n";
-
-	my $cat_count = keys %{$sumdata} ; # Number of categories.
-	# Print first row.
-	print "<tr>" ;
-	print "<th ></th>" ;
-  my $supercat ;
-	foreach $supercat (sort keys %{$sumdata}) {
-		print "<th >$supercat</th>\n" ;
-	}
-	print "<th >Total</th>" ;
-	print "</tr>\n" ;
-
-	# Print second row. Heading for each column.
-	# Loop for Categories.
-	my $tot_poss = 0 ; my $tot_earned = 0 ;
-	print "<tr>" ;
-	print "<td >Overall</td >\n" ;
-	my @supercats = sort keys %{$sumdata} ;
-	for $supercat (@supercats) {
-		# my $questions = "" ;
-		my $possible = 0 ;
-		my $earned = 0 ;
-		# $questions = join(", ", sort keys %{$sumdata->{$supercat}->{'Questions'}}) ;
-		$possible = $sumdata->{$supercat}->{'PointsAvail'} ;
-		$earned = $sumdata->{$supercat}->{'PointsEarned'} ;
-		$tot_poss += $possible ;
-		$tot_earned += $earned ;
-		print &rep_cell_str($earned, $possible, 1) ;
-	}
-	print &rep_cell_str($tot_earned, $tot_poss, 1) ;
-	print "</tr>\n" ;
-
-	# Print heading for Groups.
-	my $col_count = $cat_count + 2 ;
-	print "<tr><th colspan=\"${col_count}\">Group Breakdown</th ></tr >\n" ;
-
-	print "<tr><th >Supervisor</th >" ;
-	for $supercat (@supercats) {
-		print "<th >$supercat</th >" ;
-	}
-	print "<th >Total</th ></tr >\n" ;
-
-	unless ($grpdata) {
-		print "<tr><td colspan=\"${col_count}\">Pick Groups for more detail</td ></tr >\n" ;
-	} else {
-		my $group ;
-		foreach $group (sort keys %{$grpdata}) {
-			if ($group) {
-				print "<tr >" ;
-				print "<td >" ;
-				# print "$group " ;
-				print $all_groups->{$group}->{'grpnme'} ;
-				print "</td >" ;
-				my $tot_poss = 0 ; my $tot_earned = 0 ;
-				for $supercat (@supercats) {
-					my $possible = $grpdata->{$group}->{$supercat}->{'PointsAvail'} ;
-					my $earned = $grpdata->{$group}->{$supercat}->{'PointsEarned'} ;
-					$tot_poss += $possible ;
-					$tot_earned += $earned ;
-					print &rep_cell_str($earned, $possible, 1) ;
-				}
-				print &rep_cell_str($tot_earned, $tot_poss, 1) ;
-				print "</tr>\n" ;
-			}
-		}
-	}
-	print "</table>\n" ;
-
-  print HTMLFooter();
-}
-
-sub rep_cell_str {
-	# Parameters
-	# $count - required, number for the cell, integer.
-	# $total - dividend for the percent, integer.
-	# $skip_tot - Optional, default false.
-	#			If true, do not print total.
-	# Returned Value
-	# $html_str - html string to print for the cell.
-	my ($count, $total, $skip_tot) = @_ ;
-	my $html_str ;
-	$html_str .= "<td align=\"center\">" unless ($skip_tot) ;
-	my ($percent, $percent_str, $count_str) ;
-	$count_str = sprintf("%4i", $count) ;
-	if ($total == 0) {
-		# total is 0, percent is undefined.
-		$percent_str = "-&nbsp;&nbsp;&nbsp;-&nbsp;%" ;
-	} else {
-		$percent = 100.0 * $count / $total ;
-		$percent_str = sprintf("%5.1f&nbsp;%%", $percent) ;
-	}
-	$html_str .= "$count_str</td>" unless ($skip_tot) ;
-	$html_str .= "<td align=\"right\">" ;
-	$html_str .= "$percent_str</td>" ;
-	return $html_str ;
-}
-
-sub ret_test_chooser_mod {
-# Return strings of html to pick a survey.
-# The parameter is an array of arrays with test descriptions and ids.
-# The returned value is an array with two strings.
-#   The first string is JavaScript for the test chooser.
-#   The second string is html for the tables to drive the test chooser.
-  my @trecs = @_;
-  # print STDERR Dumper(\@trecs) ;
-  my ($testscompleted, $testsinprogress, $testspending, $href, $tstoption, $tstoptions);
-	my $html_str = "" ;
-  my $js = "function setTest(oform,test) {\n\t".
-    "oform.tstid.value=test;\n\t".
-    "oform.submit();\n};\n";
-  for (0 .. $#trecs) {
-    my ($desc,$id) ;
-		$desc = $trecs[$_][0] ;
-		$id = $trecs[$_][1] ;
-		# warn "RET_TEST_CHOOSER_MOD ID $id DESC $desc X" ;
-    $testscompleted = CountTestFiles($testcomplete,$CLIENT{'clid'},$id);
-    $testsinprogress = CountTestFiles($testinprog, $CLIENT{'clid'},$id);
-    $testspending = CountTestFiles($testpending, $CLIENT{'clid'},$id);
-    $href="javascript:setTest(document.testform1,\'$id\')\;";
-		my $radio_tst_button ;
-		$radio_tst_button = '<input type="radio" name="tstid" value="' . $id .
-			'" > ' . $id ;
-    $tstoption = " <TR>" .
-    # "<TD valign=top><FONT SIZE=2><a href=\"$href\">$id</a></FONT></TD>" .
-    "<TD valign=top><FONT SIZE=2>$radio_tst_button</FONT></TD>" .
-    "<TD valign=top><FONT SIZE=2>$desc</FONT></TD>" .
-    "<TD align=right valign=top><FONT SIZE=2>$testscompleted</FONT></TD>" .
-    "<TD align=right valign=top><FONT SIZE=2>$testsinprogress</FONT></TD>" .
-    "<TD align=right valign=top><FONT SIZE=2>$testspending</FONT></TD> </TR>\n";
-    $tstoptions = join('', $tstoptions, $tstoption);
-  }
-  $html_str = "<CENTER><B>Please choose the survey for which you would like reports:</B><br>" .
-  # "<form name=\"testform1\" action=\"/cgi-bin/creports.pl\" method=\"Post\">" .
-  # "<input type=\"hidden\" name=\"tid\" value=\"$SESSION{'tid'}\">" .
-  # "<input type=\"hidden\" name=\"tstid\" value=\"\">" .
-  # "<input type=hidden name=\"rptno\" value=\"$FORM{'rptno'}\">" .
-  # "</form>" .
-"<TABLE cellpadding=1 cellspacing=1 border=0 width=\"100\%\">" .
-  "<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
-  "<TR>" .
-    "<TD valign=top><B><FONT SIZE=1>Test ID</FONT></B></TD>" .
-    "<TD valign=top><B><FONT SIZE=1>Description</FONT></B></TD>" .
-    "<TD align=right valign=top><B><FONT SIZE=1>Cmp</FONT></B></TD>" .
-    "<TD align=right valign=top><B><FONT SIZE=1>InP</FONT></B></TD>" .
-    "<TD align=right valign=top><B><FONT SIZE=1>Pnd</FONT></B></TD>" .
-  "</TR>" .
-  "<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
-  $tstoptions .
-  "<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
-	"</TABLE> " ;
-  return ($js, $html_str) ;
-}
-

survey-nginx/cgi-bin/Likert_Gen_Groups.pl.bu20131221

@@ -1,518 +0,0 @@
-#!/usr/bin/perl
-#
-# Source File: Likert_Gen_Groups.pl
-
-# Get config
-use FileHandle;
-use Time::Local;
-use Data::Dumper;
-use IntegroLib;
-require 'sitecfg.pl';
-require 'testlib.pl';
-require 'tstatlib.pl';
-require 'LikertData.pl' ;
-require 'grepa.pm' ;
-
-use strict;
-use vars qw(%FORM %SESSION %CLIENT %TEST_SESSION %SUBTEST_QUESTIONS %TEST
-	    %SUBTEST_SUMMARY %CANDIDATE %SUBTEST_ANSWERS %SYSTEM %REPORT
-	    %SUBTEST_RESPONSES @xlatphrase);
-use vars qw($testcomplete $cgiroot $pathsep $dataroot @rptparams );
-use vars qw($testinprog $testpending) ;
-
-# &app_initialize;
-
-$FORM{"idlist"} =~ tr/\000/,/ ; # Change separator for multiple values from NULL to comma.  HBI
-
-&LanguageSupportInit();
-# print STDERR Dumper(\%FORM);
-&get_client_profile($SESSION{'clid'});
-# warn "Tstid $FORM{'tstid'}\n" ;
-&get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
-
-# Make sure we have a valid session, and exit if we don't
-if (not &get_session($FORM{'tid'})) {
-    exit(0);
-}
-
-# Get the group filters, if any
-my ($idlist,$groups);
-if (exists $FORM{'grouping'} and $FORM{'grouping'} eq 'subset') {
-    #my @tmp = split(/,/,$FORM{'idlist'});
-    my @tmp = param('idlist');
-    $FORM{'idlist'} = join(',', @tmp);
-    @{$groups}{@tmp} = @tmp;
-    $idlist = &getIdlist($CLIENT{'clid'},$FORM{'idlist'});
-}
-
-# Get the time stamp style
-my $timestamp;
-if ($FORM{'timestamp'} eq 'currenttime') {
-    $timestamp = scalar(localtime(time));
-} elsif ($FORM{"timestamp"} eq 'custom' and $FORM{'customtime'} ne '') {
-    $timestamp = $FORM{'customtime'};
-} elsif ($FORM{'timestamp'} eq 'mostrecent' and $FORM{'tstid'}) {
-    my $file = join($pathsep,$testcomplete,"$CLIENT{'clid'}.$FORM{'tstid'}.history");
-    my $fh = new FileHandle;
-    if ($fh->open($file)) {
-	my @history = map([split(/(?:<<>>|&)/,$_,4)],<$fh>);
-	# print "<pre>".Dumper(\@history)."</pre>";
-	if (defined $idlist) {
-	    foreach (reverse @history) {
-		if (exists $idlist->{$_->[2]}) {
-		    $timestamp = scalar(localtime(toGMSeconds($_->[0])));
-		    last;
-		}
-	    }
-	} else {
-	    $timestamp = scalar(localtime(toGMSeconds($history[$#history]->[0])));
-	}
-    } else {
-	print STDERR "Could not open $file in Integro.pl\n";
-    }
-}
-if (defined $timestamp) {
-    $timestamp = "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$timestamp</b></font><br><BR>\n";
-} else {
-    $timestamp = "<br>\n";
-}
-
-# Generate the reports
-if ($FORM{'reportname'} eq 'LikertWQ') {
-    &LikertWQ($idlist, $groups, $timestamp);
-	} elsif ($FORM{'reportname'} eq 'LikertWQG') {
-		&LikertWQG($idlist, $groups, $timestamp);
-	} else {
-    &ReportChooser();
-	}
-
-# There should only be function definitions beyond this point.
-exit(0);
-
-sub HTMLHeader {
-	return "<html>\n<head>\n<title>$_[0]</title>\n".
-	"<!--Integro3.pl-->\n".
-	"<script language=\"JavaScript\">\n<!-- \n$_[1]\n -->\n</script>\n</head>\n".
-	"<BODY BACKGROUND=\"$SYSTEM{'BACKGROUND'}\" BGCOLOR=\"$SYSTEM{'BGCOLOR'}\"".
-	" TEXT=\"$SYSTEM{'TEXT'}\" LINK=\"$SYSTEM{'LINK'}\"".
-	" VLINK=\"$SYSTEM{'VLINK'}\" ALINK=\"$SYSTEM{'ALINK'}\">\n";
-}
-
-sub HTMLHeaderPlain {
-    return "<html>\n<head>\n<title>$_[0]</title>\n".
-	"<script language=\"JavaScript\">\n<!-- \n$_[1]\n -->\n</script>\n</head>\n".
-	"<BODY>\n";
-}
-
-sub HTMLFooter {
-    my $year = `date +%Y`;
-    my $ionline;
-    if ($ENV{'SERVER_NAME'} =~ "integroonline.com") {
-	$ionline = "<br>Copyright (c) $year, Integro Learning Company";
-    }
-    return "<br><center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">Copyright (c) $year, ACTS Corporation$ionline<center></font></body>\n</html>\n";
-}
-
-sub ReportChooser {
-    # Links w/javascript for chosing report
-    # Radio button to choose between all and select group(s)
-    # Menu box to chose one or more groups
-    my $groups = &getGroups($CLIENT{'clid'});
-    my $js = "function parmsIntegro(oform,rpt) {\n\t".
-	"oform.reportname.value=rpt;\n\t".
-	"oform.action='/cgi-bin/creports.pl';\n\t".
-	"oform.submit();\n};\n";
-    $js .= "\nfunction commIntegro(oform) {\n\t".
-	"oform.rptid.value='ACT-C-004';\n\t".
-	"oform.rptdesc.value='Test Statistics by Test'\n\t".
-	"oform.action='/cgi-bin/IntegroTS.pl';\n\t".
-	"oform.submit();\n};\n";
-    my $organizationname = $CLIENT{'clnmc'};
-    my $uberheader;
-		my $TESTS = get_data_hash ("tests.$CLIENT{'clid'}") ;
-		# print STDERR Dumper($TESTS) ;
-		my %TESTS = %$TESTS ;
-    my @test_list = () ;
-		my $ids ;
-		for $ids (keys %TESTS) {
-			# warn "ID $ids DATADESC $TESTS{$ids}->{'desc'} X" ;
-			push @test_list, [$TESTS{$ids}->{'desc'}, $ids] ;
-		}
-		# warn "test_list count $#test_list X\n" ;
-  	# print STDERR Dumper(\@test_list) ;
-		my ($js1, $test_choice_html) = ret_test_chooser_mod(@test_list) ;
-
-    #print STDERR get_data("tests.$CLIENT{'clid'}");
-    #print STDERR "Test ID = $tstid\n"; 
-    print HTMLHeader("Integro Learning Custom Reports",$js . $js1);
-    print "<form name=\"integrorpt\" action=\"/cgi-bin/creports.pl\" method=\"Post\" target=\"rptwindow\" enctype=\"multipart/form-data\" >\n";
-    print "<input type=\"hidden\" name=\"tid\" value=\"$SESSION{'tid'}\">\n";
-    # For development purposes we hardcode the survey id.
-    # Fix this before production
-    # print "<input type=hidden name=\"tstid\" value=\"\">\n"; # HBI This had a value of $tstid
-    print "<input type=hidden name=\"rptno\" value=\"$FORM{'rptno'}\">\n";
-    print "<input type=hidden name=\"rptdesc\" value=\"$REPORT{'rptdesc'}\">\n";
-    print "<input type=hidden name=\"rptid\" value=\"$REPORT{'rptid'}\">\n";
-    print "<input type=\"hidden\" name=\"reportname\" value=\"\">\n";
-    
-    print "<center>\n<table border>\n<caption>Integro Learning Custom Reports</Caption>\n".
-	"<tr><td valign=\"top\"><input type=\"radio\" name=\"grouping\" value=\"all\" checked>All Groups</td>\n".
-	"<td valign=\"top\"><input type=\"radio\" name=\"grouping\" value=\"subset\">Choose Groups<br>\n".
-        "<select name=\"idlist\" onchange='this.form.grouping[1].click();' multiple>\n";
-    foreach (sort {$a->{'grpnme'} cmp $b->{'grpnme'}} values %$groups) {
-	print "<option value=\"$_->{'grpid'}\">$_->{'grpnme'}</option>\n";
-    }
-    print "</select>\n";
-    #print "<tr><td colspan=\"2\">$xlatphrase[797] $xlatphrase[279]: <input type=\"text\" name=\"orgname\" value=\"$organizationname\"></td></tr>\n";
-    print "<tr><td colspan=\"3\"><table border=0><tr><td>Organization Name:</td><td><input type=\"text\" name=\"orgname\" value=\"$organizationname\"></td></tr>\n";
-    print "<tr><td>Header Override:</td><td><input type=\"text\" name=\"uberheader\" value=\"$uberheader\"></td></tr></table></tr></td>\n";
-    print "<tr><td colspan=\"2\">Time Stamp:<ul style=\"list-style: none\">".
-	"<li><input type=\"radio\" name=\"timestamp\" value=\"mostrecent\" checked>Most Recent Survey Taken</li>".
-	"<li><input type=\"radio\" name=\"timestamp\" value=\"currenttime\">Current Time</li>".
-	"<li><input type=\"radio\" name=\"timestamp\" value=\"custom\">Custom Value: ".
-	"<input type=\"text\" name=\"customtime\"></li></tr></td>";
-    print "</table></center>\n";
-		print $test_choice_html ;
-    print "<p>Likert Scale Report" ;
-		print "<ul style=\"list-style: none\">" ;
-		print "<li><a href=\"javascript:parmsIntegro(document.integrorpt,'LikertWQ');\">Likert Scale</a> - No Response is ignored, Question Numbers listed.</li>\n" ;
-		print "<li><a href=\"javascript:parmsIntegro(document.integrorpt,'LikertWQG');\">Likert Scale by Group</a> - No Response is ignored, Detail by Groups.</li>\n" ;
-		print "</ul></p>\n" ;
-    print "<input type=hidden name=\"testsummary\" value=\"composite\">\n";
-    print "<input type=hidden name=\"showcmts\" value=\"donot\">\n";
-    print "</form>";
-    print HTMLFooter();
-}
-
-sub LikertWQ {
-	# This does the Summary on the Likert Scale questions,
-	#   for everybody, or the Groups selected.
-	# $idlist is the list of candidate ids to report on.  It is undef when all groups (everyone) is choosen.
-	#    It is a reference to a hash.  The keys are the candidate ids, and the value is 1 for candidates in the choosen groups.
-	# $groups is the hash of groups to report on.  It is undef when all groups (everyone) is choosen.
-	#    It is a reference to a hash.  The keys are the group ids, and the values are the group ids.
-	# $FORM{'idlist'} is a comma separated list of the group ids of the selected groups.
-	# $FORM{'grouping'} is "subset" when the report should only cover the selected groups.
-	# $FORM{'grouping'} is "all" when the report should cover everybody.
-  my ($idlist,$groups,$timestamp) = @_;
-  my $ResponseRequired = 1 ; # Do not count a question if it is not responded to.
-  my $all_groups = getGroups($CLIENT{'clid'}) ;
-  my $group_membership_required ;
-  if ($groups) {
-    $group_membership_required = 1 ;
-    my $group_p ;
-    for $group_p (keys %{$all_groups}) {
-      unless ($groups->{$group_p}) {
-	undef $all_groups->{$group_p} ;
-      }
-    }
-  } else {
-    $group_membership_required = 0 ;
-  }
-  my ($sumdata, $grpdata) = &GetFullLikertGrpData($CLIENT{'clid'},$TEST{'id'},$all_groups, $group_membership_required, $ResponseRequired) ;
-  # warn "sumdata" ;
-  # warn &Dumper(\$sumdata) ;
-  # warn "grpdata" ;
-  # warn &Dumper(\$grpdata) ;
-
-  print HTMLHeaderPlain("Likert Scale General Results");
-  print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\">" ;
-	print "<b>Likert Scale General Results<br>" ;
-	print "Survey/Test $TEST{'desc'}</b></font><br><br>\n";
-  # print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>Improvement as Perceived by Employees</b></font><br>\n";
-  # print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$FORM{'orgname'}</b></font><br>\n";
-  if ($FORM{'uberheader'} ne "") {
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>".$FORM{'uberheader'}."</b></font><br>\n";
-  } elsif (defined $idlist) {
-		print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Summary for Groups: "
-	    .join(", ",map($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n" ;
-  } else {
-		print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
-  }
-  print $timestamp;
-  print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">" ;
-
-	my (@img_labels, @img_data) ;
-	my (@values2, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum) ;
-	my ($colorscheme, $t_margin, $b_margin, $l_margin, $r_margin ) ;
-	@img_labels = () ; @img_data = () ; @values2 = () ;
-	($t_margin, $b_margin, $l_margin, $r_margin) = (0, 0, 0, 30) ;
-	($xdim, $ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, $colorscheme) =
-		(800, 100, 1, "$CLIENT{'clnmc'}", "Category", "Percent for Category", 100, 0, 10, 1) ;
-
-	# Print HTML for heading.
-	print "<b><table border>\n";
-
-	# Print first row.
-	print "<tr>" ;
-	print "<th colspan=\"5\">Category Scores</th>" ;
-	print "</tr>\n" ;
-
-	# Print second row. Heading for each column.
-	print "<tr>" ;
-	print "<th>Category</th>" ;
-	print "<th>Questions</th>" ;
-	print "<th>Points Possible</th>" ;
-	print "<th>Points Earned</th>" ;
-	print "<th>% Earned</th>" ;
-	print "</tr>\n" ;
-
-	# Loop for Categories.
-	my $tot_poss = 0 ; my $tot_earned = 0 ;
-  my $supercat ; my $text_summ = "<p align=left></b>" ;
-	$text_summ .= '<font face="Times New Roman, Times New Roman, Times New Roman, Times New Roman" size=3>' ;
-	$text_summ .= "Category: Percent<br>\n" ;
-	my @supercats = sort keys %{$sumdata} ;
-	for $supercat (@supercats) {
-		my $questions = "" ;
-		my $possible = 0 ;
-		my $earned = 0 ;
-		$questions = join(", ", sort map { $_ + 1 } keys %{$sumdata->{$supercat}->{'Questions'}}) ;
-		$possible = $sumdata->{$supercat}->{'PointsAvail'} ;
-		$earned = $sumdata->{$supercat}->{'PointsEarned'} ;
-		$tot_poss += $possible ;
-		$tot_earned += $earned ;
-		print "<tr>" ;
-		print "<th>$supercat</th>" ;
-		print "<td>$questions</td>" ;
-		print "<td>$possible</td>" ;
-		print &rep_cell_str($earned, $possible) ;
-		push @img_labels, $supercat ;
-		my ($percent) = int ((100.0 * $earned / $possible) +0.5) ;
-		push @img_data, $percent ;
-		$text_summ .= $supercat . ": " . $percent . "&nbsp;%<br>\n" ;
-		$ydim += 15 ; # add length to the chart for another row.
-		print "</tr>\n" ;
-	}
-	
-	# Print Total row.
-	print "<tr>" ;
-	print "<th colspan=\"2\">Total</th>" ;
-	print "<td>$tot_poss</td>" ;
-	push @img_labels, "Total" ;
-	my ($percent) = int ((100.0 * $tot_earned / $tot_poss) +0.5) ;
-	push @img_data, $percent ;
-	$text_summ .= "Total" . ": " . $percent . "&nbsp;%<br>\n" ;
-	$ydim += 15 ; # add length to the chart for another row.
-	print &rep_cell_str($tot_earned, $tot_poss) ;
-	print "</tr>\n" ;
-
-	print "</tr>\n" ;
-	print "</table>\n" ;
-	print $text_summ ;
-
-	if (@supercats) {
-		print "<br><br>\n" ;
-		print BuildBarGraph(\@img_labels, \@img_data, \@values2, $xdim, 
-			$ydim, $hbar, $title, $xlabel, $ylabel, $ymax, $ymin, $yticknum, 
-			$colorscheme, $t_margin, $b_margin, $l_margin, $r_margin) ;
-		print "<br><br>\n" ;
-	}
-
-  print HTMLFooter();
-}
-
-sub LikertWQG {
-	# This does the Summary on the Likert Scale questions,
-	#   for everybody, or just groups, and lists group results.
-	# $idlist is the list of candidate ids to report on.  It is undef when all groups (everyone) is choosen.
-	#    It is a reference to a hash.  The keys are the candidate ids, and the value is 1 for candidates in the choosen groups.
-	# $groups is the hash of groups to report on.  It is undef when all groups (everyone) is choosen.
-	#    It is a reference to a hash.  The keys are the group ids, and the values are the group ids.
-	# $FORM{'idlist'} is a comma separated list of the group ids of the selected groups.
-	# $FORM{'grouping'} is "subset" when the report should only cover the selected groups.
-	# $FORM{'grouping'} is "all" when the report should cover everybody.
-  # HBI - Pick it up here.
-  my ($idlist,$groups,$timestamp) = @_;
-  my $ResponseRequired = 1 ; # Do not count questions if there was no response.
-  my $all_groups = getGroups($CLIENT{'clid'}) ;
-	my $group_membership_required ;
-	if ($groups) {
-		$group_membership_required = 1 ;
-		my $group_p ;
-		for $group_p (keys %{$all_groups}) {
-			unless ($groups->{$group_p}) {
-				undef $all_groups->{$group_p} ;
-			}
-		}
-	} else {
-		$group_membership_required = 0 ;
-	}
-	my ($sumdata, $grpdata) = &GetFullLikertGrpData($CLIENT{'clid'},$TEST{'id'},$all_groups, $group_membership_required,$ResponseRequired) ;
-	# warn "sumdata" ;
-	# warn &Dumper(\$sumdata) ;
-  # warn "grpdata" ;
-	# warn &Dumper(\$grpdata) ;
-
-  print HTMLHeaderPlain("Likert Scale Group Results");
-  print "<center><font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"5\">" ;
-	print "<b>Likert Scale Group Results<br>" ;
-	print "Survey/Test $TEST{'desc'}</b></font><br><br>\n";
-  # print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"4\"><b>Improvement as Perceived by Employees</b></font><br>\n";
-  # print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$FORM{'orgname'}</b></font><br>\n";
-  if ($FORM{'uberheader'} ne "") {
-    print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>".$FORM{'uberheader'}."</b></font><br>\n";
-  } elsif (defined $idlist) {
-		print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>Summary for Groups: "
-	    .join(", ",map($all_groups->{$_}->{'grpnme'},split(/,/,$FORM{'idlist'})))."</b></font><br>\n" ;
-  } else {
-		print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"3\"><b>$xlatphrase[798] $xlatphrase[799]</b></font><br>\n";
-  }
-  print $timestamp;
-  print "<font face=\"Verdana, Arial, Helvetica, sans-serif\" size=\"1\">" ;
-
-	# Print HTML for heading.
-	print "<b><table border>\n";
-
-	my $cat_count = keys %{$sumdata} ; # Number of categories.
-	# Print first row.
-	print "<tr>" ;
-	print "<th ></th>" ;
-  my $supercat ;
-	foreach $supercat (sort keys %{$sumdata}) {
-		print "<th >$supercat</th>\n" ;
-	}
-	print "<th >Total</th>" ;
-	print "</tr>\n" ;
-
-	# Print second row. Heading for each column.
-	# Loop for Categories.
-	my $tot_poss = 0 ; my $tot_earned = 0 ;
-	print "<tr>" ;
-	print "<td >Overall</td >\n" ;
-	my @supercats = sort keys %{$sumdata} ;
-	for $supercat (@supercats) {
-		# my $questions = "" ;
-		my $possible = 0 ;
-		my $earned = 0 ;
-		# $questions = join(", ", sort keys %{$sumdata->{$supercat}->{'Questions'}}) ;
-		$possible = $sumdata->{$supercat}->{'PointsAvail'} ;
-		$earned = $sumdata->{$supercat}->{'PointsEarned'} ;
-		$tot_poss += $possible ;
-		$tot_earned += $earned ;
-		print &rep_cell_str($earned, $possible, 1) ;
-	}
-	print &rep_cell_str($tot_earned, $tot_poss, 1) ;
-	print "</tr>\n" ;
-
-	# Print heading for Groups.
-	my $col_count = $cat_count + 2 ;
-	print "<tr><th colspan=\"${col_count}\">Group Breakdown</th ></tr >\n" ;
-
-	print "<tr><th >Supervisor</th >" ;
-	for $supercat (@supercats) {
-		print "<th >$supercat</th >" ;
-	}
-	print "<th >Total</th ></tr >\n" ;
-
-	unless ($grpdata) {
-		print "<tr><td colspan=\"${col_count}\">Pick Groups for more detail</td ></tr >\n" ;
-	} else {
-		my $group ;
-		foreach $group (sort keys %{$grpdata}) {
-			if ($group) {
-				print "<tr >" ;
-				print "<td >" ;
-				# print "$group " ;
-				print $all_groups->{$group}->{'grpnme'} ;
-				print "</td >" ;
-				my $tot_poss = 0 ; my $tot_earned = 0 ;
-				for $supercat (@supercats) {
-					my $possible = $grpdata->{$group}->{$supercat}->{'PointsAvail'} ;
-					my $earned = $grpdata->{$group}->{$supercat}->{'PointsEarned'} ;
-					$tot_poss += $possible ;
-					$tot_earned += $earned ;
-					print &rep_cell_str($earned, $possible, 1) ;
-				}
-				print &rep_cell_str($tot_earned, $tot_poss, 1) ;
-				print "</tr>\n" ;
-			}
-		}
-	}
-	print "</table>\n" ;
-
-  print HTMLFooter();
-}
-
-sub rep_cell_str {
-	# Parameters
-	# $count - required, number for the cell, integer.
-	# $total - dividend for the percent, integer.
-	# $skip_tot - Optional, default false.
-	#			If true, do not print total.
-	# Returned Value
-	# $html_str - html string to print for the cell.
-	my ($count, $total, $skip_tot) = @_ ;
-	my $html_str ;
-	$html_str .= "<td align=\"center\">" unless ($skip_tot) ;
-	my ($percent, $percent_str, $count_str) ;
-	$count_str = sprintf("%4i", $count) ;
-	if ($total == 0) {
-		# total is 0, percent is undefined.
-		$percent_str = "-&nbsp;&nbsp;&nbsp;-&nbsp;%" ;
-	} else {
-		$percent = 100.0 * $count / $total ;
-		$percent_str = sprintf("%5.1f&nbsp;%%", $percent) ;
-	}
-	$html_str .= "$count_str</td>" unless ($skip_tot) ;
-	$html_str .= "<td align=\"right\">" ;
-	$html_str .= "$percent_str</td>" ;
-	return $html_str ;
-}
-
-sub ret_test_chooser_mod {
-# Return strings of html to pick a survey.
-# The parameter is an array of arrays with test descriptions and ids.
-# The returned value is an array with two strings.
-#   The first string is JavaScript for the test chooser.
-#   The second string is html for the tables to drive the test chooser.
-  my @trecs = @_;
-  # print STDERR Dumper(\@trecs) ;
-  my ($testscompleted, $testsinprogress, $testspending, $href, $tstoption, $tstoptions);
-	my $html_str = "" ;
-  my $js = "function setTest(oform,test) {\n\t".
-    "oform.tstid.value=test;\n\t".
-    "oform.submit();\n};\n";
-  for (0 .. $#trecs) {
-    my ($desc,$id) ;
-		$desc = $trecs[$_][0] ;
-		$id = $trecs[$_][1] ;
-		# warn "RET_TEST_CHOOSER_MOD ID $id DESC $desc X" ;
-    $testscompleted = CountTestFiles($testcomplete,$CLIENT{'clid'},$id);
-    $testsinprogress = CountTestFiles($testinprog, $CLIENT{'clid'},$id);
-    $testspending = CountTestFiles($testpending, $CLIENT{'clid'},$id);
-    $href="javascript:setTest(document.testform1,\'$id\')\;";
-		my $radio_tst_button ;
-		$radio_tst_button = '<input type="radio" name="tstid" value="' . $id .
-			'" > ' . $id ;
-    $tstoption = " <TR>" .
-    # "<TD valign=top><FONT SIZE=2><a href=\"$href\">$id</a></FONT></TD>" .
-    "<TD valign=top><FONT SIZE=2>$radio_tst_button</FONT></TD>" .
-    "<TD valign=top><FONT SIZE=2>$desc</FONT></TD>" .
-    "<TD align=right valign=top><FONT SIZE=2>$testscompleted</FONT></TD>" .
-    "<TD align=right valign=top><FONT SIZE=2>$testsinprogress</FONT></TD>" .
-    "<TD align=right valign=top><FONT SIZE=2>$testspending</FONT></TD> </TR>\n";
-    $tstoptions = join('', $tstoptions, $tstoption);
-  }
-  $html_str = "<CENTER><B>Please choose the survey for which you would like reports:</B><br>" .
-  # "<form name=\"testform1\" action=\"/cgi-bin/creports.pl\" method=\"Post\">" .
-  # "<input type=\"hidden\" name=\"tid\" value=\"$SESSION{'tid'}\">" .
-  # "<input type=\"hidden\" name=\"tstid\" value=\"\">" .
-  # "<input type=hidden name=\"rptno\" value=\"$FORM{'rptno'}\">" .
-  # "</form>" .
-"<TABLE cellpadding=1 cellspacing=1 border=0 width=\"100\%\">" .
-  "<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
-  "<TR>" .
-    "<TD valign=top><B><FONT SIZE=1>Test ID</FONT></B></TD>" .
-    "<TD valign=top><B><FONT SIZE=1>Description</FONT></B></TD>" .
-    "<TD align=right valign=top><B><FONT SIZE=1>Cmp</FONT></B></TD>" .
-    "<TD align=right valign=top><B><FONT SIZE=1>InP</FONT></B></TD>" .
-    "<TD align=right valign=top><B><FONT SIZE=1>Pnd</FONT></B></TD>" .
-  "</TR>" .
-  "<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
-  $tstoptions .
-  "<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>" .
-	"</TABLE> " ;
-  return ($js, $html_str) ;
-}
-

survey-nginx/cgi-bin/bargraph_multi.pm.bu20140129

@@ -1,243 +0,0 @@
-#!/usr/bin/perl -w
-#
-# $Id: bargraph_multi.pm
-#
-
-use strict;
-package bargraph_multi ;
-require Exporter ;
-@bargraph_multi::ISA = qw(Exporter) ;
-@bargraph_multi::EXPORT = qw(Build_Labeled_X_Axis_Graph_Str Build_Labeled_X_Axis_Graph_Obj) ;
-@bargraph_multi::EXPORT_OK = qw( ) ;
-use GD;
-use GD::Graph::colour;
-use GD::Graph::bars;
-use GD::Graph::hbars;
-use GD::Graph::bars3d;
-#use Data::Dumper;
-
-# This perl code is builds Graphs using the GD::Graph modules.
-# This code deals with a non-numeric X-Axis.  Each tick on the X-Axis is the name of a group.
-#   The other style has a numeric X-Axis.
-sub Build_Labeled_X_Axis_Graph_Str {
-# The parameters are:
-# $Data_In - A reference to a list of lists.  (aka, Array of Arrays)
-#		Each of the sublists has the same number of elements.
-#      An element might be the undef value.
-#   The first sublist is the names of the groups.
-#   The other sublists are related to the elements in the $Legend parameter.
-# $Legend - A reference to a list.
-#		Each element of the list is the name of a group.
-#   The data for each group is a sublist in the $Data_In parameter.
-# ---- The rest of the parameters are individual options as scalars: numbers, character strings, or undef.
-# The returned value is a list of (reference to the plotted graphical object, and graphic string in the mode.
-	my ($Data_In, $Legend, $Graphic_Mode, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, 
-			$ymax, $ymin, $yticknum, $t_margin, $b_margin, $l_margin, $r_margin, 
-			$colorscheme, $bar_spacing, $bargroup_spacing,
-			$show_values, $x_label_position, $y_label_position, $transparent, $overwrite, 
-			$interlaced, $bgclr, $fgclr, $boxclr, $accentclr, $shadowclr, $shadow_depth,
-			$labelclr, $axislabelclr, $legendclr, $valuesclr, $textclr, $dclrs, $borderclrs,
-			$cycle_clrs, $accent_treshold, $long_ticks, $tick_length, $x_ticks, $y_number_format,
-			$x_label_skip, $y_label_skip, $x_last_label_skip, $x_tick_offset, $x_all_ticks,
-			$x_label_position, $y_label_position, $x_labels_vertical, $x_plot_values, $y_plot_values,
-			$box_axis, $no_axes, $two_axes, $use_axis, $zero_axis, $zero_axis_only, $axis_space,
-			$text_space, $cumulate, $overwrite, $correct_width, $values_vertical, $values_space,
-			$values_format, $legend_placement, $legend_marker_width, $legend_marker_height, $lg_cols
-			) = @_ ;
-	my $Graph_Obj = &Build_Labeled_X_Axis_Graph_Obj 
-	 	($Data_In, $Legend, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, 
-			$ymax, $ymin, $yticknum, $t_margin, $b_margin, $l_margin, $r_margin, 
-			$colorscheme, $bar_spacing, $bargroup_spacing,
-			$show_values, $x_label_position, $y_label_position, $transparent, $overwrite,
-			$interlaced, $bgclr, $fgclr, $boxclr, $accentclr, $shadowclr, $shadow_depth,
-			$labelclr, $axislabelclr, $legendclr, $valuesclr, $textclr, $dclrs, $borderclrs,
-			$cycle_clrs, $accent_treshold, $long_ticks, $tick_length, $x_ticks, $y_number_format,
-			$x_label_skip, $y_label_skip, $x_last_label_skip, $x_tick_offset, $x_all_ticks,
-			$x_label_position, $y_label_position, $x_labels_vertical, $x_plot_values, $y_plot_values,
-			$box_axis, $no_axes, $two_axes, $use_axis, $zero_axis, $zero_axis_only, $axis_space,
-			$text_space, $cumulate, $overwrite, $correct_width, $values_vertical, $values_space,
-			$values_format, $legend_placement, $legend_marker_width, $legend_marker_height, $lg_cols ) ;
-	my $Plotted_Str ;
-	unless (defined $Graph_Obj) {
-		return (undef, "") ;
-	} else {
-		if ($Graphic_Mode =~ m/png/i) {
-			$Plotted_Str = $Graph_Obj -> png ;
-		} elsif ($Graphic_Mode =~ m/gif/i) {
-			$Plotted_Str = $Graph_Obj -> gif ;
-		} else {
-			return ($Graphic_Mode, "Unsupported Graphical Mode $Graph_Obj.\n") ;
-		}
-	}
-	return ($Graph_Obj, $Plotted_Str) ;
-}
-			
-
-sub Build_Labeled_X_Axis_Graph_Obj {
-	my ($Data_In, $Legend, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, 
-			$ymax, $ymin, $yticknum, $t_margin, $b_margin, $l_margin, $r_margin, 
-			$colorscheme, $bar_spacing, $bargroup_spacing,
-			$show_values, $x_label_position, $y_label_position, $transparent, $overwrite,
-			$interlaced, $bgclr, $fgclr, $boxclr, $accentclr, $shadowclr, $shadow_depth,
-			$labelclr, $axislabelclr, $legendclr, $valuesclr, $textclr, $dclrs, $borderclrs,
-			$cycle_clrs, $accent_treshold, $long_ticks, $tick_length, $x_ticks, $y_number_format,
-			$x_label_skip, $y_label_skip, $x_last_label_skip, $x_tick_offset, $x_all_ticks,
-			$x_label_position, $y_label_position, $x_labels_vertical, $x_plot_values, $y_plot_values,
-			$box_axis, $no_axes, $two_axes, $use_axis, $zero_axis, $zero_axis_only, $axis_space,
-			$text_space, $cumulate, $overwrite, $correct_width, $values_vertical, $values_space,
-			$values_format, $legend_placement, $legend_marker_width, $legend_marker_height, $lg_cols ) = @_ ;
-	# $colorscheme is a colon seperated string of colors.
-	my $HBI_Debug_Obj = 0 ;
-	my $Data_In_sublist ; my $Data_In_cnt = 0 ;
-
-	if ($HBI_Debug_Obj) {
-		warn "INFO: " . __FILE__ . " Legend array len is $#{$Legend}.\n" ;
-		foreach $Data_In_sublist (@{$Data_In}) {
-			warn "INFO: Data array len is $#{$Data_In_sublist}.\n" ;
-			$Data_In_cnt ++ ;
-		}
-		warn "INFO: Data array $Data_In_cnt elements.\n" ;
-	}
-
-	my $graph;
-	if ($hbar) {
-    #print STDERR "hbar set\n";
-    $graph = GD::Graph::hbars->new($xdim,$ydim);
-	} else {
-    $graph = GD::Graph::bars->new($xdim,$ydim);
-    #print STDERR "hbar not set\n";
-	}
-	my @ret_colour_names_avail = () ;
-	my %valid_colour_name = () ;
-	@ret_colour_names_avail = GD::Graph::colour::colour_list(59) ;
-	for my $clr_name (@ret_colour_names_avail) {
-  	if (defined $clr_name) {$valid_colour_name{$clr_name} = 1;}
-	}
-
-# The keys of the hash array valid_colour_name are the known color names.
-
-# warn $full_colour_list ;
-# warn "The number of colours is $#ret_colour_names_avail ." ;
-# The colors I found at one time are: pink lbrown lred purple 
-# dblue lpurple green white gold blue dyellow red lgreen marine 
-# dred cyan yellow lblue orange lgray dgreen dbrown lyellow 
-# black gray dpink dgray lorange dpurple
-
-# Set blue yellow if the colorscheme parameter is 1.
-# else use the default.
-if ($colorscheme and $colorscheme ==1) {
-	$graph->set( dclrs => [ qw(blue yellow) ] ); 
-} elsif ($colorscheme) {
-	my @new_colors = split /:/ , $colorscheme ;
-	my $index = 0 ;
-	my $colors = $graph->get('dclrs');
-	my $color ;
-	foreach $color (@new_colors) {
-		if ($valid_colour_name{$color} ) {
-			# warn "Pushed $color ." ;
-			$colors->[$index] = $color ;
-			$index ++ ;
-		} else {
-			warn "Invalid color $color requested." ;
-		}
-	}
-	# warn "Setting dclrs." ;
-	$graph->set( dclrs => $colors) ;
-	# warn "Set dclrs." ;
-}
-
-
-my %opt = ('transparent' => 0,
-	   'x_label_position' => 0.5,
-	   'show_values' => 1,
-	   'y_max_value' => 100,
-	   'overwrite' => 0);
-if ($title) {$opt{'title'} = $title;}
-if ($xlabel) {$opt{'x_label'} = $xlabel;}
-if ($ylabel) {$opt{'y_label'} = $ylabel;}
-if ($ymax) {$opt{'y_max_value'} = $ymax;}
-if ($ymin) {$opt{'y_min_value'} = $ymin;}
-if ($t_margin) {$opt{'t_margin'} = $t_margin;}
-if ($b_margin) {$opt{'b_margin'} = $b_margin;}
-if ($l_margin) {$opt{'l_margin'} = $l_margin;}
-if ($r_margin) {$opt{'r_margin'} = $r_margin;}
-if ($yticknum) {$opt{'y_tick_number'} = $yticknum;}
-if ($bar_spacing) {$opt{'bar_spacing'} = $bar_spacing;}
-if ($bargroup_spacing) {$opt{'bargroup_spacing'} = $bargroup_spacing;}
-if ($show_values) {$opt{'show_values'} = $show_values;}
-if ($x_label_position) {$opt{'x_label_position'} = $x_label_position;}
-if ($y_label_position) {$opt{'y_label_position'} = $y_label_position;}
-if ($transparent) {$opt{'transparent'} = $transparent;}
-if ($overwrite) {$opt{'overwrite'} = $overwrite;}
-if ($interlaced) {$opt{'interlaced'} = $interlaced;}
-if ($bgclr) {$opt{'bgclr'} = $bgclr;}
-if ($fgclr) {$opt{'fgclr'} = $fgclr;}
-if ($boxclr) {$opt{'boxclr'} = $boxclr;}
-if ($accentclr) {$opt{'accentclr'} = $accentclr;}
-if ($shadowclr) {$opt{'shadowclr'} = $shadowclr;}
-if ($shadow_depth) {$opt{'shadow_depth'} = $shadow_depth;}
-if ($labelclr) {$opt{'labelclr'} = $labelclr ;}
-if ($axislabelclr) {$opt{'axislabelclr'} = $axislabelclr ;}
-if ($legendclr) {$opt{'legendclr'} = $legendclr ;}
-if ($valuesclr) {$opt{'valuesclr'} = $valuesclr ;}
-if ($textclr) {$opt{'textclr'} = $textclr ;}
-if ($dclrs) {$opt{'dclrs'} = $dclrs ;}
-if ($borderclrs) {$opt{'borderclrs'} = $borderclrs ;}
-if ($cycle_clrs) {$opt{'cycle_clrs'} = $cycle_clrs ;}
-if ($accent_treshold) {$opt{'accent_treshold'} = $accent_treshold ;}
-if ($long_ticks) {$opt{'long_ticks'} = $long_ticks ;}
-if ($tick_length) {$opt{'tick_length'} = $tick_length ;}
-if ($x_ticks) {$opt{'x_ticks'} = $x_ticks ;}
-if ($y_number_format) {$opt{'y_number_format'} = $y_number_format ;}
-if ($x_label_skip) {$opt{'x_label_skip'} = $x_label_skip ;}
-if ($y_label_skip) {$opt{'y_label_skip'} = $y_label_skip ;}
-if ($x_last_label_skip) {$opt{'x_last_label_skip'} = $x_last_label_skip ;}
-if ($x_tick_offset) {$opt{'x_tick_offset'} = $x_tick_offset ;}
-if ($x_all_ticks) {$opt{'x_all_ticks'} = $x_all_ticks ;}
-if ($x_label_position) {$opt{'x_label_position'} = $x_label_position ;}
-if ($y_label_position) {$opt{'y_label_position'} = $y_label_position ;}
-if ($x_labels_vertical) {$opt{'x_labels_vertical'} = $x_labels_vertical ;}
-if ($x_plot_values) {$opt{'x_plot_values'} = $x_plot_values ;}
-if ($y_plot_values) {$opt{'y_plot_values'} = $y_plot_values ;}
-if ($box_axis) {$opt{'box_axis'} = $box_axis ;}
-if ($no_axes) {$opt{'no_axes'} = $no_axes ;}
-if ($two_axes) {$opt{'two_axes'} = $two_axes ;}
-if ($use_axis) {$opt{'use_axis'} = $use_axis ;}
-if ($zero_axis) {$opt{'zero_axis'} = $zero_axis ;}
-if ($zero_axis_only) {$opt{'zero_axis_only'} = $zero_axis_only ;}
-if ($axis_space) {$opt{'axis_space'} = $axis_space ;}
-if ($text_space) {$opt{'text_space'} = $text_space ;}
-if ($cumulate) {$opt{'cumulate'} = $cumulate ;}
-if ($overwrite) {$opt{'overwrite'} = $overwrite ;}
-if ($correct_width) {$opt{'correct_width'} = $correct_width ;}
-if ($values_vertical) {$opt{'values_vertical'} = $values_vertical ;}
-if ($values_space) {$opt{'values_space'} = $values_space ;}
-if ($values_format) {$opt{'values_format'} = $values_format ;}
-if ($legend_placement) {$opt{'legend_placement'} = $legend_placement ;}
-if ($legend_marker_width) {$opt{'legend_marker_width'} = $legend_marker_width ;}
-if ($legend_marker_height) {$opt{'legend_marker_height'} = $legend_marker_height ;}
-if ($lg_cols) {$opt{'lg_cols'} = $lg_cols ;}
-
-if ((defined $Legend) && (ref($Legend) eq "ARRAY") && ($#{${Legend}} >= 0)) {
-	$graph -> set_legend(@{$Legend}) ;
-} else {
-	warn "ERROR: Empty Legend array passed to XXX." ;
-}
-
-$graph->set(%opt) or die $graph->error;
-$graph->set_title_font(gdGiantFont);
-$graph->set_x_label_font(gdGiantFont);
-$graph->set_y_label_font(gdGiantFont);
-$graph->set_x_axis_font(gdGiantFont);
-$graph->set_y_axis_font(gdGiantFont);
-$graph->set_values_font(gdGiantFont);
-$graph->set_legend_font(gdGiantFont);
-
-my $gd = $graph->plot($Data_In) ;
-
-return $gd
-
-}
-
-1 ;
-

survey-nginx/cgi-bin/bargraph_multi.pm.bu20140131

@@ -1,244 +0,0 @@
-#!/usr/bin/perl -w
-#
-# $Id: bargraph_multi.pm
-#
-
-use strict;
-package bargraph_multi ;
-require Exporter ;
-@bargraph_multi::ISA = qw(Exporter) ;
-@bargraph_multi::EXPORT = qw(Build_Labeled_X_Axis_Graph_Str Build_Labeled_X_Axis_Graph_Obj) ;
-@bargraph_multi::EXPORT_OK = qw( ) ;
-use GD;
-use GD::Graph::colour;
-use GD::Graph::bars;
-use GD::Graph::hbars;
-use GD::Graph::bars3d;
-#use Data::Dumper;
-
-# This perl code is builds Graphs using the GD::Graph modules.
-# This code deals with a non-numeric X-Axis.  Each tick on the X-Axis is the name of a group.
-#   The other style has a numeric X-Axis.
-sub Build_Labeled_X_Axis_Graph_Str {
-# The parameters are:
-# $Data_In - A reference to a list of lists.  (aka, Array of Arrays)
-#		Each of the sublists has the same number of elements.
-#      An element might be the undef value.
-#   The first sublist is the names of the groups.
-#   The other sublists are related to the elements in the $Legend parameter.
-# $Legend - A reference to a list.
-#		Each element of the list is the name of a group.
-#   The data for each group is a sublist in the $Data_In parameter.
-# ---- The rest of the parameters are individual options as scalars: numbers, character strings, or undef.
-# The returned value is a list of (reference to the plotted graphical object, and graphic string in the mode.
-	my ($Data_In, $Legend, $Graphic_Mode, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, 
-			$ymax, $ymin, $yticknum, $t_margin, $b_margin, $l_margin, $r_margin, 
-			$colorscheme, $bar_spacing, $bargroup_spacing,
-			$show_values, $x_label_position, $y_label_position, $transparent, $overwrite, 
-			$interlaced, $bgclr, $fgclr, $boxclr, $accentclr, $shadowclr, $shadow_depth,
-			$labelclr, $axislabelclr, $legendclr, $valuesclr, $textclr, $dclrs, $borderclrs,
-			$cycle_clrs, $accent_treshold, $long_ticks, $tick_length, $x_ticks, $y_number_format,
-			$x_label_skip, $y_label_skip, $x_last_label_skip, $x_tick_offset, $x_all_ticks,
-			$x_labels_vertical, $x_plot_values, $y_plot_values,
-			$box_axis, $no_axes, $two_axes, $use_axis, $zero_axis, $zero_axis_only, $axis_space,
-			$text_space, $cumulate, $correct_width, $values_vertical, $values_space,
-			$values_format, $legend_placement, $legend_marker_width, $legend_marker_height, $lg_cols
-			) = @_ ;
-	my $Graph_Obj ;
-	$Graph_Obj = &Build_Labeled_X_Axis_Graph_Obj 
-	 	($Data_In, $Legend, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, 
-			$ymax, $ymin, $yticknum, $t_margin, $b_margin, $l_margin, $r_margin, 
-			$colorscheme, $bar_spacing, $bargroup_spacing,
-			$show_values, $x_label_position, $y_label_position, $transparent, $overwrite,
-			$interlaced, $bgclr, $fgclr, $boxclr, $accentclr, $shadowclr, $shadow_depth,
-			$labelclr, $axislabelclr, $legendclr, $valuesclr, $textclr, $dclrs, $borderclrs,
-			$cycle_clrs, $accent_treshold, $long_ticks, $tick_length, $x_ticks, $y_number_format,
-			$x_label_skip, $y_label_skip, $x_last_label_skip, $x_tick_offset, $x_all_ticks,
-			$x_labels_vertical, $x_plot_values, $y_plot_values,
-			$box_axis, $no_axes, $two_axes, $use_axis, $zero_axis, $zero_axis_only, $axis_space,
-			$text_space, $cumulate, $correct_width, $values_vertical, $values_space,
-			$values_format, $legend_placement, $legend_marker_width, $legend_marker_height, $lg_cols ) ;
-	my $Plotted_Str ;
-	unless (defined $Graph_Obj) {
-		return (undef, "") ;
-	} else {
-		if ($Graphic_Mode =~ m/png/i) {
-			$Plotted_Str = $Graph_Obj -> png ;
-		} elsif ($Graphic_Mode =~ m/gif/i) {
-			$Plotted_Str = $Graph_Obj -> gif ;
-		} else {
-			return ($Graphic_Mode, "Unsupported Graphical Mode $Graph_Obj.\n") ;
-		}
-	}
-	return ($Graph_Obj, $Plotted_Str) ;
-}
-			
-
-sub Build_Labeled_X_Axis_Graph_Obj {
-	my ($Data_In, $Legend, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, 
-			$ymax, $ymin, $yticknum, $t_margin, $b_margin, $l_margin, $r_margin, 
-			$colorscheme, $bar_spacing, $bargroup_spacing,
-			$show_values, $x_label_position, $y_label_position, $transparent, $overwrite,
-			$interlaced, $bgclr, $fgclr, $boxclr, $accentclr, $shadowclr, $shadow_depth,
-			$labelclr, $axislabelclr, $legendclr, $valuesclr, $textclr, $dclrs, $borderclrs,
-			$cycle_clrs, $accent_treshold, $long_ticks, $tick_length, $x_ticks, $y_number_format,
-			$x_label_skip, $y_label_skip, $x_last_label_skip, $x_tick_offset, $x_all_ticks,
-			$x_labels_vertical, $x_plot_values, $y_plot_values,
-			$box_axis, $no_axes, $two_axes, $use_axis, $zero_axis, $zero_axis_only, $axis_space,
-			$text_space, $cumulate, $correct_width, $values_vertical, $values_space,
-			$values_format, $legend_placement, $legend_marker_width, $legend_marker_height, $lg_cols ) = @_ ;
-	# $colorscheme is a colon seperated string of colors.
-	my $HBI_Debug_Obj = 0 ;
-	my $Data_In_sublist ; my $Data_In_cnt = 0 ;
-
-	if ($HBI_Debug_Obj) {
-		warn "INFO: " . __FILE__ . " Legend array len is $#{$Legend}.\n" ;
-		foreach $Data_In_sublist (@{$Data_In}) {
-			warn "INFO: Data array len is $#{$Data_In_sublist}.\n" ;
-			$Data_In_cnt ++ ;
-		}
-		warn "INFO: Data array $Data_In_cnt elements.\n" ;
-	}
-
-	my $graph;
-	if ($hbar) {
-    #print STDERR "hbar set\n";
-    $graph = GD::Graph::hbars->new($xdim,$ydim);
-	} else {
-    $graph = GD::Graph::bars->new($xdim,$ydim);
-    #print STDERR "hbar not set\n";
-	}
-	my @ret_colour_names_avail = () ;
-	my %valid_colour_name = () ;
-	@ret_colour_names_avail = GD::Graph::colour::colour_list(59) ;
-	for my $clr_name (@ret_colour_names_avail) {
-  	if (defined $clr_name) {$valid_colour_name{$clr_name} = 1;}
-	}
-
-# The keys of the hash array valid_colour_name are the known color names.
-
-# warn $full_colour_list ;
-# warn "The number of colours is $#ret_colour_names_avail ." ;
-# The colors I found at one time are: pink lbrown lred purple 
-# dblue lpurple green white gold blue dyellow red lgreen marine 
-# dred cyan yellow lblue orange lgray dgreen dbrown lyellow 
-# black gray dpink dgray lorange dpurple
-
-# Set blue yellow if the colorscheme parameter is 1.
-# else use the default.
-if ($colorscheme and $colorscheme ==1) {
-	$graph->set( dclrs => [ qw(blue yellow) ] ); 
-} elsif ($colorscheme) {
-	my @new_colors = split /:/ , $colorscheme ;
-	my $index = 0 ;
-	my $colors = $graph->get('dclrs');
-	my $color ;
-	foreach $color (@new_colors) {
-		if ($valid_colour_name{$color} ) {
-			# warn "Pushed $color ." ;
-			$colors->[$index] = $color ;
-			$index ++ ;
-		} else {
-			warn "Invalid color $color requested." ;
-		}
-	}
-	# warn "Setting dclrs." ;
-	$graph->set( dclrs => $colors) ;
-	# warn "Set dclrs." ;
-}
-
-
-my %opt = ('transparent' => 0,
-	   'x_label_position' => 0.5,
-	   'show_values' => 1,
-	   'y_max_value' => 100,
-	   'overwrite' => 0);
-if ($title) {$opt{'title'} = $title;}
-if ($xlabel) {$opt{'x_label'} = $xlabel;}
-if ($ylabel) {$opt{'y_label'} = $ylabel;}
-if ($ymax) {$opt{'y_max_value'} = $ymax;}
-if ($ymin) {$opt{'y_min_value'} = $ymin;}
-if ($t_margin) {$opt{'t_margin'} = $t_margin;}
-if ($b_margin) {$opt{'b_margin'} = $b_margin;}
-if ($l_margin) {$opt{'l_margin'} = $l_margin;}
-if ($r_margin) {$opt{'r_margin'} = $r_margin;}
-if ($yticknum) {$opt{'y_tick_number'} = $yticknum;}
-if ($bar_spacing) {$opt{'bar_spacing'} = $bar_spacing;}
-if ($bargroup_spacing) {$opt{'bargroup_spacing'} = $bargroup_spacing;}
-if ($show_values) {$opt{'show_values'} = $show_values;}
-if ($x_label_position) {$opt{'x_label_position'} = $x_label_position;}
-if ($y_label_position) {$opt{'y_label_position'} = $y_label_position;}
-if ($transparent) {$opt{'transparent'} = $transparent;}
-if ($overwrite) {$opt{'overwrite'} = $overwrite;}
-if ($interlaced) {$opt{'interlaced'} = $interlaced;}
-if ($bgclr) {$opt{'bgclr'} = $bgclr;}
-if ($fgclr) {$opt{'fgclr'} = $fgclr;}
-if ($boxclr) {$opt{'boxclr'} = $boxclr;}
-if ($accentclr) {$opt{'accentclr'} = $accentclr;}
-if ($shadowclr) {$opt{'shadowclr'} = $shadowclr;}
-if ($shadow_depth) {$opt{'shadow_depth'} = $shadow_depth;}
-if ($labelclr) {$opt{'labelclr'} = $labelclr ;}
-if ($axislabelclr) {$opt{'axislabelclr'} = $axislabelclr ;}
-if ($legendclr) {$opt{'legendclr'} = $legendclr ;}
-if ($valuesclr) {$opt{'valuesclr'} = $valuesclr ;}
-if ($textclr) {$opt{'textclr'} = $textclr ;}
-if ($dclrs) {$opt{'dclrs'} = $dclrs ;}
-if ($borderclrs) {$opt{'borderclrs'} = $borderclrs ;}
-if ($cycle_clrs) {$opt{'cycle_clrs'} = $cycle_clrs ;}
-if ($accent_treshold) {$opt{'accent_treshold'} = $accent_treshold ;}
-if ($long_ticks) {$opt{'long_ticks'} = $long_ticks ;}
-if ($tick_length) {$opt{'tick_length'} = $tick_length ;}
-if ($x_ticks) {$opt{'x_ticks'} = $x_ticks ;}
-if ($y_number_format) {$opt{'y_number_format'} = $y_number_format ;}
-if ($x_label_skip) {$opt{'x_label_skip'} = $x_label_skip ;}
-if ($y_label_skip) {$opt{'y_label_skip'} = $y_label_skip ;}
-if ($x_last_label_skip) {$opt{'x_last_label_skip'} = $x_last_label_skip ;}
-if ($x_tick_offset) {$opt{'x_tick_offset'} = $x_tick_offset ;}
-if ($x_all_ticks) {$opt{'x_all_ticks'} = $x_all_ticks ;}
-if ($x_label_position) {$opt{'x_label_position'} = $x_label_position ;}
-if ($y_label_position) {$opt{'y_label_position'} = $y_label_position ;}
-if ($x_labels_vertical) {$opt{'x_labels_vertical'} = $x_labels_vertical ;}
-if ($x_plot_values) {$opt{'x_plot_values'} = $x_plot_values ;}
-if ($y_plot_values) {$opt{'y_plot_values'} = $y_plot_values ;}
-if ($box_axis) {$opt{'box_axis'} = $box_axis ;}
-if ($no_axes) {$opt{'no_axes'} = $no_axes ;}
-if ($two_axes) {$opt{'two_axes'} = $two_axes ;}
-if ($use_axis) {$opt{'use_axis'} = $use_axis ;}
-if ($zero_axis) {$opt{'zero_axis'} = $zero_axis ;}
-if ($zero_axis_only) {$opt{'zero_axis_only'} = $zero_axis_only ;}
-if ($axis_space) {$opt{'axis_space'} = $axis_space ;}
-if ($text_space) {$opt{'text_space'} = $text_space ;}
-if ($cumulate) {$opt{'cumulate'} = $cumulate ;}
-if ($overwrite) {$opt{'overwrite'} = $overwrite ;}
-if ($correct_width) {$opt{'correct_width'} = $correct_width ;}
-if ($values_vertical) {$opt{'values_vertical'} = $values_vertical ;}
-if ($values_space) {$opt{'values_space'} = $values_space ;}
-if ($values_format) {$opt{'values_format'} = $values_format ;}
-if ($legend_placement) {$opt{'legend_placement'} = $legend_placement ;}
-if ($legend_marker_width) {$opt{'legend_marker_width'} = $legend_marker_width ;}
-if ($legend_marker_height) {$opt{'legend_marker_height'} = $legend_marker_height ;}
-if ($lg_cols) {$opt{'lg_cols'} = $lg_cols ;}
-
-if ((defined $Legend) && (ref($Legend) eq "ARRAY") && ($#{${Legend}} >= 0)) {
-	$graph -> set_legend(@{$Legend}) ;
-} else {
-	warn "ERROR: Empty Legend array passed to XXX." ;
-}
-
-$graph->set(%opt) or die $graph->error;
-$graph->set_title_font(gdGiantFont);
-$graph->set_x_label_font(gdGiantFont);
-$graph->set_y_label_font(gdGiantFont);
-$graph->set_x_axis_font(gdGiantFont);
-$graph->set_y_axis_font(gdGiantFont);
-$graph->set_values_font(gdGiantFont);
-$graph->set_legend_font(gdGiantFont);
-
-my $gd = $graph->plot($Data_In) ;
-
-return $gd
-
-}
-
-1 ;
-

survey-nginx/cgi-bin/bargraph_multi.pm.bu20140207

@@ -1,464 +0,0 @@
-#!/usr/bin/perl -w
-#
-# $Id: bargraph_multi.pm
-#
-
-use strict;
-use diagnostics ;
-package bargraph_multi ;
-use Exporter () ;
-@bargraph_multi::ISA = qw(Exporter) ;
-@bargraph_multi::EXPORT = qw(Build_Labeled_X_Axis_Graph_Str Build_Labeled_X_Axis_Graph_Obj
-			Build_Labeled_X_Axis_Graph_Obj_opts Build_Labeled_X_Axis_Graph_Str_opts ) ;
-@bargraph_multi::EXPORT_OK = qw( ) ;
-use GD;
-use GD::Graph::colour;
-use GD::Graph::bars;
-use GD::Graph::hbars;
-use GD::Graph::bars3d;
-#use Data::Dumper;
-
-
-
-# This perl code is builds Graphs using the GD::Graph modules.
-# This code deals with a non-numeric X-Axis.  Each tick on the X-Axis is the name of a group.
-#   The other style has a numeric X-Axis.
-sub Build_Labeled_X_Axis_Graph_Str {
-# The parameters are:
-# $Data_In - A reference to a list of lists.  (aka, Array of Arrays)
-#		Each of the sublists has the same number of elements.
-#      An element might be the undef value.
-#   The first sublist is the names of the groups.
-#   The other sublists are related to the elements in the $Legend parameter.
-# $Legend - A reference to a list.
-#		Each element of the list is the name of a group.
-#   The data for each group is a sublist in the $Data_In parameter.
-# ---- The rest of the parameters are individual options as scalars: numbers, character strings, or undef.
-# The returned value is a list of (reference to the plotted graphical object, and graphic string in the mode.
-	my ($Data_In, $Legend, $Graphic_Mode, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, 
-			$ymax, $ymin, $yticknum, $t_margin, $b_margin, $l_margin, $r_margin, 
-			$colorscheme, $bar_spacing, $bargroup_spacing,
-			$show_values, $x_label_position, $y_label_position, $transparent, $overwrite, 
-			$interlaced, $bgclr, $fgclr, $boxclr, $accentclr, $shadowclr, $shadow_depth,
-			$labelclr, $axislabelclr, $legendclr, $valuesclr, $textclr, $dclrs, $borderclrs,
-			$cycle_clrs, $accent_treshold, $long_ticks, $tick_length, $x_ticks, $y_number_format,
-			$x_label_skip, $y_label_skip, $x_last_label_skip, $x_tick_offset, $x_all_ticks,
-			$x_labels_vertical, $x_plot_values, $y_plot_values,
-			$box_axis, $no_axes, $two_axes, $use_axis, $zero_axis, $zero_axis_only, $axis_space,
-			$text_space, $cumulate, $correct_width, $values_vertical, $values_space,
-			$values_format, $legend_placement, $legend_marker_width, $legend_marker_height, $lg_cols
-			) = @_ ;
-	my $Graph_Obj ;
-	$Graph_Obj = &Build_Labeled_X_Axis_Graph_Obj 
-	 	($Data_In, $Legend, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, 
-			$ymax, $ymin, $yticknum, $t_margin, $b_margin, $l_margin, $r_margin, 
-			$colorscheme, $bar_spacing, $bargroup_spacing,
-			$show_values, $x_label_position, $y_label_position, $transparent, $overwrite,
-			$interlaced, $bgclr, $fgclr, $boxclr, $accentclr, $shadowclr, $shadow_depth,
-			$labelclr, $axislabelclr, $legendclr, $valuesclr, $textclr, $dclrs, $borderclrs,
-			$cycle_clrs, $accent_treshold, $long_ticks, $tick_length, $x_ticks, $y_number_format,
-			$x_label_skip, $y_label_skip, $x_last_label_skip, $x_tick_offset, $x_all_ticks,
-			$x_labels_vertical, $x_plot_values, $y_plot_values,
-			$box_axis, $no_axes, $two_axes, $use_axis, $zero_axis, $zero_axis_only, $axis_space,
-			$text_space, $cumulate, $correct_width, $values_vertical, $values_space,
-			$values_format, $legend_placement, $legend_marker_width, $legend_marker_height, $lg_cols ) ;
-	my $Plotted_Str ;
-	unless (defined $Graph_Obj) {
-		return (undef, "") ;
-	} else {
-		if ($Graphic_Mode =~ m/png/i) {
-			$Plotted_Str = $Graph_Obj -> png ;
-		} elsif ($Graphic_Mode =~ m/gif/i) {
-			$Plotted_Str = $Graph_Obj -> gif ;
-		} else {
-			return ($Graphic_Mode, "Unsupported Graphical Mode $Graph_Obj.\n") ;
-		}
-	}
-	return ($Graph_Obj, $Plotted_Str) ;
-}
-			
-
-sub Build_Labeled_X_Axis_Graph_Obj {
-	my ($Data_In, $Legend, $xdim, $ydim, $hbar, $title, $xlabel, $ylabel, 
-			$ymax, $ymin, $yticknum, $t_margin, $b_margin, $l_margin, $r_margin, 
-			$colorscheme, $bar_spacing, $bargroup_spacing,
-			$show_values, $x_label_position, $y_label_position, $transparent, $overwrite,
-			$interlaced, $bgclr, $fgclr, $boxclr, $accentclr, $shadowclr, $shadow_depth,
-			$labelclr, $axislabelclr, $legendclr, $valuesclr, $textclr, $dclrs, $borderclrs,
-			$cycle_clrs, $accent_treshold, $long_ticks, $tick_length, $x_ticks, $y_number_format,
-			$x_label_skip, $y_label_skip, $x_last_label_skip, $x_tick_offset, $x_all_ticks,
-			$x_labels_vertical, $x_plot_values, $y_plot_values,
-			$box_axis, $no_axes, $two_axes, $use_axis, $zero_axis, $zero_axis_only, $axis_space,
-			$text_space, $cumulate, $correct_width, $values_vertical, $values_space,
-			$values_format, $legend_placement, $legend_marker_width, $legend_marker_height, $lg_cols ) = @_ ;
-	# $colorscheme is a colon seperated string of colors.
-	my $HBI_Debug_Obj = 0 ;
-	my $Data_In_sublist ; my $Data_In_cnt = 0 ;
-
-	if ($HBI_Debug_Obj) {
-		warn "INFO: " . __FILE__ . " Parm List Legend array len is $#{$Legend}.\n" ;
-		foreach $Data_In_sublist (@{$Data_In}) {
-			warn "INFO: Data array len is $#{$Data_In_sublist}.\n" ;
-			$Data_In_cnt ++ ;
-		}
-		warn "INFO: Data array $Data_In_cnt elements.\n" ;
-	}
-
-	my $graph;
-	if ($hbar) {
-    #print STDERR "hbar set\n";
-    $graph = GD::Graph::hbars->new($xdim,$ydim);
-	} else {
-    $graph = GD::Graph::bars->new($xdim,$ydim);
-    #print STDERR "hbar not set\n";
-	}
-	my @ret_colour_names_avail = () ;
-	my %valid_colour_name = () ;
-	@ret_colour_names_avail = GD::Graph::colour::colour_list(59) ;
-	for my $clr_name (@ret_colour_names_avail) {
-  	if (defined $clr_name) {$valid_colour_name{$clr_name} = 1;}
-	}
-
-# The keys of the hash array valid_colour_name are the known color names.
-
-# warn $full_colour_list ;
-# warn "The number of colours is $#ret_colour_names_avail ." ;
-# The colors I found at one time are: pink lbrown lred purple 
-# dblue lpurple green white gold blue dyellow red lgreen marine 
-# dred cyan yellow lblue orange lgray dgreen dbrown lyellow 
-# black gray dpink dgray lorange dpurple
-
-# Set blue yellow if the colorscheme parameter is 1.
-# else use the default.
-if ($colorscheme and $colorscheme ==1) {
-	$graph->set( dclrs => [ qw(blue yellow) ] ); 
-} elsif ($colorscheme) {
-	my @new_colors = split /:/ , $colorscheme ;
-	my $index = 0 ;
-	my $colors = $graph->get('dclrs');
-	my $color ;
-	foreach $color (@new_colors) {
-		if ($valid_colour_name{$color} ) {
-			# warn "Pushed $color ." ;
-			$colors->[$index] = $color ;
-			$index ++ ;
-		} else {
-			warn "Invalid color $color requested." ;
-		}
-	}
-	# warn "Setting dclrs." ;
-	$graph->set( dclrs => $colors) ;
-	# warn "Set dclrs." ;
-}
-
-
-my %opt = ('transparent' => 0,
-	   'x_label_position' => 0.5,
-	   'show_values' => 1,
-	   'y_max_value' => 100,
-	   'overwrite' => 0);
-if ($title) {$opt{'title'} = $title;}
-if ($xlabel) {$opt{'x_label'} = $xlabel;}
-if ($ylabel) {$opt{'y_label'} = $ylabel;}
-if ($ymax) {$opt{'y_max_value'} = $ymax;}
-if ($ymin) {$opt{'y_min_value'} = $ymin;}
-if ($t_margin) {$opt{'t_margin'} = $t_margin;}
-if ($b_margin) {$opt{'b_margin'} = $b_margin;}
-if ($l_margin) {$opt{'l_margin'} = $l_margin;}
-if ($r_margin) {$opt{'r_margin'} = $r_margin;}
-if ($yticknum) {$opt{'y_tick_number'} = $yticknum;}
-if ($bar_spacing) {$opt{'bar_spacing'} = $bar_spacing;}
-if ($bargroup_spacing) {$opt{'bargroup_spacing'} = $bargroup_spacing;}
-if ($show_values) {$opt{'show_values'} = $show_values;}
-if ($x_label_position) {$opt{'x_label_position'} = $x_label_position;}
-if ($y_label_position) {$opt{'y_label_position'} = $y_label_position;}
-if ($transparent) {$opt{'transparent'} = $transparent;}
-if ($overwrite) {$opt{'overwrite'} = $overwrite;}
-if ($interlaced) {$opt{'interlaced'} = $interlaced;}
-if ($bgclr) {$opt{'bgclr'} = $bgclr;}
-if ($fgclr) {$opt{'fgclr'} = $fgclr;}
-if ($boxclr) {$opt{'boxclr'} = $boxclr;}
-if ($accentclr) {$opt{'accentclr'} = $accentclr;}
-if ($shadowclr) {$opt{'shadowclr'} = $shadowclr;}
-if ($shadow_depth) {$opt{'shadow_depth'} = $shadow_depth;}
-if ($labelclr) {$opt{'labelclr'} = $labelclr ;}
-if ($axislabelclr) {$opt{'axislabelclr'} = $axislabelclr ;}
-if ($legendclr) {$opt{'legendclr'} = $legendclr ;}
-if ($valuesclr) {$opt{'valuesclr'} = $valuesclr ;}
-if ($textclr) {$opt{'textclr'} = $textclr ;}
-if ($dclrs) {$opt{'dclrs'} = $dclrs ;}
-if ($borderclrs) {$opt{'borderclrs'} = $borderclrs ;}
-if ($cycle_clrs) {$opt{'cycle_clrs'} = $cycle_clrs ;}
-if ($accent_treshold) {$opt{'accent_treshold'} = $accent_treshold ;}
-if ($long_ticks) {$opt{'long_ticks'} = $long_ticks ;}
-if ($tick_length) {$opt{'tick_length'} = $tick_length ;}
-if ($x_ticks) {$opt{'x_ticks'} = $x_ticks ;}
-if ($y_number_format) {$opt{'y_number_format'} = $y_number_format ;}
-if ($x_label_skip) {$opt{'x_label_skip'} = $x_label_skip ;}
-if ($y_label_skip) {$opt{'y_label_skip'} = $y_label_skip ;}
-if ($x_last_label_skip) {$opt{'x_last_label_skip'} = $x_last_label_skip ;}
-if ($x_tick_offset) {$opt{'x_tick_offset'} = $x_tick_offset ;}
-if ($x_all_ticks) {$opt{'x_all_ticks'} = $x_all_ticks ;}
-if ($x_label_position) {$opt{'x_label_position'} = $x_label_position ;}
-if ($y_label_position) {$opt{'y_label_position'} = $y_label_position ;}
-if ($x_labels_vertical) {$opt{'x_labels_vertical'} = $x_labels_vertical ;}
-if ($x_plot_values) {$opt{'x_plot_values'} = $x_plot_values ;}
-if ($y_plot_values) {$opt{'y_plot_values'} = $y_plot_values ;}
-if ($box_axis) {$opt{'box_axis'} = $box_axis ;}
-if ($no_axes) {$opt{'no_axes'} = $no_axes ;}
-if ($two_axes) {$opt{'two_axes'} = $two_axes ;}
-if ($use_axis) {$opt{'use_axis'} = $use_axis ;}
-if ($zero_axis) {$opt{'zero_axis'} = $zero_axis ;}
-if ($zero_axis_only) {$opt{'zero_axis_only'} = $zero_axis_only ;}
-if ($axis_space) {$opt{'axis_space'} = $axis_space ;}
-if ($text_space) {$opt{'text_space'} = $text_space ;}
-if ($cumulate) {$opt{'cumulate'} = $cumulate ;}
-if ($overwrite) {$opt{'overwrite'} = $overwrite ;}
-if ($correct_width) {$opt{'correct_width'} = $correct_width ;}
-if ($values_vertical) {$opt{'values_vertical'} = $values_vertical ;}
-if ($values_space) {$opt{'values_space'} = $values_space ;}
-if ($values_format) {$opt{'values_format'} = $values_format ;}
-if ($legend_placement) {$opt{'legend_placement'} = $legend_placement ;}
-if ($legend_marker_width) {$opt{'legend_marker_width'} = $legend_marker_width ;}
-if ($legend_marker_height) {$opt{'legend_marker_height'} = $legend_marker_height ;}
-if ($lg_cols) {$opt{'lg_cols'} = $lg_cols ;}
-
-if ((defined $Legend) && (ref($Legend) eq "ARRAY") && ($#{${Legend}} >= 0)) {
-	$graph -> set_legend(@{$Legend}) ;
-} else {
-	warn "ERROR: Empty Legend array passed to XXX." ;
-}
-
-$graph->set(%opt) or die $graph->error;
-$graph->set_title_font(gdGiantFont);
-$graph->set_x_label_font(gdGiantFont);
-$graph->set_y_label_font(gdGiantFont);
-$graph->set_x_axis_font(gdGiantFont);
-$graph->set_y_axis_font(gdGiantFont);
-$graph->set_values_font(gdGiantFont);
-$graph->set_legend_font(gdGiantFont);
-
-my $gd = $graph->plot($Data_In) ;
-
-return $gd
-
-}
-
-# This perl code is builds Graphs using the GD::Graph modules.
-# This code deals with a non-numeric X-Axis.  Each tick on the X-Axis is the name of a group.
-#   The other style has a numeric X-Axis.
-sub Build_Labeled_X_Axis_Graph_Str_opts {
-# The parameters are:
-# $Data_In - A reference to a list of lists.  (aka, Array of Arrays)
-#		Each of the sublists has the same number of elements.
-#      An element might be the undef value.
-#   The first sublist is the names of the groups.
-#   The other sublists are related to the elements in the $Legend parameter.
-# $Legend - A reference to a list.
-# $opts - A reference to a hash array of parameters.
-#   We use the standard options for the GRAPH package.
-#   We add Graphic_Mode for PNG or GIF.
-#   We add the fonts to use for text.  The default font is a large font.
-# The returned value is a list of (reference to the plotted graphical object, and graphic string in the mode.
-	my ($Data_In, $Legend, $opts) = @_ ;
-	my $Graph_Obj ;
-	$Graph_Obj = &Build_Labeled_X_Axis_Graph_Obj_opts ($Data_In, $Legend, $opts) ;
-	my $Graphic_Mode = $opts->{'Graphic_Mode'} ;
-	unless (defined $Graphic_Mode) {$Graphic_Mode = "png" ;}
-	my $Graphic_Mode_ref = ref $Graphic_Mode ;
-	if ($Graphic_Mode_ref) {
-		return ($Graph_Obj, "Unsupported Reference Graphical Mode $Graphic_Mode_ref.\n") ;
-	}
-	my $Plotted_Str ;
-	unless (defined $Graph_Obj) {
-		return (undef, "") ;
-	} else {
-		if ($Graphic_Mode =~ m/png/i) {
-			$Plotted_Str = $Graph_Obj -> png ;
-		} elsif ($Graphic_Mode =~ m/gif/i) {
-			$Plotted_Str = $Graph_Obj -> gif ;
-		} else {
-			return ($Graph_Obj, "Unsupported Graphical Mode $Graphic_Mode.\n") ;
-		}
-	}
-	return ($Graph_Obj, $Plotted_Str) ;
-}
-
-sub Build_Labeled_X_Axis_Graph_Obj_opts {
-	my ($Data_In, $Legend, $opts ) = @_ ;
-	# $colorscheme is a colon seperated string of colors.
-	my $HBI_Debug_Obj = 0 ;
-	my $Data_In_sublist ; my $Data_In_cnt = 0 ;
-
-	if ($HBI_Debug_Obj) {
-		warn "INFO: " . __FILE__ . " Opts Legend array len is $#{$Legend}.\n" ;
-		foreach $Data_In_sublist (@{$Data_In}) {
-			warn "INFO: Data array len is $#{$Data_In_sublist}.\n" ;
-			warn "Info: Elements " . join(" ", @{$Data_In_sublist}) . " X" ;
-			$Data_In_cnt ++ ;
-		}
-		warn "INFO: Data array $Data_In_cnt elements.\n" ;
-		if (defined $Data_In) {
-			my $Data_In_ref = ref $Data_In ;
-			if ($Data_In_ref) {
-				warn "INFO: Data_In is a reference to a $Data_In_ref \n" ;
-			} else {
-				warn "INFO: Data_In is a scalar $Data_In \n" ;
-			}
-		} else {
-			warn "ERROR: Data_In is not defined." ;
-		}
-	}
-	my $hbar = $opts->{'hbar'} ;
-	my $xdim = $opts->{'width'} ;
-	my $ydim = $opts->{'height'} ;
-	warn "INFO: hbar $hbar xdim $xdim ydim $ydim X" if ($HBI_Debug_Obj) ;
-	my $graph;
-	if ($hbar) {
-    #print STDERR "hbar set\n";
-    $graph = GD::Graph::hbars->new($xdim,$ydim);
-	} else {
-    $graph = GD::Graph::bars->new($xdim,$ydim);
-    #print STDERR "hbar not set\n";
-	}
-
-	if ($HBI_Debug_Obj) {
-		if (defined $graph) {
-			my $graph_ref = ref $graph ;
-			if ($graph_ref) {
-				warn "INFO: graph is a reference to a $graph_ref \n" ;
-			} else {
-				warn "INFO: graph is a scalar $graph \n" ;
-			}
-		} else {
-			warn "ERROR: graph is not defined." ;
-		}
-	}
-
-	my @ret_colour_names_avail = () ;
-	my %valid_colour_name = () ;
-	@ret_colour_names_avail = GD::Graph::colour::colour_list(59) ;
-	for my $clr_name (@ret_colour_names_avail) {
-  	if (defined $clr_name) {$valid_colour_name{$clr_name} = 1;}
-	}
-
-# The keys of the hash array valid_colour_name are the known color names.
-
-# warn $full_colour_list ;
-# warn "The number of colours is $#ret_colour_names_avail ." ;
-# The colors I found at one time are: pink lbrown lred purple 
-# dblue lpurple green white gold blue dyellow red lgreen marine 
-# dred cyan yellow lblue orange lgray dgreen dbrown lyellow 
-# black gray dpink dgray lorange dpurple
-
-# Set blue yellow if the colorscheme parameter is 1.
-# else use the default.
-	my $colorscheme = $opts->{'colorscheme'} ;
-	if ((defined $colorscheme) and ($colorscheme eq 1)) {
-		$graph->set( dclrs => [ qw(blue yellow) ] ); 
-	} elsif ($colorscheme) {
-		my @new_colors = split /:/ , $colorscheme ;
-		my $index = 0 ;
-		my $colors = $graph->get('dclrs');
-		my $color ;
-		foreach $color (@new_colors) {
-			if ($valid_colour_name{$color} ) {
-				# warn "Pushed $color ." ;
-				$colors->[$index] = $color ;
-				$index ++ ;
-			} else {
-				warn "Invalid color $color requested." ;
-			}
-		}
-		# warn "Setting dclrs." ;
-		$graph->set( dclrs => $colors) ;
-		# warn "Set dclrs." ;
-	}
-
-	if ((defined $Legend) && (ref($Legend) eq "ARRAY") && ($#{${Legend}} >= 0)) {
-		$graph -> set_legend(@{$Legend}) ;
-	} else {
-		warn "ERROR: Empty Legend array passed to XXX." ;
-	}
-	
-	my %G_Opts = () ;
-	my $key ;
-	foreach $key (keys %{$opts}) {
-		$G_Opts{$key} = $opts->{$key} ;
-	}
-	delete $G_Opts{'colorscheme'} ;
-	delete $G_Opts{'hbar'} ;
-	delete $G_Opts{'Graphic_Mode'} ;
-	delete $G_Opts{'width'} ;
-	delete $G_Opts{'height'} ;
-
-	unless ($graph->set(%G_Opts)) {
-		warn "ERROR: graph->set complained" ;
-		warn $graph->error;
-	}
-	my $use_font ;
-	$use_font = $opts->{'title_font'} ;
-	if (defined $use_font) {
-		$graph->set_title_font($use_font);
-	} else {
-		$graph->set_title_font(gdGiantFont);
-	}
-	$use_font = $opts->{'x_label_font'} ;
-	if (defined $use_font) {
-		$graph->set_x_label_font($use_font);
-	} else {
-		$graph->set_x_label_font(gdGiantFont);
-	}
-	$use_font = $opts->{'y_label_font'} ;
-	if (defined $use_font) {
-		$graph->set_y_label_font($use_font);
-	} else {
-		$graph->set_y_label_font(gdGiantFont);
-	}
-	$use_font = $opts->{'x_axis_font'} ;
-	if (defined $use_font) {
-		$graph->set_x_axis_font($use_font);
-	} else {
-		$graph->set_x_axis_font(gdGiantFont);
-	}
-	$use_font = $opts->{'y_axis_font'} ;
-	if (defined $use_font) {
-		$graph->set_y_axis_font($use_font);
-	} else {
-		$graph->set_y_axis_font(gdGiantFont);
-	}
-	$use_font = $opts->{'values_font'} ;
-	if (defined $use_font) {
-		$graph->set_values_font($use_font);
-	} else {
-		$graph->set_values_font(gdGiantFont);
-	}
-	$use_font = $opts->{'legend_font'} ;
-	if (defined $use_font) {
-		$graph->set_legend_font($use_font);
-	} else {
-		$graph->set_legend_font(gdGiantFont);
-	}
-
-	# my $gd = $graph->plot(@{$Data_In}) ; # rejected. Bad Data
-	my $gd = $graph->plot($Data_In) ;
-
-	if ($HBI_Debug_Obj) {
-		if (defined $gd) {
-			my $gd_ref = ref $gd ;
-			if ($gd_ref) {
-				warn "INFO: gd is a reference to a $gd_ref \n" ;
-			} else {
-				warn "INFO: gd is a scalar $gd \n" ;
-			}
-		} else {
-			warn "ERROR: gd is not defined." ;
-			warn "ERROR: graph error is " . $graph->error ;
-		}
-	}
-
-	return $gd
-}
-
-1 ;
-

survey-nginx/cgi-bin/creportsf.pl.bu2011-01-05

@@ -1,547 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: creportsf.pl,v 1.11 2006/10/19 17:35:29 psims Exp $
-#
-# Source File: creportsf.pl
-
-# Get config
-require 'sitecfg.pl';
-require 'testlib.pl';
-require 'tstatlib.pl';
-require 'qlib.pl';
-
-$FORM{'frm'}="";
-
-&app_initialize;
-
-print "Content-Type: text/html\n\n";
-
-# ACT-C-004&Test Statistics by Test User Filter
-### DED 10/24/2002 Added Filter-by-Question functionality
-
-if (&get_session($FORM{'tid'})) {
-	&LanguageSupportInit();
-
-	$REPORT{'rptid'}="";
-	@rptdefs = &get_data("reports.$SESSION{'clid'}");
-	@lbls = split(/&/, $rptdefs[0]);
-	foreach $rptdef (@rptdefs) {
-		chomp ($rptdef);
-		@flds = split(/&/, $rptdef);
-		if ($flds[0] eq $FORM{'rptno'}) {
-			for $i (0 .. $#lbls) {
-				$REPORT{$lbls[$i]} = $flds[$i];
-				$i++;
-			}
-		}
-	}
-	$REPORT{'rptid'}=$FORM{'rptno'};
-	&get_client_profile($SESSION{'clid'});
-	&get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
-	&print_report_header();
-	if ($FORM{'filterbyques'} eq "on") {
-		&print_question_filter();
-	}
-	if ($FORM{'specfilter'} eq "on") {
-		&print_report_C_004();
-	}
-	&print_report_footer();
-}
-
-sub print_report_header() {
-	my $i;
-	# C_004
-	$FORM{'rptdesc'} =~ s/\+/ /g;
-	$faction="$cgiroot/teststats.pl";
-	$ftarget="rptwindow";
-	$fparms="<input type=hidden name=\"tid\" value=\"$SESSION{'tid'}\">\n";
-	$fparms=join('',$fparms,"<input type=hidden name=\"export\" value=\"$FORM{'export'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"rptno\" value=\"$FORM{'rptno'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"tstid\" value=\"$FORM{'tstid'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"testsummary\" value=\"$FORM{'testsummary'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"showobs\" value=\"$FORM{'showobs'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"showcmts\" value=\"$FORM{'showcmts'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"statsbysubj\" value=\"$FORM{'statsbysubj'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"cndnme\" value=\"$FORM{'cndnme'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"cndeml\" value=\"$FORM{'cndeml'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"cndscr\" value=\"$FORM{'cndscr'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"cnd1\" value=\"$FORM{'cnd1'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"cnd2\" value=\"$FORM{'cnd2'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"cnd3\" value=\"$FORM{'cnd3'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"cnd4\" value=\"$FORM{'cnd4'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"moto\" value=\"$FORM{'moto'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"dyto\" value=\"$FORM{'dyto'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"yrto\" value=\"$FORM{'yrto'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"mofm\" value=\"$FORM{'mofm'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"dyfm\" value=\"$FORM{'dyfm'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"yrfm\" value=\"$FORM{'yrfm'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"specfilter\" value=\"$FORM{'specfilter'}\">\n");
-	$fjscript="
-function onWdwLoad() {
-	var oform=document.rptform1;
-}
-window.onload=onWdwLoad;
-";
-	if ($FORM{'filterbyques'} eq "on") {
-		$fuserjscript="
-function rptform1_submit(oform) {
-	var ans=\"\";
-	if (oform.question.selectedIndex == 0) {
-		alert(\"You must select at least one question by which to filter!\");
-		return false;
-	}
-	if (oform.selanswer.selectedIndex == -1) {
-		alert(\"You must select at least one answer by which to filter!\");
-		return false;
-	}
-	for (var i = 0; i < oform.selanswer.options.length; i++) {
-   	if (oform.selanswer.options[i].selected)
-      		if (oform.selanswer.options[i].text == \"No Response\") {
-      			ans=\"\&\"+oform.selanswer.options[i].text;
-		} else {
-      			ans=ans+\"\&\"+i;
-		}
-	}
-	oform.answer.value=ans;
-}
-";
-	} else {
-		$fuserjscript="
-function rptform1_submit(oform) {
-	return true;
-}
-";
-	}
-	print "<HTML>
-<HEAD>
-	<TITLE>$REPORT{'rptid'} - $REPORT{'rptdesc'}</TITLE>
-	<SCRIPT language=\"JavaScript\">
-<!--
-$fjscript
-$fuserjscript
-function right(e) {
-	if (navigator.appName == 'Netscape' && (e.which == 3 || e.which == 2)) {
-		alert(\"This source and all graphics are proprietary and may not be viewed or copied.\");
-		return false;
-	} else {
-		if (navigator.appName == 'Microsoft Internet Explorer' && (event.button == 2 || event.button == 3)) {
-			alert(\"This source and all graphics are proprietary and may not be viewed or copied.\");
-			return false;
-		}
-	}
-	return true;
-}
-//document.onmousedown=right;
-//document.onmouseup=right;
-//if (document.layers) window.captureEvents(Event.MOUSEDOWN);
-//if (document.layers) window.captureEvents(Event.MOUSEUP);
-//window.onmousedown=right;
-//window.onmouseup=right;
-// -->
-	</SCRIPT>
-</HEAD>
-<BODY BACKGROUND=\"$SYSTEM{'BACKGROUND'}\" BGCOLOR=\"$SYSTEM{'BGCOLOR'}\"
-	TEXT=\"$SYSTEM{'TEXT'}\" LINK=\"$SYSTEM{'LINK'}\"
-	VLINK=\"$SYSTEM{'VLINK'}\" ALINK=\"$SYSTEM{'ALINK'}\">
-";
-	print "<FORM name=\"rptform1\" action=\"$faction\" METHOD=POST target=\"$ftarget\" onSubmit=\"return rptform1_submit(this)\">\n";
-	print "$fparms\n";
-	print "<TABLE cellpadding=0 cellspacing=0 border=0 width=100\%>
-<TR>
-	<TD VALIGN=\"top\">$CLIENT{'logo'}</TD>
-	<TD>&nbsp;</TD>
-	<TD ALIGN=\"right\">
-		<FONT COLOR=\"$SYSTEM{'HEADERCOLOR'}\">
-		<B>$FORM{'rptdesc'}<BR>$FORM{'rptid'}</B><BR>\&nbsp\;<BR>
-		</FONT>
-	</TD>
-</TR>
-</TABLE>
-";
-	print "<CENTER>\n";
-	print "<B>$TEST{'desc'} ($TEST{'id'})</B><BR>\n";
-	print "<B>$xlatphrase[745]</B><BR>\n";
-}
-
-sub print_report_footer() {
-	print "<TABLE cellpadding=0 cellspacing=0 border=0 width=100\%>
-<TR>";
-	if ($FORM{'specfilter'} eq "on") {
-	print "
-	<TD ALIGN=\"center\">
-		<input type=button name=exclude_sr value=\"$xlatphrase[742]\" onClick=\"self_reg_onClick(this.form,'sr')\">
-	</TD>\n";
-	}
-	print "
-	<TD ALIGN=\"center\">
-		<input type=submit value=\"$xlatphrase[2]\">
-	</TD>\n";
-	if ($FORM{'specfilter'} eq "on") {
-	print "
-	<TD ALIGN=\"center\">
-		<input type=button name=exclude_nonsr value=\"$xlatphrase[743]\" onClick=\"self_reg_onClick(this.form,'non')\">
-	</TD>";
-	}
-	print "
-</TR>
-</TABLE>
-";
-	print "</FORM>\n";
-	print "</BODY>\n</HTML>\n";
-}
-
-sub print_question_filter() {
-	&build_question_select_list();
-	&build_question_answer_list();
-	$fuserjscript="
-function show_question(question) {
-	var jqid=\"$quesid\", jqtxt=\"$questxt\", jqans=\"$quesans\";
-	ajqid=jqid.split(\"\&\");
-	ajtxt=jqtxt.split(\"\&\");
-	ajans=jqans.split(\"\&\");
-	for (var i = 0; i < ajqid.length; i++) {
-		if (ajqid[i] == question.value) {
-			document.rptform1.questxt.value=ajtxt[i];
-			ajqans=ajans[i].split(\"\;\");
-			lajqans=ajqans.length;
-			//document.rptform1.questxt.value=lajqans+\":\"+ajqans[lajqans]+\":\";
-			for (var j = 0; j < lajqans; j++) {
-			document.rptform1.selanswer.options[j].text=ajqans[j];
-			}
-			document.rptform1.selanswer.options[lajqans].text=\"No Response\";
-			for (var j = lajqans+1; j < document.rptform1.selanswer.length; j++) {
-			document.rptform1.selanswer.options[j].text=\"\";
-			}
-		}	
-	}
-}
-";
-	print "<SCRIPT language=\"JavaScript\">$fuserjscript</SCRIPT>\n";
-	print "<HR><B>Filter By Question</B><p>\n";
-	print "<TABLE><TR>\n";
-	print "<td align=center><B><u>Question</u></B></td>\n";
-	print "<td align=center><B><u>Answer</u></B></td>\n";
-	print "</TR>\n";
-	print "<TR>\n";
-	print "<td align=center valign=top><SELECT name=question onChange=show_question(this)><OPTION>$TEST{'questionlist'}</SELECT>\n";
-	#print "</td>\n";
-	#print "<td align=center>\n";
-	print "<p><textarea name=questxt cols=50></textarea>\n";
-	print "</td>\n";
-	print "<td align=center>\n";
-	print "<input type=hidden name=answer value=\"\">\n";
-	print "<SELECT name=selanswer MULTIPLE>\n";
-	for (0 .. $numans+1) {
-		print "<OPTION>\n";
-	}
-	print "</SELECT></td>\n";
-	print "</td>\n";
-	print "</TR></TABLE>\n";
-}
-sub print_report_C_004 {
-	my @filelist = &get_test_result_files($testcomplete, "$CLIENT{'clid'}","$TEST{'id'}");
-    my @converter;
-        if ($SESSION{'uid'} ne '') {
-                my $imaregistrar = &get_a_key("cnd.$CLIENT{'clid'}", $SESSION{'uid'}, "registrar");
-                        if ($imaregistrar eq 'Y') {
-                		foreach $rotator (@filelist) {
-                        		my @cnd = split(/\./, $rotator);
-                                	my $creator = &get_a_key("cnd.$CLIENT{'clid'}", $cnd[1], "createdby");
-                                	push(@converter, $rotator) unless $creator ne $SESSION{'uid'};
-                        	}
-        			@filelist = @converter;
-                	}
-	} else {
-		&logger::logerr("No SESSION{uid} set!");
-	}
-	my @colhdrs=();
-	push @colhdrs,"right:$xlatphrase[744]";
-	push @colhdrs,"left:$xlatphrase[745]";
-	push @colhdrs,"left:$xlatphrase[746]";
-	push @colhdrs,"left:$xlatphrase[747]";
-	push @colhdrs,"left:$xlatphrase[748]";
-	push @colhdrs,"center:$xlatphrase[749]";
-	push @colhdrs,"center:$xlatphrase[137]";
-	push @colhdrs,"center:$xlatphrase[692]";
-	push @colhdrs,"right:$xlatphrase[361]";
-	my @dataflds=();
-	my @unsorted=();
-	my $row="";
-	my @qsumry=();
-	my $user="";
-	my $joint="\&";
-	my $colhdr;
-	my $colalgn;
-    	if ($FORM{'mofm'} < 10) { $FORM{'mofm'}="0$FORM{'mofm'}";}
-    	if ($FORM{'moto'} < 10) { $FORM{'moto'}="0$FORM{'moto'}";}
-    	if ($FORM{'dyfm'} < 10) { $FORM{'dyfm'}="0$FORM{'dyfm'}";}
-    	if ($FORM{'dyto'} < 10) { $FORM{'dyto'}="0$FORM{'dyto'}";}
-    	my $datefm="$FORM{'yrfm'}\-$FORM{'mofm'}\-$FORM{'dyfm'}";
-    	my $dateto="$FORM{'yrto'}\-$FORM{'moto'}\-$FORM{'dyto'}";
-
-	for ($fidx = 0; $fidx <= $#filelist; $fidx++ ) {
-		$user = $filelist[$fidx];
-		$user =~ s/.$TEST{'id'}//g;
-		$user =~ s/$CLIENT{'clid'}.//g;
-                my $history = get_testhistory_from_log($CLIENT{'clid'},$user,$FORM{'tstid'});
-        	if (not defined $history) {
-                	$history = get_cnd_test_from_history($testcomplete,$CLIENT{'clid'},$user,$FORM{'tstid'});
-        	} else {
-               		#print STDERR "$user from log.\n";
-        	}
-        	if (not defined $history) {
-                	# no log file entry for this test
-                	#print STDERR "$user inferred from $testcomplete.$pathsep.$filelist[$fidx]\n";
-                	my $mtime = (stat($testcomplete.$pathsep.$filelist[$fidx]))[9];
-                	$history->{'end'} = $mtime;
-                	$history->{'start'} = $history->{'end'};
-        	}
-        	$completedat = &format_date_time("yyyy-mm-dd", "1", "-10000", $history->{'end'});
-        	$displaydate = &format_date_time("dd-mmm-yyyy", "1", "-10000", $history->{'end'});
-        	if (&date_out_of_range($completedat,$datefm,$dateto)) {
-                	next;
-        	}
-
-		&get_test_sequence_for_reports( $CLIENT{'clid'}, $user, $TEST{'id'});
-		@qsumry = split(/\&/, $SUBTEST_SUMMARY{2});
-		&get_candidate_profile($CLIENT{'clid'},$user);
-		$row=join($joint,$row,"$CANDIDATE{'nml'}");
-		$row=join($joint,$row,"$CANDIDATE{'nmf'}");
-		$row=join($joint,$row,"$CANDIDATE{'nmm'}");
-		$row=join($joint,$row,"$user");
-		$row=join($joint,$row,"$CANDIDATE{'selfreg'}");
-		$row=join('&',$row,$qsumry[0],$qsumry[1],$qsumry[2]);
-		push @unsorted, $row;
-		$row="";
-	}
-	my @sorted=sort @unsorted;
-	@unsorted=();
-	my $rowcount=$#filelist+1;
-	print "<HR><B>Filter By User</B><p>\n";
-	&print_report_dataextract_header($rowcount,@colhdrs);
-	$jsarray = "";
-	for $i (0 .. $#sorted) {
-		@dataflds=split($joint, $sorted[$i]);
-		print "<TR>\n";
-		for $i (0 .. $#dataflds) {
-			($colalgn,$colhdr) = split(/:/,$colhdrs[$i]);
-			if ($i == 0) {
-				print "\t\t<td align=$colalgn valign=top><input type=checkbox name=\"inc$dataflds[4]\" value=\"$dataflds[4]\">";
-			} else {
-				if ($colhdr eq "Self-Reg") {
-					print "\t\t<td align=$colalgn valign=top>$dataflds[$i]\n";
-					print "\t\t<input type=hidden name=sr$dataflds[4] value=$dataflds[5]></td>\n";
-					$jsarray .= "$dataflds[4]:";
-				} else {
-					print "\t\t<td align=$colalgn valign=top>$dataflds[$i]</td>\n";
-				}
-			}
-		}
-		print "<TR>\n";
-	}
-	$jsarray = substr($jsarray,0,-1);
-	print "</TABLE>\n";
-$jscript="
-function self_reg_onClick(oform,exc) {
-	var jsl=\"$jsarray\", jsa, n, s;
-	jsa=jsl.split(':');
-	for (var i=0; i<jsa.length;i++) {
-		n=\"oform.\"+\"sr\"+jsa[i]+\".value\";
-		s=eval(\"oform.\"+\"inc\"+jsa[i]);
-		if (eval(n) == \"Y\") {
-			if (exc == \"sr\") {
-				s.checked=true;
-			} else {
-				s.checked=false;
-			}
-		} else {
-			if (exc == \"sr\") {
-				s.checked=false;
-			} else {
-				s.checked=true;
-			}
-		}
-	}
-}
-";
-	print "<SCRIPT language=\"JavaScript\">$jscript</SCRIPT>\n";
-	@sorted=();
-}
-
-sub print_report_dataextract_header {
-	my ($ncount,@cols)= @_;
-	my $colhdr;
-	my $colalgn;
-	my $i;
-	print "<TABLE cellpadding=2 cellspacing=2 border=0 width=\"100\%\">\n";
-	print "\t<TR>\n";
-	for $i (0 .. $#cols) {
-		($colalgn,$colhdr) = split(/:/,$cols[$i]);
-		print "\t\t<td align=$colalgn valign=top><b><u>$colhdr</u></b></td>\n";
-	}
-	print "\t</TR>\n";
-}
-
-#
-#
-#
-sub get_test_sequence_for_reports {
-	&get_test_profile($_[0], $_[2]);
-	$trash3 = join($pathsep, $testcomplete, "$_[0].$_[1].$_[2]");
-	$msg = "";
-	if ( ! open(TESTFILE,"<$trash3") ) {
-		&logger::logerr("Unable to open $trash3: $!");
-		$msg="failed";
-		print "<!-- open failure\n$trash3\n$!\n-->\n";
-		$msg = "";
-	} else {
-		@seqlines = <TESTFILE>;
-		close TESTFILE;
-		$isubtest = 1; $iidx = 0; $iaryidx = 1;
-		foreach $seqline (@seqlines) {
-			chop ($seqline);
-			if ($iidx eq 0) {
-				@status = split(/&/, $seqline);
-				$ifld = 0;
-				$TEST_SESSION{'clid'} = $status[$ifld++];
-				$TEST_SESSION{'uid'} = $status[$ifld++];
-				$TEST_SESSION{'tstid'} = $status[$ifld++];
-				$TEST_SESSION{'state'} = $status[$ifld++];
-				$TEST_SESSION{'dscl'} = $status[$ifld++];
-				$TEST_SESSION{'profb'} = $status[$ifld++];
-				$TEST_SESSION{'id'} = $status[$ifld++];
-				$TEST_SESSION{'profa'} = $status[$ifld++];
-				$TEST_SESSION{'srvy'} = $status[$ifld++];
-				$TEST_SESSION{'ntfy'} = $status[$ifld++];
-				$TEST_SESSION{'emlcnd'} = $status[$ifld++];
-				@status = ();
-				$iidx++;
-			} else {
-				if ($iaryidx eq 1) {
-					$SUBTEST_QUESTIONS{$isubtest} = $seqline;
-				} elsif ($iaryidx eq 2) {
-					$SUBTEST_ANSWERS{$isubtest} = $seqline;
-				} elsif ($iaryidx eq 3) {
-					$seqline =~ s/\%0D\%0A/<br>/g;
-					$SUBTEST_RESPONSES{$isubtest} = unmunge($seqline);
-				} elsif ($iaryidx eq 4) {
-					$SUBTEST_SUMMARY{$isubtest} = $seqline;
-				}
-				$iaryidx++;
-				if ($iaryidx eq 5) {
-					$iaryidx = 1;
-					$isubtest++;
-				}
-			}
-		}
-	}
-	@seqlines = ();
-	return;
-}
-
-#wac merge v  - this code commented out because replaced the calls with EFL changes
-#
-# $patterncount = CountFiles($directory, $pattern1, $pattern2);
-#
-#sub CountFiles {
-#	opendir (GDIR, $_[0]);
-#	@cdots = readdir(GDIR);
-#	closedir GDIR;
-#	$ncount=0;
-#	$crmmask1 = "$_[1]";
-#	$crmmask2 = "$_[2]";
-#	foreach $crmfile (@cdots) {
-#		if (($crmfile =~ /$crmmask1/ ) && ($crmfile =~ /$crmmask2/ )) {$ncount++;}
-#	}
-#	@cdots = ();
-#	return $ncount;
-#}
-# wac merge ^
-
-################################################################################
-#
-# Subroutine Name
-#   GetTestHeader
-#
-# Description
-#   This subroutine returns the header of the test file
-#
-# Inputs
-#   $clientId -- The id of the client to search through
-#
-# Outputs
-#   None
-#
-# Returns
-#   @testFields -- An array of fields in the header
-#
-#adt080401###############################################################################
-sub GetTestHeader
-{
-	my $clientId = $_[0];
-	my @testList = &get_data("tests.$clientId");
-	my $testHdr = $testList[0];
-	my $testFields;
-
-	chop( $testHdr );
-	@testFields = split( /&/, $testHdr );
-	
-	return @testFields;
-}
-
-
-#adt080401###############################################################################
-#
-# Subroutine Name
-#   GetTestsByOwner
-#
-# Description
-#   This subroutine searches through the test definition file of the given
-#   client for all the tests that are owned by the given user id or are public
-#
-# Inputs
-#   $clientId -- The id of the client to search through
-#   $ownedBy -- The name of the owner of the test to search for
-#
-# Outputs
-#   None
-#
-# Returns
-#   @tests -- An array of tests owned by the given user id
-#
-################################################################################
-sub GetTestsByOwner
-{
-	my $clientId = $_[0];
-	my $ownedBy = $_[1];
-	my %currHash;
-	my @testList = &get_data("tests.$clientId");
-	my @currField;
-	my @tests;
-	my $testHdr = $testList[0];
-	my $testFields;
-	my $testCntr;
-	
-	@testFields = &GetTestHeader( $clientId );
-
-	for( $testCntr = 1; $testCntr < $#testList; $testCntr++ )
-	{
-		#print "<b>$testList[$testCntr]</b><br>\n";
-		chop( $testList[$testCntr] );
-		@currField = split( '&', $testList[$testCntr] );
-		for( 0 .. $#testFields )
-		{
-			$currHash{$testFields[$_]} = $currField[$_];
-		}
-		
-		#print "$currHash{'ownedby'} - $ownedBy<p>";
-		if( ( $currHash{'ownedby'} eq $ownedBy ) || ( $currHash{'ownedby'} eq "" ) )
-		{
-			push( @tests, $testList[$testCntr] );
-			#print "<font color=\"#ff0000\"><b>$testList[$testCntr]</b></font><br>\n";
-		}
-	}
-	
-	return @tests;
-}
-

survey-nginx/cgi-bin/creportsf.pl.bu20131217

@@ -1,555 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: creportsf.pl,v 1.11 2006/10/19 17:35:29 psims Exp $
-#
-# Source File: creportsf.pl
-
-# Get config
-require 'sitecfg.pl';
-require 'testlib.pl';
-require 'tstatlib.pl';
-require 'qlib.pl';
-
-$FORM{'frm'}="";
-
-&app_initialize;
-
-print "Content-Type: text/html\n\n";
-
-# ACT-C-004&Test Statistics by Test User Filter
-### DED 10/24/2002 Added Filter-by-Question functionality
-
-if (&get_session($FORM{'tid'})) {
-	&LanguageSupportInit();
-
-	$REPORT{'rptid'}="";
-	@rptdefs = &get_data("reports.$SESSION{'clid'}");
-	@lbls = split(/&/, $rptdefs[0]);
-	foreach $rptdef (@rptdefs) {
-		chomp ($rptdef);
-		@flds = split(/&/, $rptdef);
-		if ($flds[0] eq $FORM{'rptno'}) {
-			for $i (0 .. $#lbls) {
-				$REPORT{$lbls[$i]} = $flds[$i];
-				$i++;
-			}
-		}
-	}
-	$REPORT{'rptid'}=$FORM{'rptno'};
-	&get_client_profile($SESSION{'clid'});
-	&get_test_profile($CLIENT{'clid'}, $FORM{'tstid'});
-	&print_report_header();
-	if ($FORM{'filterbyques'} eq "on") {
-		&print_question_filter();
-	}
-	if ($FORM{'specfilter'} eq "on") {
-		&print_report_C_004();
-	}
-	&print_report_footer();
-}
-
-sub print_report_header() {
-	my $i;
-	# C_004
-	$FORM{'rptdesc'} =~ s/\+/ /g;
-	$faction="$cgiroot/teststats.pl";
-	$ftarget="rptwindow";
-	$fparms="<input type=hidden name=\"tid\" value=\"$SESSION{'tid'}\">\n";
-	$fparms=join('',$fparms,"<input type=hidden name=\"export\" value=\"$FORM{'export'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"rptno\" value=\"$FORM{'rptno'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"tstid\" value=\"$FORM{'tstid'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"testsummary\" value=\"$FORM{'testsummary'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"showobs\" value=\"$FORM{'showobs'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"showcmts\" value=\"$FORM{'showcmts'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"anoncmts\" value=\"$FORM{'anoncmts'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"statsbysubj\" value=\"$FORM{'statsbysubj'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"cndnme\" value=\"$FORM{'cndnme'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"cndeml\" value=\"$FORM{'cndeml'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"cndscr\" value=\"$FORM{'cndscr'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"cnd1\" value=\"$FORM{'cnd1'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"cnd2\" value=\"$FORM{'cnd2'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"cnd3\" value=\"$FORM{'cnd3'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"cnd4\" value=\"$FORM{'cnd4'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"moto\" value=\"$FORM{'moto'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"dyto\" value=\"$FORM{'dyto'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"yrto\" value=\"$FORM{'yrto'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"mofm\" value=\"$FORM{'mofm'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"dyfm\" value=\"$FORM{'dyfm'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"yrfm\" value=\"$FORM{'yrfm'}\">\n");
-	$fparms=join('',$fparms,"<input type=hidden name=\"specfilter\" value=\"$FORM{'specfilter'}\">\n");
-	$fjscript="
-function onWdwLoad() {
-	var oform=document.rptform1;
-}
-window.onload=onWdwLoad;
-";
-	if ($FORM{'filterbyques'} eq "on") {
-		$fuserjscript="
-function rptform1_submit(oform) {
-	var ans=\"\";
-	if (oform.question.selectedIndex == 0) {
-		alert(\"You must select at least one question by which to filter!\");
-		return false;
-	}
-	if (oform.selanswer.selectedIndex == -1) {
-		alert(\"You must select at least one answer by which to filter!\");
-		return false;
-	}
-	for (var i = 0; i < oform.selanswer.options.length; i++) {
-   	if (oform.selanswer.options[i].selected)
-      		if (oform.selanswer.options[i].text == \"No Response\") {
-      			ans=\"\&\"+oform.selanswer.options[i].text;
-		} else {
-      			ans=ans+\"\&\"+i;
-		}
-	}
-	oform.answer.value=ans;
-}
-";
-	} else {
-		$fuserjscript="
-function rptform1_submit(oform) {
-	return true;
-}
-";
-	}
-	print "<HTML>
-<HEAD>
-	<TITLE>$REPORT{'rptid'} - $REPORT{'rptdesc'}</TITLE>
-	<SCRIPT language=\"JavaScript\">
-<!--
-$fjscript
-$fuserjscript
-function right(e) {
-	if (navigator.appName == 'Netscape' && (e.which == 3 || e.which == 2)) {
-		alert(\"This source and all graphics are proprietary and may not be viewed or copied.\");
-		return false;
-	} else {
-		if (navigator.appName == 'Microsoft Internet Explorer' && (event.button == 2 || event.button == 3)) {
-			alert(\"This source and all graphics are proprietary and may not be viewed or copied.\");
-			return false;
-		}
-	}
-	return true;
-}
-//document.onmousedown=right;
-//document.onmouseup=right;
-//if (document.layers) window.captureEvents(Event.MOUSEDOWN);
-//if (document.layers) window.captureEvents(Event.MOUSEUP);
-//window.onmousedown=right;
-//window.onmouseup=right;
-// -->
-	</SCRIPT>
-</HEAD>
-<BODY BACKGROUND=\"$SYSTEM{'BACKGROUND'}\" BGCOLOR=\"$SYSTEM{'BGCOLOR'}\"
-	TEXT=\"$SYSTEM{'TEXT'}\" LINK=\"$SYSTEM{'LINK'}\"
-	VLINK=\"$SYSTEM{'VLINK'}\" ALINK=\"$SYSTEM{'ALINK'}\">
-";
-	print "<FORM name=\"rptform1\" action=\"$faction\" METHOD=POST target=\"$ftarget\" onSubmit=\"return rptform1_submit(this)\">\n";
-	print "$fparms\n";
-	print "<TABLE cellpadding=0 cellspacing=0 border=0 width=100\%>
-<TR>
-	<TD VALIGN=\"top\">$CLIENT{'logo'}</TD>
-	<TD>&nbsp;</TD>
-	<TD ALIGN=\"right\">
-		<FONT COLOR=\"$SYSTEM{'HEADERCOLOR'}\">
-		<B>$FORM{'rptdesc'}<BR>$FORM{'rptid'}</B><BR>\&nbsp\;<BR>
-		</FONT>
-	</TD>
-</TR>
-</TABLE>
-";
-	print "<CENTER>\n";
-	print "<B>$TEST{'desc'} ($TEST{'id'})</B><BR>\n";
-	print "<B>$xlatphrase[745]</B><BR>\n";
-}
-
-sub print_report_footer() {
-	print "<TABLE cellpadding=0 cellspacing=0 border=0 width=100\%>
-<TR>";
-	if ($FORM{'specfilter'} eq "on") {
-	print "
-	<TD ALIGN=\"center\">
-		<input type=button name=exclude_sr value=\"$xlatphrase[742]\" onClick=\"self_reg_onClick(this.form,'sr')\">
-	</TD>\n";
-	}
-	print "
-	<TD ALIGN=\"center\">
-		<input type=submit value=\"$xlatphrase[2]\">
-	</TD>\n";
-	if ($FORM{'specfilter'} eq "on") {
-	print "
-	<TD ALIGN=\"center\">
-		<input type=button name=exclude_nonsr value=\"$xlatphrase[743]\" onClick=\"self_reg_onClick(this.form,'non')\">
-	</TD>";
-	}
-	print "
-</TR>
-</TABLE>
-";
-	print "</FORM>\n";
-	print "</BODY>\n</HTML>\n";
-}
-
-sub print_question_filter() {
-	&build_question_select_list();
-	&build_question_answer_list();
-	$fuserjscript="
-function show_question(question) {
-	var jqid=\"$quesid\", jqtxt=\"$questxt\", jqans=\"$quesans\";
-	ajqid=jqid.split(\"\&\");
-	ajtxt=jqtxt.split(\"\&\");
-	ajans=jqans.split(\"\&\");
-	for (var i = 0; i < ajqid.length; i++) {
-		if (ajqid[i] == question.value) {
-			document.rptform1.questxt.value=ajtxt[i];
-			ajqans=ajans[i].split(\"\;\");
-			lajqans=ajqans.length;
-			//document.rptform1.questxt.value=lajqans+\":\"+ajqans[lajqans]+\":\";
-			for (var j = 0; j < lajqans; j++) {
-			document.rptform1.selanswer.options[j].text=ajqans[j];
-			}
-			document.rptform1.selanswer.options[lajqans].text=\"No Response\";
-			for (var j = lajqans+1; j < document.rptform1.selanswer.length; j++) {
-			document.rptform1.selanswer.options[j].text=\"\";
-			}
-		}	
-	}
-}
-";
-	print "<SCRIPT language=\"JavaScript\">$fuserjscript</SCRIPT>\n";
-	print "<HR><B>Filter By Question</B><p>\n";
-	print "<TABLE><TR>\n";
-	print "<td align=center><B><u>Question</u></B></td>\n";
-	print "<td align=center><B><u>Answer</u></B></td>\n";
-	print "</TR>\n";
-	print "<TR>\n";
-	print "<td align=center valign=top><SELECT name=question onChange=show_question(this)><OPTION>$TEST{'questionlist'}</SELECT>\n";
-	#print "</td>\n";
-	#print "<td align=center>\n";
-	print "<p><textarea name=questxt cols=50></textarea>\n";
-	print "</td>\n";
-	print "<td align=center>\n";
-	print "<input type=hidden name=answer value=\"\">\n";
-	print "<SELECT name=selanswer MULTIPLE>\n";
-	for (0 .. $numans+1) {
-		print "<OPTION>\n";
-	}
-	print "</SELECT></td>\n";
-	print "</td>\n";
-	print "</TR></TABLE>\n";
-}
-sub print_report_C_004 {
-	my @filelist = &get_test_result_files($testcomplete, "$CLIENT{'clid'}","$TEST{'id'}");
-    my @converter;
-        if ($SESSION{'uid'} ne '') {
-                my $imaregistrar = &get_a_key("cnd.$CLIENT{'clid'}", $SESSION{'uid'}, "registrar");
-                        if ($imaregistrar eq 'Y') {
-                		foreach $rotator (@filelist) {
-                        		my @cnd = split(/\./, $rotator);
-                                	my $creator = &get_a_key("cnd.$CLIENT{'clid'}", $cnd[1], "createdby");
-                                	push(@converter, $rotator) unless $creator ne $SESSION{'uid'};
-                        	}
-        			@filelist = @converter;
-                	}
-	} else {
-		&logger::logerr("No SESSION{uid} set!");
-	}
-	my @colhdrs=();
-	push @colhdrs,"right:$xlatphrase[744]";
-	push @colhdrs,"left:$xlatphrase[745]";
-	push @colhdrs,"left:$xlatphrase[746]";
-	push @colhdrs,"left:$xlatphrase[747]";
-	push @colhdrs,"left:$xlatphrase[748]";
-	push @colhdrs,"center:$xlatphrase[749]";
-	push @colhdrs,"center:$xlatphrase[137]";
-	push @colhdrs,"center:$xlatphrase[692]";
-	push @colhdrs,"right:$xlatphrase[361]";
-	my @dataflds=();
-	my @unsorted=();
-	my $row="";
-	my @qsumry=();
-	my $user="";
-	my $joint="\&";
-	my $colhdr;
-	my $colalgn;
-    	if ($FORM{'mofm'} < 10) { $FORM{'mofm'}="0$FORM{'mofm'}";}
-    	if ($FORM{'moto'} < 10) { $FORM{'moto'}="0$FORM{'moto'}";}
-    	if ($FORM{'dyfm'} < 10) { $FORM{'dyfm'}="0$FORM{'dyfm'}";}
-    	if ($FORM{'dyto'} < 10) { $FORM{'dyto'}="0$FORM{'dyto'}";}
-    	my $datefm="$FORM{'yrfm'}\-$FORM{'mofm'}\-$FORM{'dyfm'}";
-    	my $dateto="$FORM{'yrto'}\-$FORM{'moto'}\-$FORM{'dyto'}";
-
-	for ($fidx = 0; $fidx <= $#filelist; $fidx++ ) {
-		$user = $filelist[$fidx];
-		$user =~ s/.$TEST{'id'}//g;
-		$user =~ s/$CLIENT{'clid'}.//g;
-                my $history = get_testhistory_from_log($CLIENT{'clid'},$user,$FORM{'tstid'});
-        	if (not defined $history) {
-                	$history = get_cnd_test_from_history($testcomplete,$CLIENT{'clid'},$user,$FORM{'tstid'});
-        	} else {
-               		#print STDERR "$user from log.\n";
-        	}
-        	if (not defined $history) {
-                	# no log file entry for this test
-                	#print STDERR "$user inferred from $testcomplete.$pathsep.$filelist[$fidx]\n";
-                	my $mtime = (stat($testcomplete.$pathsep.$filelist[$fidx]))[9];
-                	$history->{'end'} = $mtime;
-                	$history->{'start'} = $history->{'end'};
-        	}
-        	$completedat = &format_date_time("yyyy-mm-dd", "1", "-10000", $history->{'end'});
-        	$displaydate = &format_date_time("dd-mmm-yyyy", "1", "-10000", $history->{'end'});
-        	if (&date_out_of_range($completedat,$datefm,$dateto)) {
-                	next;
-        	}
-
-		&get_test_sequence_for_reports( $CLIENT{'clid'}, $user, $TEST{'id'});
-		@qsumry = split(/\&/, $SUBTEST_SUMMARY{2});
-		&get_candidate_profile($CLIENT{'clid'},$user);
-		$row=join($joint,$row,"$CANDIDATE{'nml'}");
-		$row=join($joint,$row,"$CANDIDATE{'nmf'}");
-		$row=join($joint,$row,"$CANDIDATE{'nmm'}");
-		$row=join($joint,$row,"$user");
-		$row=join($joint,$row,"$CANDIDATE{'selfreg'}");
-		$row=join('&',$row,$qsumry[0],$qsumry[1],$qsumry[2]);
-		push @unsorted, $row;
-		$row="";
-	}
-	my @sorted=sort @unsorted;
-	@unsorted=();
-	my $rowcount=$#filelist+1;
-	print "<HR><B>Filter By User</B><p>\n";
-	&print_report_dataextract_header($rowcount,@colhdrs);
-	$jsarray = "";
-	for $i (0 .. $#sorted) {
-		@dataflds=split($joint, $sorted[$i]);
-		print "<TR>\n";
-		for $i (0 .. $#dataflds) {
-			($colalgn,$colhdr) = split(/:/,$colhdrs[$i]);
-			if ($i == 0) {
-				print "\t\t<td align=$colalgn valign=top><input type=checkbox name=\"inc$dataflds[4]\" value=\"$dataflds[4]\">";
-			} else {
-				if ($colhdr eq "Self-Reg") {
-					print "\t\t<td align=$colalgn valign=top>$dataflds[$i]\n";
-					print "\t\t<input type=hidden name=sr$dataflds[4] value=$dataflds[5]></td>\n";
-					$jsarray .= "$dataflds[4]:";
-				} else {
-					print "\t\t<td align=$colalgn valign=top>$dataflds[$i]</td>\n";
-				}
-			}
-		}
-		print "<TR>\n";
-	}
-	$jsarray = substr($jsarray,0,-1);
-	print "</TABLE>\n";
-$jscript="
-function self_reg_onClick(oform,exc) {
-	var jsl=\"$jsarray\", jsa, n, s;
-	jsa=jsl.split(':');
-	for (var i=0; i<jsa.length;i++) {
-		n=\"oform.\"+\"sr\"+jsa[i]+\".value\";
-		s=eval(\"oform.\"+\"inc\"+jsa[i]);
-		if (eval(n) == \"Y\") {
-			if (exc == \"sr\") {
-				s.checked=true;
-			} else {
-				s.checked=false;
-			}
-		} else {
-			if (exc == \"sr\") {
-				s.checked=false;
-			} else {
-				s.checked=true;
-			}
-		}
-	}
-}
-";
-	print "<SCRIPT language=\"JavaScript\">$jscript</SCRIPT>\n";
-	@sorted=();
-}
-
-sub print_report_dataextract_header {
-	my ($ncount,@cols)= @_;
-	my $colhdr;
-	my $colalgn;
-	my $i;
-	print "<TABLE cellpadding=2 cellspacing=2 border=0 width=\"100\%\">\n";
-	print "\t<TR>\n";
-	for $i (0 .. $#cols) {
-		($colalgn,$colhdr) = split(/:/,$cols[$i]);
-		print "\t\t<td align=$colalgn valign=top><b><u>$colhdr</u></b></td>\n";
-	}
-	print "\t</TR>\n";
-}
-
-#
-#
-#
-sub get_test_sequence_for_reports {
-	# There is a duplicate, and better version of this function in testlib.pl.
-	&get_test_profile($_[0], $_[2]);
-	$trash3 = join($pathsep, $testcomplete, "$_[0].$_[1].$_[2]");
-	$msg = "";
-	if ( ! open(TESTFILE,"<$trash3") ) {
-		&logger::logerr("Unable to open $trash3: $!");
-		$msg="failed";
-		print "<!-- open failure\n$trash3\n$!\n-->\n";
-		$msg = "";
-		# Clear the hashs.  Otherwise the calling code will process the current contents.
-		%TEST_SESSION = () ;
-		%SUBTEST_QUESTIONS = () ;
-		%SUBTEST_ANSWERS = () ;
-		%SUBTEST_RESPONSES = () ;
-		%SUBTEST_SUMMARY = () ;
-	} else {
-		@seqlines = <TESTFILE>;
-		close TESTFILE;
-		$isubtest = 1; $iidx = 0; $iaryidx = 1;
-		foreach $seqline (@seqlines) {
-			chop ($seqline);
-			if ($iidx eq 0) {
-				@status = split(/&/, $seqline);
-				$ifld = 0;
-				$TEST_SESSION{'clid'} = $status[$ifld++];
-				$TEST_SESSION{'uid'} = $status[$ifld++];
-				$TEST_SESSION{'tstid'} = $status[$ifld++];
-				$TEST_SESSION{'state'} = $status[$ifld++];
-				$TEST_SESSION{'dscl'} = $status[$ifld++];
-				$TEST_SESSION{'profb'} = $status[$ifld++];
-				$TEST_SESSION{'id'} = $status[$ifld++];
-				$TEST_SESSION{'profa'} = $status[$ifld++];
-				$TEST_SESSION{'srvy'} = $status[$ifld++];
-				$TEST_SESSION{'ntfy'} = $status[$ifld++];
-				$TEST_SESSION{'emlcnd'} = $status[$ifld++];
-				@status = ();
-				$iidx++;
-			} else {
-				if ($iaryidx eq 1) {
-					$SUBTEST_QUESTIONS{$isubtest} = $seqline;
-				} elsif ($iaryidx eq 2) {
-					$SUBTEST_ANSWERS{$isubtest} = $seqline;
-				} elsif ($iaryidx eq 3) {
-					$seqline =~ s/\%0D\%0A/<br>/g;
-					$SUBTEST_RESPONSES{$isubtest} = unmunge($seqline);
-				} elsif ($iaryidx eq 4) {
-					$SUBTEST_SUMMARY{$isubtest} = $seqline;
-				}
-				$iaryidx++;
-				if ($iaryidx eq 5) {
-					$iaryidx = 1;
-					$isubtest++;
-				}
-			}
-		}
-	}
-	@seqlines = ();
-	return;
-}
-
-#wac merge v  - this code commented out because replaced the calls with EFL changes
-#
-# $patterncount = CountFiles($directory, $pattern1, $pattern2);
-#
-#sub CountFiles {
-#	opendir (GDIR, $_[0]);
-#	@cdots = readdir(GDIR);
-#	closedir GDIR;
-#	$ncount=0;
-#	$crmmask1 = "$_[1]";
-#	$crmmask2 = "$_[2]";
-#	foreach $crmfile (@cdots) {
-#		if (($crmfile =~ /$crmmask1/ ) && ($crmfile =~ /$crmmask2/ )) {$ncount++;}
-#	}
-#	@cdots = ();
-#	return $ncount;
-#}
-# wac merge ^
-
-################################################################################
-#
-# Subroutine Name
-#   GetTestHeader
-#
-# Description
-#   This subroutine returns the header of the test file
-#
-# Inputs
-#   $clientId -- The id of the client to search through
-#
-# Outputs
-#   None
-#
-# Returns
-#   @testFields -- An array of fields in the header
-#
-#adt080401###############################################################################
-sub GetTestHeader
-{
-	my $clientId = $_[0];
-	my @testList = &get_data("tests.$clientId");
-	my $testHdr = $testList[0];
-	my $testFields;
-
-	chop( $testHdr );
-	@testFields = split( /&/, $testHdr );
-	
-	return @testFields;
-}
-
-
-#adt080401###############################################################################
-#
-# Subroutine Name
-#   GetTestsByOwner
-#
-# Description
-#   This subroutine searches through the test definition file of the given
-#   client for all the tests that are owned by the given user id or are public
-#
-# Inputs
-#   $clientId -- The id of the client to search through
-#   $ownedBy -- The name of the owner of the test to search for
-#
-# Outputs
-#   None
-#
-# Returns
-#   @tests -- An array of tests owned by the given user id
-#
-################################################################################
-sub GetTestsByOwner
-{
-	my $clientId = $_[0];
-	my $ownedBy = $_[1];
-	my %currHash;
-	my @testList = &get_data("tests.$clientId");
-	my @currField;
-	my @tests;
-	my $testHdr = $testList[0];
-	my $testFields;
-	my $testCntr;
-	
-	@testFields = &GetTestHeader( $clientId );
-
-	for( $testCntr = 1; $testCntr < $#testList; $testCntr++ )
-	{
-		#print "<b>$testList[$testCntr]</b><br>\n";
-		chop( $testList[$testCntr] );
-		@currField = split( '&', $testList[$testCntr] );
-		for( 0 .. $#testFields )
-		{
-			$currHash{$testFields[$_]} = $currField[$_];
-		}
-		
-		#print "$currHash{'ownedby'} - $ownedBy<p>";
-		if( ( $currHash{'ownedby'} eq $ownedBy ) || ( $currHash{'ownedby'} eq "" ) )
-		{
-			push( @tests, $testList[$testCntr] );
-			#print "<font color=\"#ff0000\"><b>$testList[$testCntr]</b></font><br>\n";
-		}
-	}
-	
-	return @tests;
-}
-

survey-nginx/cgi-bin/forgot.pl.bu20120228

@@ -1,52 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: forgot.pl,v 1.2 2006/01/23 21:39:30 ddoughty Exp $
-#
-# Source File: forgot.pl
-
-# Get config
-require 'sitecfg.pl';
-require 'testlib.pl';
-
-&traceoutput("login.pl");	# TRACE IF ACTIVE
-
-&app_initialize;
-
-print "Content-Type: text/html\n\n";
-
-$SESSION{'clid'} = $FORM{'clid'};
-$SESSION{'lang'} = $FORM{'lang'};
-&get_client_configuration();
-&traceoutput("login.pl:$FORM{'clid'}:$FORM{'uid'}:$FORM{'pwd'}");	# TRACE IF ACTIVE
-&setbrowsertype();
-
-# Load Index.html
-if ($FORM{'home'} eq 'client') {
-
-	if ($FORM{'uid'} eq '') {
-		return 0;
-	} else {
-		my $tmpfile = "cnd.$FORM{'clid'}";
-		my @cnds = &get_data($tmpfile);
-		foreach my $cnd (@cnds) {
-			chop ($cnd);
-			my @flds = split(/&/, $cnd);
-			if ($flds[0] eq $FORM{'uid'}) {
-				my $pw = $flds[1];
-				my $email = $flds[11];
-				$mmsubj = "Password for ".$CLIENT{'clnmc'};
-				$mmbody  = "Dear $flds[3],\n";
-				$mmbody .= "  Your password for the ";
-				$mmbody .= $CLIENT{'clnmc'};
-				$mmbody .= " Test Manager system is: $pw.\n";
-				&send_mail($mmautonotifyfrom, $email, $mmsubj, $mmbody);
-			}
-		}
-		@lines = &get_template("cindex");
-	}
-} else {
-	@lines = &get_template("shome");
-}
-foreach $line (@lines) {
-	$line = &xlatline($line);
-}

survey-nginx/cgi-bin/imagepop.pl.bu20190627

@@ -1,20 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: imagepop.pl,v 1.3 2006/01/23 21:39:30 ddoughty Exp $
-#
-# Source File: image.pl
-
-require 'sitecfg.pl';
-require 'testlib.pl';
-
-&app_initialize;
-
-print "Content-Type: text/html\n\n";
-
-if (&get_session($FORM{'tid'})) {
-	print "<HTML>
-<BODY>
-	<IMG SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$FORM{'img'}\" BORDER=0>
-</BODY>
-</HTML>\n";
-}

survey-nginx/cgi-bin/likert_rep_wall_A_104.pl.bu20140127

@@ -1,18 +0,0 @@
-#!/usr/bin/perl
-#
-# Source File: likert_rep_wall_104.pl
-# $Header$
-
-print "<HTML>\n";
-print "<HEAD></HEAD>\n";
-print "<FRAMESET frameborder=0 rows=\"60,*\">\n";
-print "\t<FRAME noresize scrolling=\"no\" name=\"rptindx003\" frameborder=0 src=\"$urlroot/likert_wall_A_104.pl?lang=$SESSION{'lang'}&tid=$SESSION{'tid'}&frm=1&rptno=$FORM{'rptno'}\">\n";
-print "\t<FRAMESET frameborder=0 cols=\"230,*\">\n";
-print "\t\t<FRAME name=\"rpttidx003\" frameborder=0 src=\"$urlroot/likert_wall_A_104.pl?lang=$SESSION{'lang'}&tid=$SESSION{'tid'}&frm=0\">\n";
-print "\t\t<FRAME name=\"rptdtl003\" frameborder=0 src=\"$urlroot/likert_wall_A_104.pl?lang=$SESSION{'lang'}&tid=$SESSION{'tid'}&frm=0\">\n";
-print "\t</FRAMESET>\n";
-print "</FRAMESET>\n";
-print "</HTML>\n";
-
-1 ;
-

survey-nginx/cgi-bin/login.pl.bu20120228

@@ -1,203 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: login.pl,v 1.16 2006/10/19 17:35:29 psims Exp $
-#
-# Source File: login.pl
-
-# Get config
-require 'sitecfg.pl';
-require 'testlib.pl';
-
-&traceoutput("login.pl");	# TRACE IF ACTIVE
-
-&app_initialize;
-$SESSION{'temptime'} = time();
-
-$SESSION{'clid'} = $FORM{'clid'};
-$SESSION{'lang'} = $FORM{'lang'};
-&get_client_configuration();
-&traceoutput("login.pl:$FORM{'clid'}:$FORM{'uid'}:$FORM{'pwd'}");	# TRACE IF ACTIVE
-&setbrowsertype();
-
-## DED Patch for secure_html/tests dir permission problem 2006/10/11
-if (! -x $testroot) {
- 	print STDERR "PERMS: $testroot is not X\n";
-	chmod(0777, $testroot);
-}
-
-if ($FORM{'selfregister'} eq "Y") {
-	&get_client_profile($SESSION{'clid'});
-	$CANDIDATE{'new'}="Y";
-	print "Content-Type: text/html\n\n";
-	&show_template("regsas");
-} elsif (&verifyaccess) {
-	&init_session;
-	&LanguageSupportInit();
-	&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "1");
-	$FORM{'notice'} = $SYSTEM{'message'};
-
-	### For redirect to regcnd & regsas
-	$vars{'tid'} = $SESSION{'tid'};
-	$vars{'lang'} = $SESSION{'lang'};
-	$vars{'badid'} = $FORM{'badid'} unless !(defined($FORM{'badid'}));	#This is used if badid is passed from regsas for autorefresh location trick
-	$vars{'direction'} = $FORM{'direction'} unless !(defined($FORM{'direction'}));
-
-	if ($SESSION{'taclid'} ne '') {
-		print "Content-Type: text/html\n\n";
-		&get_client_profile($SESSION{'clid'});
-		my $opts = { restrict_to_availability_window => 1 };
-		&set_session($SESSION{'tid'},'taclauthtests',$SESSION{'taclauthtests'});
-		&set_session($SESSION{'tid'},'uid',$SESSION{'taclid'});
-		if ($FORM{'pwd'} eq '_____') {
-			&get_tacl_profile("regauto");
-			&regdusr("regauto");
-		} else {
-			&get_tacl_profile();
-			&regdusr("regtacl");
-		}
-	} elsif ($FORM{'sas'} ne '') {
-## ^ support for wilcard login
-		# register an account to the candidate
-		&get_client_profile($SESSION{'clid'});
-		my $opts = { restrict_to_availability_window => 1 };
-		&get_candidate_profile($SESSION{'clid'}, $SESSION{'uid'}, $opts);
-		#&regdusr("regsas");
-		&redirect("regsas", \%vars);
-	} else {
-		if ($FORM{'sadm'} ne '') {
-			print "Content-Type: text/html\n\n";
-			if ($SESSION{'uac'} eq 'gadmin') {
-				# Site administration
-				$CLIENT{'active'} = "X";
-				$CLIENT{'logo'} = "<IMG SRC=\"$PATHS{'graphroot'}/logo.gif\" BORDER=0>\n";
-				$CLIENT{'clorg'} = "ACTS Corporation";
-				&regdusr("frsadmin");
-			} elsif ($SESSION{'uac'} =~ /txlatr./ ) {
-				($FORM{'uac'},$FORM{'lang'}) = split(/\./, $SESSION{'uac'});
-				$CLIENT{'active'} = "X";
-				$CLIENT{'logo'} = "<IMG SRC=\"$PATHS{'graphroot'}/logo.gif\" BORDER=0>\n";
-				$CLIENT{'clorg'} = "ACTS Corporation";
-				print "<HTML>\n";
-				print "<HEAD>\n";
-				print "<META HTTP-EQUIV=\"Refresh\" CONTENT=\"0; URL=$PATHS{'cgiroot'}/Interpreter.pl?tid=$SESSION{'tid'}&lang=$FORM{'lang'}\">\n";
-				print "</HEAD>\n";
-				print "<BODY>\n";
-				print "</BODY>\n";
-				print "</HTML>\n";
-			} elsif ($SESSION{'uac'} eq 'madmin') {
-				# Multiple-client admin
-				&regdusr("madmin");
-			} else {
-				# Client Test Administration
-				&get_client_profile($SESSION{'clid'});
-				&regdusr("frsadmin");
-			}
-		} else {
-			if ($FORM{'tadm'} ne '') {
-				print "Content-Type: text/html\n\n";
-				if ($SESSION{'uac'} eq 'madmin') {
-					# Multiple-client admin
-					&regdusr("madmin");
-				} else {
-					# Client Test Administration
-					&get_client_profile($SESSION{'clid'});
-					&regdusr("frsadmin");
-				}
-			} else {
-				if (&checkinprogress($SESSION{'clid'}, $FORM{'uid'}) ) {
-					# resume test at point of pause
-					&resumetest;
-				} else {
-					if ($FORM{'cnd'} ne '') {
-						&get_client_profile($SESSION{'clid'});
-						my $opts = { restrict_to_availability_window => 1 };
-						&get_candidate_profile($SESSION{'clid'}, $FORM{'uid'}, $opts);
-						#print STDERR "clid: $SESSION{'clid'}, uid: $FORM{'uid'}, opts: $opts\n";
-						if ($CANDIDATE{'grpowner'} eq 'Y') {
-							print "Content-Type: text/html\n\n";
-							&show_template("frcnd");
-						} elsif ($CANDIDATE{'registrar'} eq 'Y') {
-							print "Content-Type: text/html\n\n";
-							&show_template("frcnd");
-						} else {
-							&redirect("regcnd", \%vars);
-						}
-					} else {
-						&get_candidate_profile($SESSION{'clid'}, $FORM{'uid'});
-						#&regdusr("regsas");
-						&redirect("regsas", \%vars);
-					}
-				}
-			}
-		}
-	}
-} else {
-	# Load Index.html
-	print "Content-Type: text/html\n\n";
-	if ($FORM{'home'} eq 'client') {
-		&get_client_profile($FORM{'clid'});
-		@lines = &get_template("cindex");
-	} else {
-		@lines = &get_template("shome");
-	}
-	if ($ipfilter ne '') {
-		if ($ipfilter =~ /$ENV{'REMOTE_ADDR'}/ ) {
-			# ip blocked
-			if ($FORM{'sas'} eq '') {
-				# uid or password were incorrect
-				$SYSTEM{'message'} = "<IMG SRC=\"$graphroot/msgbpw.gif\" ALT=\"System Maintenance In Progress.\" BORDER=0>";
-			} else {
-				# uid is used
-				$SYSTEM{'message'} = "<IMG SRC=\"$graphroot/msgidu.gif\" ALT=\"Requested Login ID is not available.\" BORDER=0>";
-			}
-		} else {
-			&logger::loginfo("Incorrect passwd 4");
-			$SYSTEM{'message'} = "<IMG SRC=\"$graphroot/msgipb.gif\" ALT=\"Incorrect Password.\" BORDER=0>";
-		}
-	} else {
-		if ($SYSTEM{'IP_ACCESS_FILTER'} ne '') {
-			if ($SYSTEM{'IP_ACCESS_FILTER'} =~ /$ENV{'REMOTE_ADDR'}/ ) {
-				if ($FORM{'sas'} eq '') {
-					# uid or password were incorrect
-					&logger::loginfo("Incorrect passwd 3");
-					$SYSTEM{'message'} = "<IMG SRC=\"$graphroot/msgbpw.gif\" ALT=\"Incorrect Password.\" BORDER=0>";
-				} else {
-					# uid is used
-					$SYSTEM{'message'} = "<IMG SRC=\"$graphroot/msgidu.gif\" ALT=\"Requested Login ID is not available.\" BORDER=0>";
-				}
-			} else {
-				&logger::loginfo("Incorrect passwd 2");
-				$SYSTEM{'message'} = "<IMG SRC=\"$graphroot/msgipb.gif\" ALT=\"Incorrect Password.\" BORDER=0>";
-			}
-		} else {
-			if ($FORM{'sas'} eq '') {
-				# uid or password were incorrect
-				&logger::loginfo("Incorrect passwd 1");
-				$SYSTEM{'message'} = "<IMG SRC=\"$graphroot/msgbpw.gif\" ALT=\"Incorrect Password.\" BORDER=0>";
-			} else {
-				# uid is used
-				$SYSTEM{'message'} = "<IMG SRC=\"$graphroot/msgidu.gif\" ALT=\"Requested Login ID is not available.\" BORDER=0>";
-			}
-		}
-	}
-	foreach $line (@lines) {
-		$line = &xlatline($line);
-	}
-}
-
-sub resumetest {
-	print "RESUMING TEST<BR>\n";
-	print "<INPUT TYPE=TEXT NAME=\"tid\" VALUE=\"$FORM{'tid'}\"><BR>\n";
-	print "<INPUT TYPE=TEXT NAME=\"uid\" VALUE=\"$FORM{'uid'}\"><BR>\n";
-	print "<INPUT TYPE=TEXT NAME=\"pwd\" VALUE=\"$FORM{'pwd'}\"><BR>\n";
-	print "<INPUT TYPE=TEXT NAME=\"uac\" VALUE=\"$FORM{'uac'}\"><BR>\n";
-}
-
-sub test {
-	print "<INPUT TYPE=TEXT NAME=\"tid\" VALUE=\"$FORM{'tid'}\"><BR>\n";
-	print "<INPUT TYPE=TEXT NAME=\"uid\" VALUE=\"$FORM{'uid'}\"><BR>\n";
-	print "<INPUT TYPE=TEXT NAME=\"pwd\" VALUE=\"$FORM{'pwd'}\"><BR>\n";
-	print "<INPUT TYPE=TEXT NAME=\"uac\" VALUE=\"$FORM{'uac'}\"><BR>\n";
-	&showenv;
-}
-

survey-nginx/cgi-bin/login.pl.bu20190730

@@ -1,224 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: login.pl,v 1.16 2006/10/19 17:35:29 psims Exp $
-#
-# Source File: login.pl
-
-# Get config
-require 'sitecfg.pl';
-require 'testlib.pl';
-
-&traceoutput("login.pl");	# TRACE IF ACTIVE
-
-&app_initialize;
-$SESSION{'temptime'} = time();
-
-$SESSION{'clid'} = $FORM{'clid'};
-$SESSION{'lang'} = $FORM{'lang'};
-&get_client_configuration();
-&traceoutput("login.pl:$FORM{'clid'}:$FORM{'uid'}:$FORM{'pwd'}");	# TRACE IF ACTIVE
-&setbrowsertype();
-
-## DED Patch for secure_html/tests dir permission problem 2006/10/11
-if (! -x $testroot) {
- 	print STDERR "PERMS: $testroot is not X\n";
-	chmod(0777, $testroot);
-}
-
-if ($FORM{'selfregister'} eq "Y") {
-  unless ($SESSION{'clid'}) {
-    warn "ERROR: Empty Client ID in Form $FORM{'clid'} " ;
-    &show_illegal_access_warning("user");
-    exit();
-  }
-	&get_client_profile($SESSION{'clid'});
-	unless (%CLIENT) {
-    warn "ERROR: Invalid Client ID $FORM{'clid'} " ;
-    &show_illegal_access_warning("user");
-    exit();
-  }
-	$CANDIDATE{'new'}="Y";
-	print "Content-Type: text/html\n\n";
-	&show_template("regsas");
-} elsif (&verifyaccess) {
-	&init_session;
-	&LanguageSupportInit();
-	&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "1");
-	$FORM{'notice'} = $SYSTEM{'message'};
-
-	### For redirect to regcnd & regsas
-	$vars{'tid'} = $SESSION{'tid'};
-	$vars{'lang'} = $SESSION{'lang'};
-	$vars{'badid'} = $FORM{'badid'} unless !(defined($FORM{'badid'}));	#This is used if badid is passed from regsas for autorefresh location trick
-	$vars{'direction'} = $FORM{'direction'} unless !(defined($FORM{'direction'}));
-  unless ($SESSION{'clid'}) {
-    warn "ERROR: Empty Client ID in Form $FORM{'clid'} " ;
-    &show_illegal_access_warning("user");
-    exit();
-  }
-	&get_client_profile($SESSION{'clid'});
-	unless (%CLIENT || $SESSION{'clid'} eq 'std') {
-    warn "ERROR: Invalid Client ID $FORM{'clid'} " ;
-    &show_illegal_access_warning("user");
-    exit();
-  }
-	if ($SESSION{'taclid'} ne '') {
-		print "Content-Type: text/html\n\n";
-		my $opts = { restrict_to_availability_window => 1 };
-		&set_session($SESSION{'tid'},'taclauthtests',$SESSION{'taclauthtests'});
-		&set_session($SESSION{'tid'},'uid',$SESSION{'taclid'});
-		if ($FORM{'pwd'} eq '_____') {
-			&get_tacl_profile("regauto");
-			&regdusr("regauto");
-		} else {
-			&get_tacl_profile();
-			&regdusr("regtacl");
-		}
-	} elsif ($FORM{'sas'} ne '') {
-## ^ support for wilcard login
-		# register an account to the candidate
-		my $opts = { restrict_to_availability_window => 1 };
-		unless ($SESSION{'uid'}) {
-    	warn "ERROR: Empty Candidate ID in Session data " ;
-  	}
-		&get_candidate_profile($SESSION{'clid'}, $SESSION{'uid'}, $opts);
-		#&regdusr("regsas");
-		&redirect("regsas", \%vars);
-	} else {
-		if ($FORM{'sadm'} ne '') {
-			print "Content-Type: text/html\n\n";
-			if ($SESSION{'uac'} eq 'gadmin') {
-				# Site administration
-				$CLIENT{'active'} = "X";
-				$CLIENT{'logo'} = "<IMG SRC=\"$PATHS{'graphroot'}/logo.gif\" BORDER=0>\n";
-				$CLIENT{'clorg'} = "ACTS Corporation";
-				&regdusr("frsadmin");
-			} elsif ($SESSION{'uac'} =~ /txlatr./ ) {
-				($FORM{'uac'},$FORM{'lang'}) = split(/\./, $SESSION{'uac'});
-				$CLIENT{'active'} = "X";
-				$CLIENT{'logo'} = "<IMG SRC=\"$PATHS{'graphroot'}/logo.gif\" BORDER=0>\n";
-				$CLIENT{'clorg'} = "ACTS Corporation";
-				print "<HTML>\n";
-				print "<HEAD>\n";
-				print "<META HTTP-EQUIV=\"Refresh\" CONTENT=\"0; URL=$PATHS{'cgiroot'}/Interpreter.pl?tid=$SESSION{'tid'}&lang=$FORM{'lang'}\">\n";
-				print "</HEAD>\n";
-				print "<BODY>\n";
-				print "</BODY>\n";
-				print "</HTML>\n";
-			} elsif ($SESSION{'uac'} eq 'madmin') {
-				# Multiple-client admin
-				&regdusr("madmin");
-			} else {
-				# Client Test Administration
-				&get_client_profile($SESSION{'clid'});
-				&regdusr("frsadmin");
-			}
-		} else {
-			if ($FORM{'tadm'} ne '') {
-				print "Content-Type: text/html\n\n";
-				if ($SESSION{'uac'} eq 'madmin') {
-					# Multiple-client admin
-					&regdusr("madmin");
-				} else {
-					# Client Test Administration
-					&get_client_profile($SESSION{'clid'});
-					&regdusr("frsadmin");
-				}
-			} else {
-				if (&checkinprogress($SESSION{'clid'}, $FORM{'uid'}) ) {
-					# resume test at point of pause
-					&resumetest;
-				} else {
-					if ($FORM{'cnd'} ne '') {
-						&get_client_profile($SESSION{'clid'});
-						my $opts = { restrict_to_availability_window => 1 };
-						&get_candidate_profile($SESSION{'clid'}, $FORM{'uid'}, $opts);
-						#print STDERR "clid: $SESSION{'clid'}, uid: $FORM{'uid'}, opts: $opts\n";
-						if ($CANDIDATE{'grpowner'} eq 'Y') {
-							print "Content-Type: text/html\n\n";
-							&show_template("frcnd");
-						} elsif ($CANDIDATE{'registrar'} eq 'Y') {
-							print "Content-Type: text/html\n\n";
-							&show_template("frcnd");
-						} else {
-							&redirect("regcnd", \%vars);
-						}
-					} else {
-						&get_candidate_profile($SESSION{'clid'}, $FORM{'uid'});
-						#&regdusr("regsas");
-						&redirect("regsas", \%vars);
-					}
-				}
-			}
-		}
-	}
-} else {
-	# Load Index.html
-	print "Content-Type: text/html\n\n";
-	if ($FORM{'home'} eq 'client') {
-		&get_client_profile($FORM{'clid'});
-		@lines = &get_template("cindex");
-	} else {
-		@lines = &get_template("shome");
-	}
-	if ($ipfilter ne '') {
-		if ($ipfilter =~ /$ENV{'REMOTE_ADDR'}/ ) {
-			# ip blocked
-			if ($FORM{'sas'} eq '') {
-				# uid or password were incorrect
-				$SYSTEM{'message'} = "<IMG SRC=\"$graphroot/msgbpw.gif\" ALT=\"System Maintenance In Progress.\" BORDER=0>";
-			} else {
-				# uid is used
-				$SYSTEM{'message'} = "<IMG SRC=\"$graphroot/msgidu.gif\" ALT=\"Requested Login ID is not available.\" BORDER=0>";
-			}
-		} else {
-			&logger::loginfo("Incorrect passwd 4");
-			$SYSTEM{'message'} = "<IMG SRC=\"$graphroot/msgipb.gif\" ALT=\"Incorrect Password.\" BORDER=0>";
-		}
-	} else {
-		if ($SYSTEM{'IP_ACCESS_FILTER'} ne '') {
-			if ($SYSTEM{'IP_ACCESS_FILTER'} =~ /$ENV{'REMOTE_ADDR'}/ ) {
-				if ($FORM{'sas'} eq '') {
-					# uid or password were incorrect
-					&logger::loginfo("Incorrect passwd 3");
-					$SYSTEM{'message'} = "<IMG SRC=\"$graphroot/msgbpw.gif\" ALT=\"Incorrect Password.\" BORDER=0>";
-				} else {
-					# uid is used
-					$SYSTEM{'message'} = "<IMG SRC=\"$graphroot/msgidu.gif\" ALT=\"Requested Login ID is not available.\" BORDER=0>";
-				}
-			} else {
-				&logger::loginfo("Incorrect passwd 2");
-				$SYSTEM{'message'} = "<IMG SRC=\"$graphroot/msgipb.gif\" ALT=\"Incorrect Password.\" BORDER=0>";
-			}
-		} else {
-			if ($FORM{'sas'} eq '') {
-				# uid or password were incorrect
-				&logger::loginfo("Incorrect passwd 1");
-				$SYSTEM{'message'} = "<IMG SRC=\"$graphroot/msgbpw.gif\" ALT=\"Incorrect Password.\" BORDER=0>";
-			} else {
-				# uid is used
-				$SYSTEM{'message'} = "<IMG SRC=\"$graphroot/msgidu.gif\" ALT=\"Requested Login ID is not available.\" BORDER=0>";
-			}
-		}
-	}
-	foreach $line (@lines) {
-		$line = &xlatline($line);
-	}
-}
-
-sub resumetest {
-	print "RESUMING TEST<BR>\n";
-	print "<INPUT TYPE=TEXT NAME=\"tid\" VALUE=\"$FORM{'tid'}\"><BR>\n";
-	print "<INPUT TYPE=TEXT NAME=\"uid\" VALUE=\"$FORM{'uid'}\"><BR>\n";
-	print "<INPUT TYPE=TEXT NAME=\"pwd\" VALUE=\"$FORM{'pwd'}\"><BR>\n";
-	print "<INPUT TYPE=TEXT NAME=\"uac\" VALUE=\"$FORM{'uac'}\"><BR>\n";
-}
-
-sub test {
-	print "<INPUT TYPE=TEXT NAME=\"tid\" VALUE=\"$FORM{'tid'}\"><BR>\n";
-	print "<INPUT TYPE=TEXT NAME=\"uid\" VALUE=\"$FORM{'uid'}\"><BR>\n";
-	print "<INPUT TYPE=TEXT NAME=\"pwd\" VALUE=\"$FORM{'pwd'}\"><BR>\n";
-	print "<INPUT TYPE=TEXT NAME=\"uac\" VALUE=\"$FORM{'uac'}\"><BR>\n";
-	&showenv;
-}
-

survey-nginx/cgi-bin/maillib.pl.bu20120228

@@ -1,98 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: maillib.pl,v 1.2 2004/01/13 19:22:04 jeffo Exp $
-#
-# Source File: maillib.pl
-
-
-use Net::SMTP;
-
-#sub send_mail {
-#	open(SENDMAIL, "|/usr/lib/sendmail -oi -t")
-#		or $msg2 = "Can't fork for sendmail: $!\n";
-#	print SENDMAIL <<"EOF";
-#From: $_[0]
-#To: $_[1]
-#Subject: $_[2]
-#
-#
-#
-#$_[3]
-#EOF
-#close(SENDMAIL)     or $msg2 = "sendmail didn't close nicely";
-#}
-
-sub send_mail {
-	$subj = $_[2];
-	warn "maillib.pl send_mail called SUBJ is $subj X" ;
-	warn "maillib.pl send_mail called TO is $_[1] FROM is $_[0] X" ;
-	warn "send_mail called mail_server_domain is $mail_server_domain X" ;
-	if ( $subj =~ /\:/) {
-		$maildir = join( $pathsep, $pubroot, $SESSION{'clid'}, "notify");
-		$mmdate = &format_date_time("dd-mmm-yyyy", time, "0");
-		$mmtime = &format_date_time("hh:nn:ss", time, "0");
-		$filename=join(' ', $_[2],$mmdate,$mmtime);
-		$filename =~ s/ /_/g;
-		$trash = join( $pathsep, $maildir, $filename);
-		if (open( MAILFILE, ">$trash" )) {
-			print MAILFILE "From:$_[0]\nTo: $_[1]\nSubject: $_[2]\n$_[3]\n";
-			close MAILFILE;
-		}
-	}
-#v wac add ability to send to a list of recipients 6/18/02, adapt W2K fix from 8/21/01
-	@recipients = split(/\,/, $_[1]);
- 
-$trash = join( $pathsep, $secroot, "debug.txt");
-open( DBGFILE, ">>$trash" ) || return 0;
-	$smtp =  Net::SMTP -> new ($mail_server_domain,
-						Timeout => '60'
-						);
-print DBGFILE "MAIL: mark\n";
-#print DBGFILE "MAIL: new\n";
-	$smtp-> mail ("$_[0]");
-#print DBGFILE "MAIL: from\n";
-	
-	foreach $recipient (@recipients) {
-		$smtp-> recipient ("$recipient",
-					Skipbad  =>  TRUE);
-	}
-
-#print DBGFILE "MAIL: recips specified\n";
-	$smtp-> data();
-	$smtp -> datasend ("From: $_[0]\nTo: $_[1]\nSubject: $_[2]\n$_[3]");
-	$smtp -> dataend;
-#print DBGFILE "MAIL: data\n";
-	$smtp -> quit;
-#print DBGFILE "MAIL: done\n";
-close DBGFILE;
-}
-
-#wac ^  replaced whole subroutine, had to adapt to retain debug statements.
-
-sub send_illegal_attempt {
-	$capturedenv = "";
-	for (keys %ENV) {
-		$capturedenv = join('', $capturedenv, "$_ = $ENV{$_}\r\n");
-	}
-	$mmdate = &format_date_time("dd-mmm-yyyy", time, "0");
-	$mmtime = &format_date_time("hh:nn:ss", time, "0");
-	$mmsubj = "ILLEGAL ACCESS ATTEMPT";
-	$mmbody = "Date: $mmdate
-An illegal attempt to access the site has occurred.
-
-USER_AGENT:		$ENV{'HTTP_USER_AGENT'}
-REMOTE_ADDR:	$ENV{'REMOTE_ADDR'}
-HTTP_REFERER:	$ENV{'HTTP_REFERER'}
-REQUEST_METHOD:	$ENV{'REQUEST_METHOD'}
-SERVER_PORT:	$ENV{'SERVER_PORT'}
-QUERY_STRING:	$qstr
-
-ENVIRONMENT:
-$capturedenv
-";
-	&send_mail($mmautontfyfrom, $mmautontfyto, $mmsubj, $mmbody);
-}
-
-
-# end with True because this is a require file
-1

survey-nginx/cgi-bin/qlib.pl.bu20190705

@@ -1,224 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: qlib.pl,v 1.4 2004/10/08 17:38:09 ddoughty Exp $
-# Source File: qlib.pl
-
-use CGI qw/:standard/;
-
-sub build_question_select_list {
-	$questionlist = "";
-	@questions=&get_question_list($TEST{'id'}, $SESSION{'clid'});
-	$qflds = $questions[0];
-	chop($qflds);
-	@qflds = split(/&/, $qflds);
-	for (0 .. $#qflds) { 
-		$QFIELDS{$qflds[$_]} = $_;
-	}
-	$idxid = $QFIELDS{'id'};
-	$idxqtp = $QFIELDS{'qtp'};
-	$idxqil = $QFIELDS{'qil'};
-	$idxsub = $QFIELDS{'subj'};
-	$idxtxt = $QFIELDS{'qtx'};
-	@qflds = ();
-	$qflds="";
-	for (1 .. $#questions) {
-		$qflds = $questions[$_];
-		chop ($qflds);
-		@qdata = split(/&/, $qflds);
-		($trash, $qnum) = split(/\./, $qdata[$idxid]);
-		$qobsind=($qdata[$idxqil] eq 'Y') ? '*' : "\ ";
-		### DED 9/11/02 Added marker for entry questions 
-		$qentind=($TEST{'qent'} =~ /$qnum/) ? '>' : "\ ";
-		$qtext = substr($qdata[$idxtxt],0,20);
-		$listtext = sprintf("%s %3s %10s : %20s", $qnum, $qdata[$idxqtp], $qdata[$idxsub], $qtext);
-		$questionlist = join('', $questionlist, "<OPTION VALUE=\"$qdata[$idxid]\">$qobsind$qentind $listtext</OPTION>\n");
-	}
-	@qdata = ();
-	@questions = ();
-	$TEST{'questionlist'} = $questionlist;
-}
-
-
-sub build_question_answer_list {
-	$quesid = "";
-	$questxt = "";
-	$quesans = "";
-	$numans = 0;
-	@questions=&get_question_list($TEST{'id'}, $SESSION{'clid'});
-	$qflds = $questions[0];
-	chop($qflds);
-	@qflds = split(/&/, $qflds);
-	for (0 .. $#qflds) { 
-		$QFIELDS{$qflds[$_]} = $_;
-	}
-	$idxid = $QFIELDS{'id'};
-	$idxqtp = $QFIELDS{'qtp'};
-	$idxtxt = $QFIELDS{'subj'};
-	$idxqtx = $QFIELDS{'qtx'};
-	$idxqca = $QFIELDS{'qca'};
-	$idxqia = $QFIELDS{'qia'};
-	@qflds = ();
-	$qflds="";
-	for (1 .. $#questions) {
-		$qflds = $questions[$_];
-		chop ($qflds);
-		@qdata = split(/&/, $qflds);
-		($trash, $qnum) = split(/\./, $qdata[$idxid]);
-		$quesid=join('&',$quesid,$qdata[$idxid]);
-		$questxt=join('&',$questxt,$qdata[$idxqtx]);
-		if ($qdata[$idxqtp] eq 'mcs' || $qdata[$idxqtp] eq 'mca' || $qdata[$idxqtp] eq 'tf' || $qdata[$idxqtp] eq 'esa') {
-			if ($qdata[$idxqca] eq '') {
-				$ansdata=$qdata[$idxqia];
-			} elsif ($qdata[$idxqia] eq '') {
-				$ansdata=$qdata[$idxqca];
-			} else {
-				$ansdata=join('\;',$qdata[$idxqca],$qdata[$idxqia]);
-			}
-		} elsif ($qdata[$idxqtp] eq 'mcm') {
-			if ($qdata[$idxqca] eq '') {
-				$ansdata=$qdata[$idxqia];
-			} elsif ($qdata[$idxqia] eq '') {
-				$ansdata=$qdata[$idxqca];
-			} else {
-				$ansdata=join('',$qdata[$idxqca],$qdata[$idxqia]);
-			}
-			
-		} else {
-			$ansdata="";
-		}
-		$ansdata =~ s/^\;//;
-		$ansdata =~ s/\;$//;
-		@ansdata=split('\;',$ansdata);
-		if ($#ansdata > $numans) { $numans = $#ansdata }
-		$quesans=join('&',$quesans,$ansdata);
-	}
-	$quesid=substr($quesid,1);
-	$questxt=substr($questxt,1);
-	$quesans=substr($quesans,1);
-	@qdata = ();
-	@questions = ();
-	@ansdata=();
-}
-
-#($TEST{'id'}, $SESSION{'clid'}, $FORM{'qid'})
-sub put_question_image {
-	my ($clid,$qid,$upfilename) = @_;
-	my $upfile;
-	my $msg;
-	my $chmodok;
-	if ($upfilename eq '') { 
-		$upfilename = "$clid.$qid";
-	}
-	my $upimg = upload($upfilename);
-	my @fileparts = split(/\./, param($upfilename));
-	my $question_image_ext = $fileparts[$#fileparts];
-	@fileparts = ();
-	if ($question_image_ext ne "" && $SYSTEM{'supportedimagemedia'} =~ /$question_image_ext/i ) {
-		# remove any old images for this question
-		&remove_question_image($clid, $qid);
-		# write the uploaded file
-		$upfile = join($pathsep, $testgraphic, "$clid.$qid.$question_image_ext");
-		open (OUTFILE, ">$upfile") or $msg="failed";
-		if ($msg ne "failed") {
-			binmode(OUTFILE);
-			while ($bytesread=read($upimg,$buffer,1024)) {
-			   print OUTFILE $buffer;
-			}
-			close OUTFILE;
-			$chmodok = chmod 0666, $upfile;
-		}
-	}
-}
-
-#($TEST{'id'}, $SESSION{'clid'}, $FORM{'qid'})
-sub remove_question_image {
-	my ($clid,$qid) = @_;
-	my $prefile;
-	my $existingfile;
-	my $cnt;
-	my @suexts = split(/\;/, $SYSTEM{'supportedimagemedia'});
-	foreach $suext (@suexts) {
-		$prefile = join($pathsep, $testgraphic, "$clid.$qid");
-		$existingfile=&file_exists_with_extension($prefile, $suext);
-		if ($existingfile ne '') {
-			$cnt = unlink $existingfile;
-		}
-	}
-}
-
-sub copy_question_image {
-	my ($clid,$newqid,$qid) = @_;
-	my $prefile;
-	my $existingfile;
-	my $imgdata;
-	my $fsize;
-	my $chmodok;
-	my $msg;
-	my @suexts = split(/\;/, $SYSTEM{'supportedimagemedia'});
-	foreach $suext (@suexts) {
-		$prefile = join($pathsep, $testgraphic, "$clid.$newqid");
-		$existingfile=&file_exists_with_extension($prefile, $suext);
-		if ($existingfile ne '') {
-			$prefile = $existingfile;
-			$prefile =~ s/$newqid/$qid/g;
-
-			open (IMGFILE, "<$existingfile");
-			binmode(IMGFILE);
-			$fsize = (stat(IMGFILE))[7];
-			read(IMGFILE, $imgdata, $fsize);
-			close IMGFILE;
-
-			open (IMGFILE, ">$prefile") or $msg="failed";
-			if ($msg ne "failed") {
-				binmode(IMGFILE);
-				print IMGFILE $imgdata;
-				close IMGFILE;
-				$chmodok = chmod 0666, $prefile;
-			}
-		}
-	}
-}
-
-sub set_thumbnail {
-	$htmlreference="";
-	if ($QUESTION{'new'} eq "Y") {
-		if ($QUESTION{'qim'} ne '0') {
-			$imgfile = $FORM{'localimg'};
-			if ($_[0] eq '1') {
-				$htmlreference = "<A NAME=\"qimage\" HREF=\"file:///$imgfile\" TARGET=\"illustrated\">View</A>\n";
-			} elsif ($_[0] eq '2') {
-				$htmlreference = "<IMG NAME=\"qimage\" SRC=\"file:///$imgfile\">\n";
-			}
-		}
-	} else {
-		&get_question_definition($TEST{'id'}, $SESSION{'clid'}, $QUESTION{'id'});
-		if ($QUESTION{'qim'} ne '0') {
-			if ($FORM{'localimg'} ne '') {
-				if ($QUESTION{'qim'} ne '0') {
-					$imgfile = $FORM{'localimg'};
-					if ($_[0] eq '1') {
-						$htmlreference = "<A NAME=\"qimage\" HREF=\"file:///$imgfile\" TARGET=\"illustrated\">View</A>\n";
-					} elsif ($_[0] eq '2') {
-						$htmlreference = "<IMG NAME=\"qimage\" SRC=\"file:///$imgfile\">\n";
-					}
-				}
-			} else {
-				$imgbase = join($pathsep, $testgraphic, "$SESSION{'clid'}.$QUESTION{'id'}");
-				$imgextopts = join('', $SYSTEM{'supportedimagemedia'},
-									$SYSTEM{'supportedaudiomedia'},
-									$SYSTEM{'supportedvideomedia'});
-				$imgfile = &file_exists_with_extension($imgbase, $imgextopts);
-				$imgfile =~ s/$testgraphic//g;
-				$imgfile =~ s/\///g;
-				if ($_[0] eq '1') {
-					$htmlreference = "<A NAME=\"qimage\" HREF=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$imgfile\" TARGET=\"illustrated\">View</A>\n";
-				} elsif ($_[0] eq '2') {
-					$htmlreference = "<IMG NAME=\"qimage\" SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$imgfile\">\n";
-				}
-			}
-		}
-	}
-	return $htmlreference;
-}
-# end with True because this is a require file
-1

survey-nginx/cgi-bin/questionslib.pl.bu20190627

@@ -1,152 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: $
-#
-# Source File: questionslib.pl
-#  --- Originally pulled from testdata.pl and converted to a library PERL file.
-
-# Get config
-use FileHandle;
-use Reporter;
-use Data::Dumper;
-require 'cybertestlib.pl' ;
-require 'sitecfg.pl' ;
-use strict;
-use vars qw(%FORM %SESSION %CLIENT %TEST_SESSION %SUBTEST_QUESTIONS %TEST %SUBTEST_SUMMARY %CANDIDATE %SUBTEST_ANSWERS %SYSTEM %REPORT %SUBTEST_RESPONSES);
-use vars qw($testcomplete $cgiroot $pathsep $dataroot $testgraphic $graphroot);
-
-
-sub get_question_definitions {
-    my ($clid, $testid) = @_;
-    my $qcount = 0;
-    my @questions = () ;
-    my @qrecs = &get_question_list($testid, $clid);
-    chomp $qrecs[0];
-    my @flds = split(/&/,shift(@qrecs));
-    foreach my $qrec (@qrecs) {
-	chomp ($qrec);
-	#($id, $qtyp) = split(/&/, $qrec);
-	my @rowdata = split(/&/, $qrec);
-	my $i=0;
-	my $question = {};
-	@{$question}{@flds} = @rowdata;
-	($question->{'subj'},$question->{'skilllevel'}) = split(/\./,$question->{'subj'});
-	$question->{'tf'} = ($question->{'qtp'} eq 'tf') ? "SELECTED" : "";
-	$question->{'mcs'} = ($question->{'qtp'} eq 'mcs') ? "SELECTED" : "";
-	$question->{'mcm'} = ($question->{'qtp'} eq 'mcm') ? "SELECTED" : "";
-	$question->{'esa'} = ($question->{'qtp'} eq 'esa') ? "SELECTED" : "";
-	$question->{'nrt'} = ($question->{'qtp'} eq 'nrt') ? "SELECTED" : "";
-	$question->{'qtx'} =~ s/\;/\n/g;
-	$question->{'qca'} =~ s/\;/\n/g;
-	$question->{'qia'} =~ s/\;/\n/g;
-	
-	$question->{'lbla'} = ($question->{'qalb'} eq 'a') ? "SELECTED" : "";
-	$question->{'lblA'} = ($question->{'qalb'} eq 'A') ? "SELECTED" : "";
-	$question->{'lbln'} = ($question->{'qalb'} eq 'n') ? "SELECTED" : "";
-	$question->{'lblr'} = ($question->{'qalb'} eq 'r') ? "SELECTED" : "";
-	$question->{'lblR'} = ($question->{'qalb'} eq 'R') ? "SELECTED" : "";
-	
-	$question->{'tft'} = ($question->{'qtp'} eq 'tf' && $question->{'qca'} eq 'TRUE') ? "CHECKED" : "";
-	$question->{'tff'} = ($question->{'qtp'} eq 'tf' && $question->{'qca'} eq'FALSE') ? "CHECKED" : "";
-	$question->{'tfy'} = ($question->{'qtp'} eq 'tf' && $question->{'qca'} eq 'YES') ? "CHECKED" : "";
-	$question->{'tfn'} = ($question->{'qtp'} eq 'tf' && $question->{'qca'} eq'NO') ? "CHECKED" : "";
-	
-	$question->{'qim0'} = ($question->{'qim'} eq '0') ? "SELECTED" : "";
-	$question->{'qim1'} = "";
-	$question->{'qim2'} = "";
-	my $illus = join($pathsep, $testgraphic, "$clid.$question->{'id'}");
-	my $supportedmedia = join(';', $SYSTEM{'supportedimagemedia'}, $SYSTEM{'supportedaudiomedia'}, $SYSTEM{'supportedvideomedia'});
-	my $illusfile = &file_exists_with_extension($illus, $supportedmedia);
-	$question->{'illustration'} = "";
-	$question->{'defthumbnail'} = "<IMG NAME=\"qimage\" SRC=\"$graphroot/noimageassigned.gif\" width=100 BORDER=0>";
-	if ($question->{'qim'} eq '1') {
-	    $question->{'qim1'} = "SELECTED";
-	} elsif ($question->{'qim'} eq '2') {
-	    $question->{'qim2'} = "SELECTED";
-	} elsif ($question->{'qim'} eq '3' ) {
-	    $question->{'qim3'} = "SELECTED";
-	    $question->{'illustration'} = "<A NAME=\"qimage\" HREF=\"$question->{'flr'}\" TARGET=\"illustrated\">Reference Page</A>";
-	}
-	if ($illusfile ne '') {
-	    my @filesegs = split(/\./, $illusfile);
-	    my $fext = $filesegs[$#filesegs];
-	    @filesegs = () ;
-	    if ($SYSTEM{'supportedimagemedia'} =~ m/$fext/i ) {
-		if ($question->{'qim'} eq '1') {
-		    $question->{'illustration'} = "<A NAME=\"qimage\" HREF=\"$cgiroot/imagepop.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" TARGET=\"illustrated\">Illustration</A>";
-		    $question->{'defthumbnail'} = "<A NAME=\"qimage\" HREF=\"$cgiroot/imagepop.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" TARGET=\"illustrated\"><IMG NAME=\"qimagetn\" SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" width=100 BORDER=0></A>";
-		} else {
-		    $question->{'illustration'} = "<IMG NAME=\"qimage\" SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" BORDER=0>";
-		    $question->{'defthumbnail'} = "<A NAME=\"qimage\" HREF=\"$cgiroot/imagepop.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" TARGET=\"illustrated\"><IMG NAME=\"qimagetn\" SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" width=100 BORDER=0></A>";
-		}
-	    } elsif ($SYSTEM{'supportedvideomedia'} =~ m/$fext/i ) {
-		$question->{'illustration'} = "<EMBED SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" AUTOSTART=\"TRUE\" LOOP=\"false\" VOLUME=\"100\" CONTROLS=\"console\" HIDDEN=\"false\">";
-	    } elsif ($SYSTEM{'supportedaudiomedia'} =~ m/$fext/i ) {
-		$question->{'illustration'} = "<EMBED SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" AUTOSTART=\"TRUE\" LOOP=\"false\" VOLUME=\"100\" WIDTH=\"100\" HEIGHT=\"50\" CONTROLS=\"small console\" HIDDEN=\"false\">";
-	    }
-	}
-	#if ($question->{'qnxt'} eq '' ) {
-	#$question->{'qnxt'} = ($qcount < $#qrecs) ? $qcount + 1 : $#qrecs;
-	#} else {
-	#if ($question->{'qnxt'} > $#qrecs) {
-	#$question->{'qnxt'} = $#qrecs;
-	#}
-	#}
-	#if ($question->{'qprv'} eq '' ) {
-	#$question->{'qprv'} = ($qcount == 1) ? 1 : $qcount - 1;
-	#} else {
-	#if ($question->{'qprv'} > $#qrecs) {
-	#$question->{'qprv'} = $#qrecs;
-	#}
-	#}
-	$question->{'totdef'} = $#qrecs;
-	$question->{'chkobs'} = ($question->{'qil'} eq 'Y') ? "CHECKED" : "";
-	if ($question->{'qtx'} =~ /:::/) {
-	    ($question->{'qtx'}, $question->{'left_be'}, $question->{'right_be'}) = split(/:::/, $question->{'qtx'});
-	}
-	if ($question->{'layout'} =~ /:/) {
-	    ($question->{'layout'}, $question->{'anslay'}) = split(/:/, $question->{'layout'});
-	    $question->{'anslayhchk'} = ($question->{'anslay'} eq 'h') ? "CHECKED" : "";
-	} else {
-	    $question->{'anslay'} = "";
-	}
-	$question->{'anslayvchk'} = ($question->{'anslay'} ne 'h') ? "CHECKED" : "";
-	$question->{'layout2chk'} = ($question->{'layout'} eq '2') ? "CHECKED" : "";
-	$question->{'layout3chk'} = ($question->{'layout'} eq '3') ? "CHECKED" : "";
-	$question->{'layout4chk'} = ($question->{'layout'} eq '4') ? "CHECKED" : "";
-	$question->{'layout5chk'} = ($question->{'layout'} eq '5') ? "CHECKED" : "";
-	$question->{'layout1chk'} = ($question->{'layout'} eq '1') ? "CHECKED" : "";
-	if ($question->{'layout'} eq '') {
-	    $question->{'layout'} = '1';
-	    $question->{'layout1chk'} = "CHECKED";
-	}
-# sac v start addition for comment input support
-	my @qflags = split(/\./,$question->{'flags'});
-	$question->{'qcmtprmpt'} = $qflags[0];
-	$question->{'chkqccmt'} = ($qflags[0] eq 'Y') ? "CHECKED" : "";
-	$question->{'qcprmpt'} = ($qflags[0] eq 'Y') ? $qflags[1] : "";
-	$question->{'promptcomments'}="";
-	if ($qflags[0] eq 'Y') {
-	    $question->{'promptcomments'}="
-<FONT SIZE=\"4\">\&nbsp;<br>
-<b><i>$qflags[1]</i></b><br>
-<TEXTAREA NAME=\"qcucmt\" cols=\"50\" rows=\"3\"
-	wrap=on onKeyPress=\"languagesupport(this)\"
-	onFocus=\"return tGotFocus(this)\"
-	onChange=\"return onConvert(this)\"></TEXTAREA>
-</FONT><br>\n";
-	    if (($question->{'layout'} eq '4') || ($question->{'layout'} eq '5') || ($question->{'qtyp'} eq 'nrt')) {
-		$question->{'promptcomments'}=join('',"\&nbsp;<br>",$question->{'promptcomments'});
-	    } else {
-		$question->{'promptcomments'}=join('',"<tr><td>",$question->{'promptcomments'},"</td></tr>");
-	    }
-	}
-# sac ^ end addition for comment input support
-	#return;
-	push @questions, $question;
-    }
-    return \@questions;
-}
-
-1 ; # End of library file.
-

survey-nginx/cgi-bin/questionslib.pl.bu20190705

@@ -1,158 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: $
-#
-# Source File: questionslib.pl
-#  --- Originally pulled from testdata.pl and converted to a library PERL file.
-
-# Get config
-use FileHandle;
-use Reporter;
-use Data::Dumper;
-require 'cybertestlib.pl' ;
-require 'sitecfg.pl' ;
-use strict;
-use vars qw(%FORM %SESSION %CLIENT %TEST_SESSION %SUBTEST_QUESTIONS %TEST %SUBTEST_SUMMARY %CANDIDATE %SUBTEST_ANSWERS %SYSTEM %REPORT %SUBTEST_RESPONSES);
-use vars qw($testcomplete $cgiroot $pathsep $dataroot $testgraphic $graphroot);
-
-
-sub get_question_definitions {
-    my ($clid, $testid) = @_;
-    my $qcount = 0;
-    my @questions = () ;
-    my @qrecs = &get_question_list($testid, $clid);
-    chomp $qrecs[0];
-    my @flds = split(/&/,shift(@qrecs));
-    foreach my $qrec (@qrecs) {
-	chomp ($qrec);
-	#($id, $qtyp) = split(/&/, $qrec);
-	my @rowdata = split(/&/, $qrec);
-	my $i=0;
-	my $question = {};
-	@{$question}{@flds} = @rowdata;
-	($question->{'subj'},$question->{'skilllevel'}) = split(/\./,$question->{'subj'});
-	$question->{'tf'} = ($question->{'qtp'} eq 'tf') ? "SELECTED" : "";
-	$question->{'mcs'} = ($question->{'qtp'} eq 'mcs') ? "SELECTED" : "";
-	$question->{'mcm'} = ($question->{'qtp'} eq 'mcm') ? "SELECTED" : "";
-	$question->{'esa'} = ($question->{'qtp'} eq 'esa') ? "SELECTED" : "";
-	$question->{'nrt'} = ($question->{'qtp'} eq 'nrt') ? "SELECTED" : "";
-	$question->{'qtx'} =~ s/\;/\n/g;
-	$question->{'qca'} =~ s/\;/\n/g;
-	$question->{'qia'} =~ s/\;/\n/g;
-	
-	$question->{'lbla'} = ($question->{'qalb'} eq 'a') ? "SELECTED" : "";
-	$question->{'lblA'} = ($question->{'qalb'} eq 'A') ? "SELECTED" : "";
-	$question->{'lbln'} = ($question->{'qalb'} eq 'n') ? "SELECTED" : "";
-	$question->{'lblr'} = ($question->{'qalb'} eq 'r') ? "SELECTED" : "";
-	$question->{'lblR'} = ($question->{'qalb'} eq 'R') ? "SELECTED" : "";
-	
-	$question->{'tft'} = ($question->{'qtp'} eq 'tf' && $question->{'qca'} eq 'TRUE') ? "CHECKED" : "";
-	$question->{'tff'} = ($question->{'qtp'} eq 'tf' && $question->{'qca'} eq'FALSE') ? "CHECKED" : "";
-	$question->{'tfy'} = ($question->{'qtp'} eq 'tf' && $question->{'qca'} eq 'YES') ? "CHECKED" : "";
-	$question->{'tfn'} = ($question->{'qtp'} eq 'tf' && $question->{'qca'} eq'NO') ? "CHECKED" : "";
-	
-	$question->{'qim0'} = ($question->{'qim'} eq '0') ? "SELECTED" : "";
-	$question->{'qim1'} = "";
-	$question->{'qim2'} = "";
-	my $illus = join($pathsep, $testgraphic, "$clid.$question->{'id'}");
-	my $supportedmedia = join(';', $SYSTEM{'supportedimagemedia'}, $SYSTEM{'supportedaudiomedia'}, $SYSTEM{'supportedvideomedia'});
-	my $illusfile = &file_exists_with_extension($illus, $supportedmedia);
-	$question->{'illustration'} = "";
-	$question->{'defthumbnail'} = "<IMG NAME=\"qimage\" SRC=\"$graphroot/noimageassigned.gif\" width=100 BORDER=0>";
-	if ($question->{'qim'} eq '1') {
-	    $question->{'qim1'} = "SELECTED";
-	} elsif ($question->{'qim'} eq '2') {
-	    $question->{'qim2'} = "SELECTED";
-	} elsif ($question->{'qim'} eq '3' ) {
-	    $question->{'qim3'} = "SELECTED";
-	    $question->{'illustration'} = "<A NAME=\"qimage\" HREF=\"$question->{'flr'}\" TARGET=\"illustrated\">Reference Page</A>";
-	}
-	if ($illusfile ne '') {
-	    my @filesegs = split(/\./, $illusfile);
-	    my $fext = $filesegs[$#filesegs];
-	    @filesegs = () ;
-		my $IllustrationLabel = "" ;
-		if ($fext =~ /pdf$/i ) { 
-			$IllustrationLabel = "Click Here" ;
-		} else {
-			$IllustrationLabel = "Illustration" ;
-		}
-	    if ($SYSTEM{'supportedimagemedia'} =~ m/$fext/i ) {
-		if ($question->{'qim'} eq '1') {
-		    $question->{'illustration'} = "<A NAME=\"qimage\" HREF=\"$cgiroot/imagepop.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" TARGET=\"illustrated\">$IllustrationLabel</A>";
-		    $question->{'defthumbnail'} = "<A NAME=\"qimage\" HREF=\"$cgiroot/imagepop.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" TARGET=\"illustrated\"><IMG NAME=\"qimagetn\" SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" width=100 BORDER=0></A>";
-		} else {
-		    $question->{'illustration'} = "<IMG NAME=\"qimage\" SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" BORDER=0>";
-		    $question->{'defthumbnail'} = "<A NAME=\"qimage\" HREF=\"$cgiroot/imagepop.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" TARGET=\"illustrated\"><IMG NAME=\"qimagetn\" SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" width=100 BORDER=0></A>";
-		}
-	    } elsif ($SYSTEM{'supportedvideomedia'} =~ m/$fext/i ) {
-		$question->{'illustration'} = "<EMBED SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" AUTOSTART=\"TRUE\" LOOP=\"false\" VOLUME=\"100\" CONTROLS=\"console\" HIDDEN=\"false\">";
-	    } elsif ($SYSTEM{'supportedaudiomedia'} =~ m/$fext/i ) {
-		$question->{'illustration'} = "<EMBED SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" AUTOSTART=\"TRUE\" LOOP=\"false\" VOLUME=\"100\" WIDTH=\"100\" HEIGHT=\"50\" CONTROLS=\"small console\" HIDDEN=\"false\">";
-	    }
-	}
-	#if ($question->{'qnxt'} eq '' ) {
-	#$question->{'qnxt'} = ($qcount < $#qrecs) ? $qcount + 1 : $#qrecs;
-	#} else {
-	#if ($question->{'qnxt'} > $#qrecs) {
-	#$question->{'qnxt'} = $#qrecs;
-	#}
-	#}
-	#if ($question->{'qprv'} eq '' ) {
-	#$question->{'qprv'} = ($qcount == 1) ? 1 : $qcount - 1;
-	#} else {
-	#if ($question->{'qprv'} > $#qrecs) {
-	#$question->{'qprv'} = $#qrecs;
-	#}
-	#}
-	$question->{'totdef'} = $#qrecs;
-	$question->{'chkobs'} = ($question->{'qil'} eq 'Y') ? "CHECKED" : "";
-	if ($question->{'qtx'} =~ /:::/) {
-	    ($question->{'qtx'}, $question->{'left_be'}, $question->{'right_be'}) = split(/:::/, $question->{'qtx'});
-	}
-	if ($question->{'layout'} =~ /:/) {
-	    ($question->{'layout'}, $question->{'anslay'}) = split(/:/, $question->{'layout'});
-	    $question->{'anslayhchk'} = ($question->{'anslay'} eq 'h') ? "CHECKED" : "";
-	} else {
-	    $question->{'anslay'} = "";
-	}
-	$question->{'anslayvchk'} = ($question->{'anslay'} ne 'h') ? "CHECKED" : "";
-	$question->{'layout2chk'} = ($question->{'layout'} eq '2') ? "CHECKED" : "";
-	$question->{'layout3chk'} = ($question->{'layout'} eq '3') ? "CHECKED" : "";
-	$question->{'layout4chk'} = ($question->{'layout'} eq '4') ? "CHECKED" : "";
-	$question->{'layout5chk'} = ($question->{'layout'} eq '5') ? "CHECKED" : "";
-	$question->{'layout1chk'} = ($question->{'layout'} eq '1') ? "CHECKED" : "";
-	if ($question->{'layout'} eq '') {
-	    $question->{'layout'} = '1';
-	    $question->{'layout1chk'} = "CHECKED";
-	}
-# sac v start addition for comment input support
-	my @qflags = split(/\./,$question->{'flags'});
-	$question->{'qcmtprmpt'} = $qflags[0];
-	$question->{'chkqccmt'} = ($qflags[0] eq 'Y') ? "CHECKED" : "";
-	$question->{'qcprmpt'} = ($qflags[0] eq 'Y') ? $qflags[1] : "";
-	$question->{'promptcomments'}="";
-	if ($qflags[0] eq 'Y') {
-	    $question->{'promptcomments'}="
-<FONT SIZE=\"4\">\&nbsp;<br>
-<b><i>$qflags[1]</i></b><br>
-<TEXTAREA NAME=\"qcucmt\" cols=\"50\" rows=\"3\"
-	wrap=on onKeyPress=\"languagesupport(this)\"
-	onFocus=\"return tGotFocus(this)\"
-	onChange=\"return onConvert(this)\"></TEXTAREA>
-</FONT><br>\n";
-	    if (($question->{'layout'} eq '4') || ($question->{'layout'} eq '5') || ($question->{'qtyp'} eq 'nrt')) {
-		$question->{'promptcomments'}=join('',"\&nbsp;<br>",$question->{'promptcomments'});
-	    } else {
-		$question->{'promptcomments'}=join('',"<tr><td>",$question->{'promptcomments'},"</td></tr>");
-	    }
-	}
-# sac ^ end addition for comment input support
-	#return;
-	push @questions, $question;
-    }
-    return \@questions;
-}
-
-1 ; # End of library file.
-

survey-nginx/cgi-bin/regcnd.pl.bu20190730

@@ -1,114 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: regcnd.pl,v 1.8 2006/10/19 17:35:29 psims Exp $
-#
-# Source File: regcnd.pl
-
-# Get config
-require 'sitecfg.pl';
-require 'testlib.pl';
-
-&app_initialize;
-
-if (&get_session($FORM{'tid'})) {
-	&LanguageSupportInit();
-	if ($FORM{'lang'} eq "") { $FORM{'lang'} = $SESSION{'lang'}; }
-	if ($FORM{'dbop'} eq 'logout') {
-		$indextemplate = ($SESSION{'clid'} eq 'std') ? "shome" : "cindex";
-		if ($SESSION{'clid'} ne 'std') {&get_client_profile($SESSION{'clid'});}
-		print "Content-Type: text/html\n\n";
-		&show_template("$indextemplate");
-	} elsif ($FORM{'dbop'} eq 'save') {
-		$FORM{'uid'} = $SESSION{'uid'};
-		&get_client_profile($SESSION{'clid'});
-		&get_candidate_profile( $SESSION{'clid'}, $SESSION{'uid'});
-		foreach (keys %CANDIDATE) {
-        		if (!( defined($FORM{$_}) )) {	
-                		$FORM{$_} = $CANDIDATE{$_};
-        		}
-                        if ($CLIENT{'savechange'} eq "N") {
-	                        $FORM{$_} = $CANDIDATE{$_} unless $_ eq 'pwd';
-                        }
-			if ($_ eq 'pwd') {
-				if ($FORM{'oldpwdval'} ne $CANDIDATE{'pwd'} && $FORM{'oldpwdval'} ne '') {
-					$errmess = "$xlatphrase[888]";
-					$direction = "password";
-					$FORM{$_} = $CANDIDATE{$_};
-				} else {
-					$errmess = "$xlatphrase[879]" unless $FORM{'oldpwdval'} eq '';
-				}
-			}
-		}
-		if ($FORM{'eml'} ne $CANDIDATE{'eml'}) {
-			$continue_eml_tests = 1;
-			&get_client_profile($SESSION{'clid'});
-                        if ( ($CLIENT{'emlacl'} eq "Y") && ($continue_eml_tests == 1) ){
-                        	my @tempacl = &popEmlAcl($CLIENT{'clid'});
-                        	if ($CLIENT{'emlacllst'} eq "B") {
-                        		foreach (@tempacl) {
-                               		 	if ($FORM{'eml'} =~ /$_/g) {
-                               		         	$FORM{'eml'} = $CANDIDATE{'eml'};
-                               		                 $continue_eml_tests = 0;
-                               		                 $errmess = $xlatphrase[903];
-                               		         }
-                               		 }
-                        	}
-                        	if ($CLIENT{'emlacllst'} eq "W") {
-                        		foreach (@tempacl) {
-                                		$tempemlacltest .= $_;
-                                	}
-                                	$tmpemladr = $FORM{'eml'};
-                                	$tmpemladr =~ s/@/ /g;
-                                	$tmpemladr =~ /\w+\.\w+$/g;
-                                	$tmpemladr = $&;
-                                	if ( !($tempemlacltest =~ /$tmpemladr/) ) {
-                                		$FORM{'eml'} = $CANDIDATE{'eml'};
-                                        	$continue_eml_tests = 0;
-                                        	$errmess = $xlatphrase[903];
-                                	}
-                        	}
-                        }
-                        if ( ($CLIENT{'emlstrict'} eq "Y") && ($continue_eml_tests == 1) ) {
-                        	my $clid = $SESSION{'clid'};
-                        	my @cndcols = &get_data("cnd.$SESSION{'clid'}");
-                        	my @duplicates = grep(/$FORM{'eml'}/, @cndcols);
-                        	foreach (@duplicates) {
-                                	$errmess = $xlatphrase[904];
-                                        $continue_eml_tests = 0;
-                                        $FORM{'eml'} = $CANDIDATE{'eml'};
-                                }
-                        }
-		}
-		&put_candidate_profile($SESSION{'clid'}, $SESSION{'uid'}, $SESSION{'uac'});
-		&get_client_profile($SESSION{'clid'});
-		&get_candidate_profile( $SESSION{'clid'}, $SESSION{'uid'});
-		#&show_template("regcnd");
-		if ($CANDIDATE{'badid'} eq "$xlatphrase[758]") {
-                        #print "Content-Type: text/html\n\n";
-                        &show_template("regsas");
-                } else {
-                        $vars{'home'}  = "client";
-                        $vars{'lang'} = "$FORM{'lang'}";
-                        $vars{'uid'} = "$FORM{'uid'}";
-                        $vars{'pwd'} = "$FORM{'pwd'}";
-                        $vars{'clid'} = "$SESSION{'clid'}";
-                        $vars{'cnd'} = "Login";
-			$vars{'badid'} = "$errmess";
-			$vars{'direction'} = $direction unless $direction eq '';
-
-			&redirect("login", \%vars);
-                }
-	} elsif ($FORM{'dbop'} eq 'resend') {
-		if ( $SESSION{'clid'} ) {&get_client_profile($SESSION{'clid'});} ;
-		&resend_exit_emails($SESSION{'clid'}, $SESSION{'uid'}, $FORM{'tstid'});
-		$vars{'tid'} = $SESSION{'tid'};
-		$vars{'lang'} = $SESSION{'lang'};
-		&redirect("regcnd", \%vars);
-	} else {
-		&get_client_profile($SESSION{'clid'});
-		my $opts = { restrict_to_availability_window => 1 };
-		&get_candidate_profile( $SESSION{'clid'}, $SESSION{'uid'}, $opts);
-		print "Content-Type: text/html\n\n";
-		&show_template("regcnd");
-	}
-}

survey-nginx/cgi-bin/regsas.pl.bu20190718

@@ -1,444 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: regsas.pl,v 1.21 2006/11/28 21:07:48 psims Exp $
-#
-# Source File: regsas.pl
-
-# Get config
-require 'sitecfg.pl';
-require 'testlib.pl';
-
-&app_initialize;
-
-&setbrowsertype();
-if ($FORM{'newsas'} ne "") {
-	$SESSION{'clid'} = $FORM{'clid'};
-	$SESSION{'lang'} = $FORM{'lang'};
-	&get_client_configuration();
-	&LanguageSupportInit();
-	if ($FORM{'dbop'} eq 'save') {
-		&get_client_profile($SESSION{'clid'});
-		if (&adduidreq($SESSION{'clid'},$FORM{'uidreq'},$FORM{'pwdreq'})) {
-			$FORM{'uid'}=$FORM{'uidreq'};
-			$CANDIDATE{'uid'}=$FORM{'uidreq'};
-			$FORM{'clid'}=$SESSION{'clid'};
-			&get_candidate_profile($SESSION{'clid'}, $FORM{'uid'}, $opts);
-			&send_the_mail("$CLIENT{'clid'}.emlsend", "testmanager.com Personal Validation Key", $FORM{'eml'}) unless $CLIENT{'emlval'} ne "Y"; 
-			$FORM{'uac'}='sas';
-			&init_session;
-			&LanguageSupportInit();
-			my $opts = { restrict_to_availability_window => 1 };
-			&get_candidate_profile($SESSION{'clid'}, $SESSION{'uid'}, $opts);
-			&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "1");
-			$FORM{'notice'} = $SYSTEM{'message'};
-			$CANDIDATE{'badid'}="";
-		} else {
-			&get_candidate_profile($SESSION{'clid'}, $FORM{'uid'});
-			if ($FORM{'allowin'} ne "Y") {
-				$CANDIDATE{'firstlogin'}="";
-				$CANDIDATE{'new'}="Y";
-				$errmess = $xlatphrase[758];
-				$CANDIDATE{'badid'}="$xlatphrase[758]";
-                        }
-		}
-
-		#$CANDIDATE{'sal'}="";
-		#$CANDIDATE{'nmf'}=$FORM{'nmf'};
-		#$CANDIDATE{'nmm'}=$FORM{'nmm'};
-		#$CANDIDATE{'nml'}=$FORM{'nml'};
-		#$CANDIDATE{'adr'}=$FORM{'adr'};
-		#$CANDIDATE{'cty'}=$FORM{'cty'};
-		#$CANDIDATE{'ste'}=$FORM{'ste'};
-		#$CANDIDATE{'pst'}=$FORM{'pst'};
-		#$CANDIDATE{'ctry'}=$FORM{'ctry'};
-		#$CANDIDATE{'eml'}=$FORM{'eml'};
-		#$CANDIDATE{'cnd1'}=$FORM{'cnd1'};
-		#$CANDIDATE{'cnd2'}=$FORM{'cnd2'};
-		#$CANDIDATE{'cnd3'}=$FORM{'cnd3'};
-		#$CANDIDATE{'cnd4'}=$FORM{'cnd4'};
-		#$CANDIDATE{'uid'}=$FORM{'uid'};
-		if ($CANDIDATE{'badid'} eq "$xlatphrase[758]") {
-			if ($errmess2 ne '') { #This is the fast way to patch error messages
-				$FORM{'badid'} = $errmess2;
-			} else {
-				$FORM{'badid'} = $errmess unless $errmess eq '';
-			}
-			print "Content-Type: text/html\n\n";
-			&show_template("regsas");
-		} else {
-			$vars{'home'}  = "client";
-			$vars{'lang'} = "$FORM{'lang'}";
-			$vars{'uid'} = "$CANDIDATE{'uid'}";
-			$vars{'pwd'} = "$CANDIDATE{'pwd'}";
-			$vars{'clid'} = "$SESSION{'clid'}";
-			$vars{'cnd'} = "Login";
-			$vars{'newsas'} = "";
-			$vars{'dbop'} = "$FORM{'dbop'}";
-
-			&redirect("login", \%vars);
-		}
-	}
-} else {
-	if (&get_session($FORM{'tid'})) {
-		&LanguageSupportInit();
-		if ($FORM{'lang'} eq "") { $FORM{'lang'} = $SESSION{'lang'}; }
-		if ($FORM{'dbop'} eq 'logout') {
-			$indextemplate = ($SESSION{'clid'} eq 'std') ? "shome" : "cindex";
-			if ($SESSION{'clid'} ne 'std') {&get_client_profile($SESSION{'clid'});}
-			print "Content-Type: text/html\n\n";
-			&show_template("$indextemplate");
-		} elsif ($FORM{'dbop'} eq 'save') {
-			&get_client_profile($SESSION{'clid'});
-			&get_candidate_profile( $SESSION{'clid'}, $SESSION{'uid'});
-                	foreach (keys %CANDIDATE) {
-                       		if (!( defined($FORM{$_}) )) {
-                               			$FORM{$_} = $CANDIDATE{$_};
-                        	}
-				if ($CLIENT{'savechange'} eq "N") {
-                               		$FORM{$_} = $CANDIDATE{$_} unless $_ eq 'pwd';
-				}
-                        	if ($_ eq 'pwd') { #Do this type of check for filters based on seperate buttons
-                               		if ($FORM{'oldpwdval'} ne $CANDIDATE{'pwd'} && $FORM{'oldpwdval'} ne '') {
-                                        	$errmess = "$xlatphrase[888]";
-						$direction = "password";
-                                        	$FORM{$_} = $CANDIDATE{$_};
-                                	} else {
-                                        	$errmess = "$xlatphrase[879]" unless $FORM{'oldpwdval'} eq '';
-                                	}
-                        	}
-				if ($FORM{'eml'} ne $CANDIDATE{'eml'}) { #Do this type of check on every subsequent filter based revision
-					$FORM{'validated'} = 'N';
-					$continue_eml_tests = 1;
-					&send_the_mail("$CLIENT{'clid'}.emlsend", "testmanager.com Personal Validation Key", $FORM{'eml'}) unless $CLIENT{'emlval'} ne "Y"; 
-					$CANDIDATE{'badid'}="$xlatphrase[872]" unless $CLIENT{'emlval'}  ne "Y";
-					&get_client_profile($SESSION{'clid'});
-					if ( ($CLIENT{'emlacl'} eq "Y") && ($continue_eml_tests == 1) ){
-						my @tempacl = &popEmlAcl($CLIENT{'clid'});
-						if ($CLIENT{'emlacllst'} eq "B") {
-							foreach (@tempacl) {
-								if ($FORM{'eml'} =~ /$_/g) {
-									$FORM{'eml'} = $CANDIDATE{'eml'};
-									$continue_eml_tests = 0;
-									$errmess = $xlatphrase[903];
-								}
-							}
-						}
-						if ($CLIENT{'emlacllst'} eq "W") {
-							foreach (@tempacl) {
-								$tempemlacltest .= $_;
-							}
-							$tmpemladr = $FORM{'eml'};
-							$tmpemladr =~ s/@/ /g;
-							$tmpemladr =~ /\w+\.\w+$/g;
-							$tmpemladr = $&;
-							if ( !($tempemlacltest =~ /$tmpemladr/) ) {
-								$FORM{'eml'} = $CANDIDATE{'eml'};
-								$continue_eml_tests = 0;
-								$errmess = $xlatphrase[903];
-							}
-						}
-					}
-					if ( ($CLIENT{'emlstrict'} eq "Y") && ($continue_eml_tests == 1) ) {
-						my $clid = $SESSION{'clid'};
-						my @cndcols = &get_data("cnd.$SESSION{'clid'}");
-						my @duplicates = grep(/$FORM{'eml'}/, @cndcols);
-						foreach (@duplicates) {
-							$errmess = $xlatphrase[904];
-							$continue_eml_tests = 0;
-							$FORM{'eml'} = $CANDIDATE{'eml'};
-						}
-					}
-				}
-			}
-			&put_candidate_profile($SESSION{'clid'}, $SESSION{'uid'});
-			&get_candidate_profile( $SESSION{'clid'}, $SESSION{'uid'});
-        	        if ($CANDIDATE{'badid'} eq "$xlatphrase[758]" || $CANDIDATE{'badid'} eq "$xlatphrase[872]") {
-                                $vars{'home'}  = "client";
-                                $vars{'lang'} = "$FORM{'lang'}";
-                                $vars{'uid'} = "$CANDIDATE{'uid'}";
-                                $vars{'pwd'} = "$CANDIDATE{'pwd'}";
-                                $vars{'clid'} = "$SESSION{'clid'}";
-                                $vars{'cnd'} = "Login";
-				$vars{'badid'} = "$xlatphrase[758]" unless $CANDIDATE{'badid'} ne "$xlatphrase[758]";
-				$vars{'badid'} = "$xlatphrase[872]" unless $CANDIDATE{'badid'} ne "$xlatphrase[872]";
-			&redirect("login", \%vars);
-               	 	} else {
-               	       		$vars{'home'}  = "client";
-               	       		$vars{'lang'} = "$FORM{'lang'}";
-               	      		$vars{'uid'} = "$CANDIDATE{'uid'}";
-               	   		$vars{'pwd'} = "$CANDIDATE{'pwd'}";
-               	       		$vars{'clid'} = "$SESSION{'clid'}";
-                       		$vars{'cnd'} = "Login";
-				$vars{'badid'} = $errmess unless $errmess eq '';
-				$vars{'direction'} = $direction unless $direction eq '';
-				&redirect("login", \%vars);
-                	}
-			#print "Content-Type: text/html\n\n";
-			#&show_template("regsas");
-		 } elsif ($FORM{'dbop'} eq 'resend') {
-			&resend_exit_emails($SESSION{'clid'}, $SESSION{'uid'}, $FORM{'tstid'});
-			$vars{'tid'} = "$SESSION{'tid'}";
-			$vars{'lang'} = "$SESSION{'lang'}";
-			&redirect("regsas", \%vars);
-		} else {
-			&get_client_profile($SESSION{'clid'});
-
-			my $opts = { restrict_to_availability_window => 1 };
-			&get_candidate_profile( $SESSION{'clid'}, $SESSION{'uid'}, $opts);
-			my $realkey = &makecndhash($CANDIDATE{'createdate'}, $CANDIDATE{'uid'});
-			$realkey =~ s/-//g;
-			$FORM{'validationcode'} =~ s/-//g;
-			if ($CLIENT{'emlval'} eq "Y") { #If the client doesnt want selfreg eml validation, ignore this and go straight to regsas.
-				if ($CANDIDATE{'selfreg'} eq "Y" && $CANDIDATE{'validated'} eq "N") {
-					if ($FORM{'resendkey'} eq "Y") {
-						$SESSION{'message'} = "<%=PHRASE.868%>";
-						&send_the_mail("$CLIENT{'clid'}.emlresend", "testmanager.com Personal Validation Key", $CANDIDATE{'eml'});
-						print "Content-Type: text/html\n\n";
-						&show_template("validatesreg");
-					} elsif ($FORM{'validationcode'} eq $realkey) {
-						$FORM{'validated'} = "Y";
-						$FORM{'uid'} = $CANDIDATE{'uid'}; #This is because regsas is terribly broken when it treats form variables
-						&put_candidate_profile($SESSION{'clid'}, $SESSION{'uid'});
-						#&show_template("regsas");
-						$vars{'home'}  = "client";
-						$vars{'lang'} = "$FORM{'lang'}";
-						$vars{'uid'} = "$CANDIDATE{'uid'}";
-						$vars{'pwd'} = "$CANDIDATE{'pwd'}";
-						$vars{'clid'} = "$SESSION{'clid'}";
-						$vars{'cnd'} = "Login";
-			
-						&redirect("login", \%vars);
-					} else {
-						if ($FORM{'validationcode'} ne '') {
-							$SESSION{'message'} = "<%=PHRASE.867%>";
-						} else {
-							$SESSION{'message'} = "<br>";
-						}
-						print "Content-Type: text/html\n\n";
-						&show_template("validatesreg");
-					}
-				} elsif ($CANDIDATE{'selfreg'} eq "Y" && $CANDIDATE{'validated'} eq "Y") {
-					print "Content-Type: text/html\n\n";
-					$FORM{'allowin'} = "Y";
-					&show_template("regsas");
-				} else { #Dont punish old sreggers without a $CANDIDATE{'validated'} value, which is all of them to this point
-					$FORM{'allowin'} = "Y";
-					print "Content-Type: text/html\n\n";
-					&show_template("regsas");
-				}
-			} else {
-				print "Content-Type: text/html\n\n";
-				if ($errmess ne '') {
-					$FORM{'badid'} = $errmess;
-				}
-				&show_template("regsas");
-			}
-		}
-	}
-}
-#
-# Verify that the requested id is not already
-# used in admin.dat or cnd.{client}
-# if not used add it to the cnd.{client} file
-#
-sub adduidreq {
-	my ($clid,$urq,$urpw) = @_;
-	my @crecs = &get_data("admin.dat");
-	my $rec;
-	my $i;
-	my $fldkey;
-	my $fldval;
-	my $trash;
-	my @flds;
-	my $retOK=1;
-	my @found = grep( /$urq&/ ,@crecs);
-	if ($#found != -1) {
-		#
-		# verify that the first field is the requested urq
-		# just in case grep picked it up somewhere else in the record
-		#
-		foreach $rec (@found) {
-			@flds=split(/&/, $rec);
-			if ($flds[0] eq $urq) {
-				$retOK=0;
-				$last;
-			}
-		}
-	}
-	my $cndeml = $FORM{'eml'};
-	if ($CLIENT{'emlacl'} eq "Y") {
-		my @tempacl = &popEmlAcl($SESSION{'clid'});
-		if ($CLIENT{'emlacllst'} eq "B") {
-			foreach (@tempacl) {
-				if ($cndeml =~ /$_/g) {
-					$retOK = 0;
-					$errmess2 = $xlatphrase[903];
-				}
-			}
-		}
-		if ($CLIENT{'emlacllst'} eq "W") {
-			foreach (@tempacl) {
-				$tempemltest .= $_;
-			}
-			$tmpemladr = $cndeml;
-			$tmpemladr =~ s/@/ /g;
-			$tmpemladr =~ /\w+\.\w+$/g;
-			$tmpemladr = $&;	#the domain.ltd part of user@domain.ltd
-			if ( !($tempemltest =~/$tmpemladr/) ) {
-				$retOK = 0;
-				$errmess2 = $xlatphrase[903];
-			}
-		}
-		
-	}
-	if ($CLIENT{'emlstrict'} eq "Y") {
-		my @cndcols = &get_data("cnd.$clid");
-		my @duplicates = grep(/$cndeml/, @cndcols);
-		foreach (@duplicates) {
-			$retOK=0;
-			$errmess2 = $xlatphrase[904];
-		}
-	}
-	if ($retOK == 1) {
-		@crecs = &get_data("cnd.$clid");
-		my $rhdr = shift @crecs;
-		@found = grep( /$urq&/ ,@crecs);
-		if ($#found != -1) {
-			#
-			# verify that the first field is the requested uid
-			# just in case grep picked it up somewhere else in the record
-			#
-			foreach $rec (@found) {
-				@flds=split(/&/, $rec);
-				if ($flds[0] eq $urq) {
-					$retOK=0;
-					$last;
-				}
-			}
-		}
-		if ($retOK == 1) {
-			#
-			# add the requested uid
-			#
-			$rec=$rhdr;
-			chop($rec);
-			@flds=split(/&/,$rec);
-			$rec = join('&',$urq,$urpw);
-			$FORM{'selfreg'} = "Y";
-			for $i (2 .. $#flds) {
-				$fldkey=$flds[$i];
-				$FORM{$fldkey} =~ tr/+/ /;
-				$fldval=$FORM{$fldkey};
-				$rec = join('&', $rec, $fldval);
-			}
-			push @crecs,"$rec\n";
-			my @csorted = sort @crecs;
-			@crecs=();
-			unshift @csorted,$rhdr;
-			$retOK=0;
-
-
-			#This adds createdate and validated to the new candidate stack
-			my $shift_hack = shift(@csorted);
-			$shift_hack =~ (s/authtests/createdate/);
-			$shift_hack =~ (s/grpid/createdby/);
-			$_ = $shift_hack;
-			if ( !(/validated/)) {
-				chomp $shift_hack;
-				$shift_hack .= '&validated'."\n";
-			}
-			if ( !(/registrar/)) {
-				chomp $shift_hack;
-				$shift_hack .= '&registrar'."\n";
-			}
-			### DED 3/26/07 These fields not yet supported
-			#if ( !(/cnd3/)) {
-				#chomp $shift_hack;
-				#$shift_hack .= '&cnd3'."\n";
-			#}
-			#if ( !(/cnd4/)) {
-				#chomp $shift_hack;
-				#$shift_hack .= '&cnd4'."\n";
-			#}
-			unshift (@csorted, $shift_hack);
-
-			my @labels = split('&', @csorted[0]);
-			my @fields;
-			foreach (@csorted) {
-				if (/^$urq&/) {
-					@fields = split('&', $_);
-				}
-			}
-			my %turbohash = (); #merge them into a hash
-				foreach (0..$#labels) { 		
-					$turbohash{$labels[$_]} = $fields[$_];
-				}
-				$turbohash{'createdate'} = time();
-				$turbohash{'createdby'} = $FORM{'uidreq'};
-				$turbohash{'validated'} = 'N';
-			#Now we have to put them all together in the same order as the key row
-			my $client_string; #will hold the temp. line for cnd.clientid
-			foreach (0..$#labels) {
-				chomp($labels[$_]); #chomp it because $labels[-1] is actually $labels[-1]\n
-				$client_string .= "&$turbohash{$labels[$_]}";
-			}
-			$client_string =~ s/^&//; 
-			$client_string =~ s/\n//g;
-			$client_string =~ s/\+/ /g;
-			$client_string .= "\n"; #insert the \n after the chomp
-			foreach my $rotator (1..$#csorted) { 		#scary part where we insert it back into the array
-				if ($csorted[$rotator] =~ /^$urq&/) {
-					$csorted[$rotator] = $client_string;
-				}
-			}
-					
-
-			my $tmpfile = join($pathsep, $dataroot, "cnd.$clid");
-			my $existed=&file_exists($tmpfile);
-			if ( open (TMPFILE, ">$tmpfile") ) {
-				for $i (0 .. $#csorted) {
-					print TMPFILE "$csorted[$i]";
-				}
-				close TMPFILE;
-				if ($existed==0) {
-					$chmodok = chmod 0666, $_[0];
-				}
-				$retOK=1;
-			}
-			@csorted=();
-		}
-	}
-	#
-	# clean up
-	#
-	@flds=();
-	@found=();
-	@crecs=();
-	return $retOK;
-}
-
-
-
-sub send_the_mail {	#This is a special function to send the validation key email. Shouldn't ever be needed outside this file.
-	my $mmfrom = $CLIENT{'email_from'};
-        my $eml_txt = join( $pathsep, $dataroot,  $_[0]);
-        my $mmsubj = $_[1];
-        my $mmto = $_[2];
-        my $hash_createdate = &get_a_key("cnd.$SESSION{'clid'}", $CANDIDATE{'uid'}, "createdate");
-        my $mmbody = '';
-        if ( open(EMLBODY, "<$eml_txt") ) {
-        	foreach (<EMLBODY>) {
-                	$mmbody .= $_;
-        		close(EMLBODY);
-        	}
-	} else {
-		$mmbody = "Thank you for registering at $ENV{'HTTP_HOST'}. Your personal Registration Code is <%=NOP_valkey%>. You will only have to enter it once.\n"
-	}
-	#insert customized regex here
-	my $valkey = &makecndhash($hash_createdate, $CANDIDATE{'uid'});
-	#print STDERR "valkey = $valkey, hash_createdate = $hash_createdate, uid = $CANDIDATE{'uid'}\n";	#uncomment this to see all necessary validation key info
-        $mmbody =~ s/\<%=NOP_valkey%\>/$valkey/g;
-	$mmbody = &xlatline($mmbody, '', 0);
-
-	&send_mail($mmfrom, $mmto, $mmsubj, $mmbody);
-}

survey-nginx/cgi-bin/regsas.pl.bu20190730

@@ -1,462 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: regsas.pl,v 1.21 2006/11/28 21:07:48 psims Exp $
-#
-# Source File: regsas.pl
-
-# Set variables local to this code file.
-
-# HBI Shorten validation key to less characters.
-%Long_Val_Client = () ; 
-# Inital value, no clients use the long validation string. 
-# This is a global that could be modified in sitecfg.pl
-my $Short_Val_off = 1 ; # Start with the second digit of the computed value.
-my $Short_Val_len = 3 ; # Use three characters.
-
-# Get config
-require 'sitecfg.pl';
-require 'testlib.pl';
-
-&app_initialize;
-
-&setbrowsertype();
-if ($FORM{'newsas'} ne "") {
-	$SESSION{'clid'} = $FORM{'clid'};
-	$SESSION{'lang'} = $FORM{'lang'};
-	&get_client_configuration();
-	&LanguageSupportInit();
-	if ($FORM{'dbop'} eq 'save') {
-		&get_client_profile($SESSION{'clid'});
-		if (&adduidreq($SESSION{'clid'},$FORM{'uidreq'},$FORM{'pwdreq'})) {
-			$FORM{'uid'}=$FORM{'uidreq'};
-			$CANDIDATE{'uid'}=$FORM{'uidreq'};
-			$FORM{'clid'}=$SESSION{'clid'};
-			&get_candidate_profile($SESSION{'clid'}, $FORM{'uid'}, $opts);
-			&send_the_mail("$CLIENT{'clid'}.emlsend", "testmanager.com Personal Validation Key", $FORM{'eml'}) unless $CLIENT{'emlval'} ne "Y"; 
-			$FORM{'uac'}='sas';
-			&init_session;
-			&LanguageSupportInit();
-			my $opts = { restrict_to_availability_window => 1 };
-			&get_candidate_profile($SESSION{'clid'}, $SESSION{'uid'}, $opts);
-			&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "1");
-			$FORM{'notice'} = $SYSTEM{'message'};
-			$CANDIDATE{'badid'}="";
-		} else {
-			&get_candidate_profile($SESSION{'clid'}, $FORM{'uid'});
-			if ($FORM{'allowin'} ne "Y") {
-				$CANDIDATE{'firstlogin'}="";
-				$CANDIDATE{'new'}="Y";
-				$errmess = $xlatphrase[758];
-				$CANDIDATE{'badid'}="$xlatphrase[758]";
-                        }
-		}
-
-		#$CANDIDATE{'sal'}="";
-		#$CANDIDATE{'nmf'}=$FORM{'nmf'};
-		#$CANDIDATE{'nmm'}=$FORM{'nmm'};
-		#$CANDIDATE{'nml'}=$FORM{'nml'};
-		#$CANDIDATE{'adr'}=$FORM{'adr'};
-		#$CANDIDATE{'cty'}=$FORM{'cty'};
-		#$CANDIDATE{'ste'}=$FORM{'ste'};
-		#$CANDIDATE{'pst'}=$FORM{'pst'};
-		#$CANDIDATE{'ctry'}=$FORM{'ctry'};
-		#$CANDIDATE{'eml'}=$FORM{'eml'};
-		#$CANDIDATE{'cnd1'}=$FORM{'cnd1'};
-		#$CANDIDATE{'cnd2'}=$FORM{'cnd2'};
-		#$CANDIDATE{'cnd3'}=$FORM{'cnd3'};
-		#$CANDIDATE{'cnd4'}=$FORM{'cnd4'};
-		#$CANDIDATE{'uid'}=$FORM{'uid'};
-		if ($CANDIDATE{'badid'} eq "$xlatphrase[758]") {
-			if ($errmess2 ne '') { #This is the fast way to patch error messages
-				$FORM{'badid'} = $errmess2;
-			} else {
-				$FORM{'badid'} = $errmess unless $errmess eq '';
-			}
-			print "Content-Type: text/html\n\n";
-			&show_template("regsas");
-		} else {
-			$vars{'home'}  = "client";
-			$vars{'lang'} = "$FORM{'lang'}";
-			$vars{'uid'} = "$CANDIDATE{'uid'}";
-			$vars{'pwd'} = "$CANDIDATE{'pwd'}";
-			$vars{'clid'} = "$SESSION{'clid'}";
-			$vars{'cnd'} = "Login";
-			$vars{'newsas'} = "";
-			$vars{'dbop'} = "$FORM{'dbop'}";
-
-			&redirect("login", \%vars);
-		}
-	}
-} else {
-	if (&get_session($FORM{'tid'})) {
-		&LanguageSupportInit();
-		if ($FORM{'lang'} eq "") { $FORM{'lang'} = $SESSION{'lang'}; }
-		if ($FORM{'dbop'} eq 'logout') {
-			$indextemplate = ($SESSION{'clid'} eq 'std') ? "shome" : "cindex";
-			if ($SESSION{'clid'} ne 'std') {&get_client_profile($SESSION{'clid'});}
-			print "Content-Type: text/html\n\n";
-			&show_template("$indextemplate");
-		} elsif ($FORM{'dbop'} eq 'save') {
-			&get_client_profile($SESSION{'clid'});
-			&get_candidate_profile( $SESSION{'clid'}, $SESSION{'uid'});
-                	foreach (keys %CANDIDATE) {
-                       		if (!( defined($FORM{$_}) )) {
-                               			$FORM{$_} = $CANDIDATE{$_};
-                        	}
-				if ($CLIENT{'savechange'} eq "N") {
-                               		$FORM{$_} = $CANDIDATE{$_} unless $_ eq 'pwd';
-				}
-                        	if ($_ eq 'pwd') { #Do this type of check for filters based on seperate buttons
-                               		if ($FORM{'oldpwdval'} ne $CANDIDATE{'pwd'} && $FORM{'oldpwdval'} ne '') {
-                                        	$errmess = "$xlatphrase[888]";
-						$direction = "password";
-                                        	$FORM{$_} = $CANDIDATE{$_};
-                                	} else {
-                                        	$errmess = "$xlatphrase[879]" unless $FORM{'oldpwdval'} eq '';
-                                	}
-                        	}
-				if ($FORM{'eml'} ne $CANDIDATE{'eml'}) { #Do this type of check on every subsequent filter based revision
-					$FORM{'validated'} = 'N';
-					$continue_eml_tests = 1;
-					&send_the_mail("$CLIENT{'clid'}.emlsend", "testmanager.com Personal Validation Key", $FORM{'eml'}) unless $CLIENT{'emlval'} ne "Y"; 
-					$CANDIDATE{'badid'}="$xlatphrase[872]" unless $CLIENT{'emlval'}  ne "Y";
-					&get_client_profile($SESSION{'clid'});
-					if ( ($CLIENT{'emlacl'} eq "Y") && ($continue_eml_tests == 1) ){
-						my @tempacl = &popEmlAcl($CLIENT{'clid'});
-						if ($CLIENT{'emlacllst'} eq "B") {
-							foreach (@tempacl) {
-								if ($FORM{'eml'} =~ /$_/g) {
-									$FORM{'eml'} = $CANDIDATE{'eml'};
-									$continue_eml_tests = 0;
-									$errmess = $xlatphrase[903];
-								}
-							}
-						}
-						if ($CLIENT{'emlacllst'} eq "W") {
-							foreach (@tempacl) {
-								$tempemlacltest .= $_;
-							}
-							$tmpemladr = $FORM{'eml'};
-							$tmpemladr =~ s/@/ /g;
-							$tmpemladr =~ /\w+\.\w+$/g;
-							$tmpemladr = $&;
-							if ( !($tempemlacltest =~ /$tmpemladr/) ) {
-								$FORM{'eml'} = $CANDIDATE{'eml'};
-								$continue_eml_tests = 0;
-								$errmess = $xlatphrase[903];
-							}
-						}
-					}
-					if ( ($CLIENT{'emlstrict'} eq "Y") && ($continue_eml_tests == 1) ) {
-						my $clid = $SESSION{'clid'};
-						my @cndcols = &get_data("cnd.$SESSION{'clid'}");
-						my @duplicates = grep(/$FORM{'eml'}/, @cndcols);
-						foreach (@duplicates) {
-							$errmess = $xlatphrase[904];
-							$continue_eml_tests = 0;
-							$FORM{'eml'} = $CANDIDATE{'eml'};
-						}
-					}
-				}
-			}
-			&put_candidate_profile($SESSION{'clid'}, $SESSION{'uid'});
-			&get_candidate_profile( $SESSION{'clid'}, $SESSION{'uid'});
-        	        if ($CANDIDATE{'badid'} eq "$xlatphrase[758]" || $CANDIDATE{'badid'} eq "$xlatphrase[872]") {
-                                $vars{'home'}  = "client";
-                                $vars{'lang'} = "$FORM{'lang'}";
-                                $vars{'uid'} = "$CANDIDATE{'uid'}";
-                                $vars{'pwd'} = "$CANDIDATE{'pwd'}";
-                                $vars{'clid'} = "$SESSION{'clid'}";
-                                $vars{'cnd'} = "Login";
-				$vars{'badid'} = "$xlatphrase[758]" unless $CANDIDATE{'badid'} ne "$xlatphrase[758]";
-				$vars{'badid'} = "$xlatphrase[872]" unless $CANDIDATE{'badid'} ne "$xlatphrase[872]";
-			&redirect("login", \%vars);
-               	 	} else {
-               	       		$vars{'home'}  = "client";
-               	       		$vars{'lang'} = "$FORM{'lang'}";
-               	      		$vars{'uid'} = "$CANDIDATE{'uid'}";
-               	   		$vars{'pwd'} = "$CANDIDATE{'pwd'}";
-               	       		$vars{'clid'} = "$SESSION{'clid'}";
-                       		$vars{'cnd'} = "Login";
-				$vars{'badid'} = $errmess unless $errmess eq '';
-				$vars{'direction'} = $direction unless $direction eq '';
-				&redirect("login", \%vars);
-                	}
-			#print "Content-Type: text/html\n\n";
-			#&show_template("regsas");
-		 } elsif ($FORM{'dbop'} eq 'resend') {
-			&resend_exit_emails($SESSION{'clid'}, $SESSION{'uid'}, $FORM{'tstid'});
-			$vars{'tid'} = "$SESSION{'tid'}";
-			$vars{'lang'} = "$SESSION{'lang'}";
-			&redirect("regsas", \%vars);
-		} else {
-			&get_client_profile($SESSION{'clid'});
-
-			my $opts = { restrict_to_availability_window => 1 };
-			&get_candidate_profile( $SESSION{'clid'}, $SESSION{'uid'}, $opts);
-			my $realkey = &makecndhash($CANDIDATE{'createdate'}, $CANDIDATE{'uid'});
-			$realkey =~ s/-//g;
-			# HBI Shorten validation key to less characters.
-			unless ($Long_Val_Client{$SESSION{'clid'}} ) {
-				$realkey = substr($realkey, $Short_Val_off, $Short_Val_len) ;
-			}
-			$FORM{'validationcode'} =~ s/-//g;
-			if ($CLIENT{'emlval'} eq "Y") { #If the client doesnt want selfreg eml validation, ignore this and go straight to regsas.
-				if ($CANDIDATE{'selfreg'} eq "Y" && $CANDIDATE{'validated'} eq "N") {
-					if ($FORM{'resendkey'} eq "Y") {
-						$SESSION{'message'} = "<%=PHRASE.868%>";
-						&send_the_mail("$CLIENT{'clid'}.emlresend", "testmanager.com Personal Validation Key", $CANDIDATE{'eml'});
-						print "Content-Type: text/html\n\n";
-						&show_template("validatesreg");
-					} elsif ($FORM{'validationcode'} eq $realkey) {
-						$FORM{'validated'} = "Y";
-						$FORM{'uid'} = $CANDIDATE{'uid'}; #This is because regsas is terribly broken when it treats form variables
-						&put_candidate_profile($SESSION{'clid'}, $SESSION{'uid'});
-						#&show_template("regsas");
-						$vars{'home'}  = "client";
-						$vars{'lang'} = "$FORM{'lang'}";
-						$vars{'uid'} = "$CANDIDATE{'uid'}";
-						$vars{'pwd'} = "$CANDIDATE{'pwd'}";
-						$vars{'clid'} = "$SESSION{'clid'}";
-						$vars{'cnd'} = "Login";
-			
-						&redirect("login", \%vars);
-					} else {
-						if ($FORM{'validationcode'} ne '') {
-							$SESSION{'message'} = "<%=PHRASE.867%>";
-						} else {
-							$SESSION{'message'} = "<br>";
-						}
-						print "Content-Type: text/html\n\n";
-						&show_template("validatesreg");
-					}
-				} elsif ($CANDIDATE{'selfreg'} eq "Y" && $CANDIDATE{'validated'} eq "Y") {
-					print "Content-Type: text/html\n\n";
-					$FORM{'allowin'} = "Y";
-					&show_template("regsas");
-				} else { #Dont punish old sreggers without a $CANDIDATE{'validated'} value, which is all of them to this point
-					$FORM{'allowin'} = "Y";
-					print "Content-Type: text/html\n\n";
-					&show_template("regsas");
-				}
-			} else {
-				print "Content-Type: text/html\n\n";
-				if ($errmess ne '') {
-					$FORM{'badid'} = $errmess;
-				}
-				&show_template("regsas");
-			}
-		}
-	}
-}
-#
-# Verify that the requested id is not already
-# used in admin.dat or cnd.{client}
-# if not used add it to the cnd.{client} file
-#
-sub adduidreq {
-	my ($clid,$urq,$urpw) = @_;
-	my @crecs = &get_data("admin.dat");
-	my $rec;
-	my $i;
-	my $fldkey;
-	my $fldval;
-	my $trash;
-	my @flds;
-	my $retOK=1;
-	my @found = grep( /$urq&/ ,@crecs);
-	if ($#found != -1) {
-		#
-		# verify that the first field is the requested urq
-		# just in case grep picked it up somewhere else in the record
-		#
-		foreach $rec (@found) {
-			@flds=split(/&/, $rec);
-			if ($flds[0] eq $urq) {
-				$retOK=0;
-				$last;
-			}
-		}
-	}
-	my $cndeml = $FORM{'eml'};
-	if ($CLIENT{'emlacl'} eq "Y") {
-		my @tempacl = &popEmlAcl($SESSION{'clid'});
-		if ($CLIENT{'emlacllst'} eq "B") {
-			foreach (@tempacl) {
-				if ($cndeml =~ /$_/g) {
-					$retOK = 0;
-					$errmess2 = $xlatphrase[903];
-				}
-			}
-		}
-		if ($CLIENT{'emlacllst'} eq "W") {
-			foreach (@tempacl) {
-				$tempemltest .= $_;
-			}
-			$tmpemladr = $cndeml;
-			$tmpemladr =~ s/@/ /g;
-			$tmpemladr =~ /\w+\.\w+$/g;
-			$tmpemladr = $&;	#the domain.ltd part of user@domain.ltd
-			if ( !($tempemltest =~/$tmpemladr/) ) {
-				$retOK = 0;
-				$errmess2 = $xlatphrase[903];
-			}
-		}
-		
-	}
-	if ($CLIENT{'emlstrict'} eq "Y") {
-		my @cndcols = &get_data("cnd.$clid");
-		my @duplicates = grep(/$cndeml/, @cndcols);
-		foreach (@duplicates) {
-			$retOK=0;
-			$errmess2 = $xlatphrase[904];
-		}
-	}
-	if ($retOK == 1) {
-		@crecs = &get_data("cnd.$clid");
-		my $rhdr = shift @crecs;
-		@found = grep( /$urq&/ ,@crecs);
-		if ($#found != -1) {
-			#
-			# verify that the first field is the requested uid
-			# just in case grep picked it up somewhere else in the record
-			#
-			foreach $rec (@found) {
-				@flds=split(/&/, $rec);
-				if ($flds[0] eq $urq) {
-					$retOK=0;
-					$last;
-				}
-			}
-		}
-		if ($retOK == 1) {
-			#
-			# add the requested uid
-			#
-			$rec=$rhdr;
-			chop($rec);
-			@flds=split(/&/,$rec);
-			$rec = join('&',$urq,$urpw);
-			$FORM{'selfreg'} = "Y";
-			for $i (2 .. $#flds) {
-				$fldkey=$flds[$i];
-				$FORM{$fldkey} =~ tr/+/ /;
-				$fldval=$FORM{$fldkey};
-				$rec = join('&', $rec, $fldval);
-			}
-			push @crecs,"$rec\n";
-			my @csorted = sort @crecs;
-			@crecs=();
-			unshift @csorted,$rhdr;
-			$retOK=0;
-
-
-			#This adds createdate and validated to the new candidate stack
-			my $shift_hack = shift(@csorted);
-			$shift_hack =~ (s/authtests/createdate/);
-			$shift_hack =~ (s/grpid/createdby/);
-			$_ = $shift_hack;
-			if ( !(/validated/)) {
-				chomp $shift_hack;
-				$shift_hack .= '&validated'."\n";
-			}
-			if ( !(/registrar/)) {
-				chomp $shift_hack;
-				$shift_hack .= '&registrar'."\n";
-			}
-			### DED 3/26/07 These fields not yet supported
-			#if ( !(/cnd3/)) {
-				#chomp $shift_hack;
-				#$shift_hack .= '&cnd3'."\n";
-			#}
-			#if ( !(/cnd4/)) {
-				#chomp $shift_hack;
-				#$shift_hack .= '&cnd4'."\n";
-			#}
-			unshift (@csorted, $shift_hack);
-
-			my @labels = split('&', @csorted[0]);
-			my @fields;
-			foreach (@csorted) {
-				if (/^$urq&/) {
-					@fields = split('&', $_);
-				}
-			}
-			my %turbohash = (); #merge them into a hash
-				foreach (0..$#labels) { 		
-					$turbohash{$labels[$_]} = $fields[$_];
-				}
-				$turbohash{'createdate'} = time();
-				$turbohash{'createdby'} = $FORM{'uidreq'};
-				$turbohash{'validated'} = 'N';
-			#Now we have to put them all together in the same order as the key row
-			my $client_string; #will hold the temp. line for cnd.clientid
-			foreach (0..$#labels) {
-				chomp($labels[$_]); #chomp it because $labels[-1] is actually $labels[-1]\n
-				$client_string .= "&$turbohash{$labels[$_]}";
-			}
-			$client_string =~ s/^&//; 
-			$client_string =~ s/\n//g;
-			$client_string =~ s/\+/ /g;
-			$client_string .= "\n"; #insert the \n after the chomp
-			foreach my $rotator (1..$#csorted) { 		#scary part where we insert it back into the array
-				if ($csorted[$rotator] =~ /^$urq&/) {
-					$csorted[$rotator] = $client_string;
-				}
-			}
-					
-
-			my $tmpfile = join($pathsep, $dataroot, "cnd.$clid");
-			my $existed=&file_exists($tmpfile);
-			if ( open (TMPFILE, ">$tmpfile") ) {
-				for $i (0 .. $#csorted) {
-					print TMPFILE "$csorted[$i]";
-				}
-				close TMPFILE;
-				if ($existed==0) {
-					$chmodok = chmod 0666, $_[0];
-				}
-				$retOK=1;
-			}
-			@csorted=();
-		}
-	}
-	#
-	# clean up
-	#
-	@flds=();
-	@found=();
-	@crecs=();
-	return $retOK;
-}
-
-
-
-sub send_the_mail {	#This is a special function to send the validation key email. Shouldn't ever be needed outside this file.
-	my $mmfrom = $CLIENT{'email_from'};
-        my $eml_txt = join( $pathsep, $dataroot,  $_[0]);
-        my $mmsubj = $_[1];
-        my $mmto = $_[2];
-        my $hash_createdate = &get_a_key("cnd.$SESSION{'clid'}", $CANDIDATE{'uid'}, "createdate");
-        my $mmbody = '';
-        if ( open(EMLBODY, "<$eml_txt") ) {
-        	foreach (<EMLBODY>) {
-                	$mmbody .= $_;
-        		close(EMLBODY);
-        	}
-	} else {
-		$mmbody = "Thank you for registering at $ENV{'HTTP_HOST'}. Your personal Registration Code is <%=NOP_valkey%>. You will only have to enter it once.\n"
-	}
-	#insert customized regex here
-	my $valkey = &makecndhash($hash_createdate, $CANDIDATE{'uid'});
-	#print STDERR "valkey = $valkey, hash_createdate = $hash_createdate, uid = $CANDIDATE{'uid'}\n";	#uncomment this to see all necessary validation key info
-	# HBI Shorten validation key to less characters.
-	unless ($Long_Val_Client{$SESSION{'clid'}} ) {
-		$valkey =~ s/-//g;
-		$valkey = substr($valkey, $Short_Val_off, $Short_Val_len) ;
-	}
-        $mmbody =~ s/\<%=NOP_valkey%\>/$valkey/g;
-	$mmbody = &xlatline($mmbody, '', 0);
-	&send_mail($mmfrom, $mmto, $mmsubj, $mmbody);
-}
-

survey-nginx/cgi-bin/sadmin.pl.bu20120228

@@ -1,468 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: sadmin.pl,v 1.12 2006/11/28 21:07:48 psims Exp $
-#
-# Source File: sadmin.pl
-
-# Get config
-require 'sitecfg.pl';
-require 'testlib.pl';
-
-&app_initialize;
-
-print "Content-Type: text/html\n\n";
-
-if (&get_session($FORM{'tid'})) {
-	&LanguageSupportInit();
-	if ($SESSION{'clid'} ne 'std') {
-		&get_client_profile($SESSION{'clid'});
-		if ($SESSION{'uac'} eq 'admin' || $SESSION{'uac'} eq 'madmin') {
-			$FORM{'pageid'} = "Group";
-			$FORM{'PAGEID'} = "GROUP";
-			$mainttmplt = "frgrpadmin";
-		} else {
-			&get_candidate_profile($SESSION{'clid'}, $SESSION{'uid'});
-			$FORM{'pageid'} = "Gradebook";
-			$FORM{'PAGEID'} = "GRADEBOOK";
-			$mainttmplt = "frgradebooks";
-		}
-	}
-
-	my @tempacl = &popEmlAcl($SESSION{'clid'});
-	foreach (@tempacl) {
-		$CLIENT{'emlaclstr'} .= "$_,";
-	}
-	$CLIENT{'emlaclstr'} =~ s/@//g;
-	$CLIENT{'emlaclstr'} =~ s/,$//g;
-
-
-
-	if ($FORM{'idx'} eq '1') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/I");
-		if ($SESSION{'uac'} eq 'admin' || $SESSION{'uac'} eq 'gadmin' || $SESSION{'uac'} eq 'madmin') {
-			&show_template("sadminidx");
-		} else {
-			&show_template("cndidx");
-		}
-	} elsif ($FORM{'dtl'} eq '0') {
-		print "<HTML>\n$xlatphrase[539]<BR>$xlatphrase[540]</HTML>\n";
-	} elsif ($FORM{'dtl'} eq '1') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/CM");
-		if ($SESSION{'uac'} eq 'gadmin') {
-			&show_admin_request("maintclient");
-		} else {
-			$FORM{'dbop'} = 'ccupd';
-			&show_admin_request("cdef");
-		}
-	} elsif ($FORM{'dtl'} eq '12') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/TR");
-		&show_admin_request("treplicaframe");
-	} elsif ($FORM{'dtl'} eq '13') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/TO");
-		&show_admin_request("tocrinpframe");
-	} elsif ($FORM{'dtl'} eq '2') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/TM");
-		$TEST{'id'} = $FORM{'tstid'};
-		&show_admin_request("tdefframe");
-	} elsif ($FORM{'dtl'} eq '21') {
-		if ($SESSION{'uac'} eq 'cnd') {
-			$CANDIDATE{'ownedtests'} = &get_group_tests($SESSION{'clid'}, $SESSION{'uid'}, 0);
-		}
-		&show_admin_request("mainttest");
-	} elsif ($FORM{'dtl'} eq '99') {
-		&show_template("selectpg");
-	} elsif ($FORM{'dtl'} eq '3') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/R");
-		&show_admin_request("maintreport");
-	} elsif ($FORM{'dtl'} eq '4') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/DL");
-		&show_admin_downloads;
-	} elsif ($FORM{'dtl'} eq '5') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/DB");
-		&show_admin_request("maintdb");
-	} elsif ($FORM{'dtl'} eq '6') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/CF");
-		# set FORM.colors
-		$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;
-		$langdef = "enu";
-		$FORM{'colors'} = "";
-		for (0 .. $#cfgentries) {
-			chop ($cfgentries[$_]);
-			($entrykey,$entryvalue) = split(/=/, $cfgentries[$_]);
-			if ($entrykey eq 'DEFAULTLANG') {
-				$langdef = $entryvalue;
-				$langselfr = ($langdef eq 'fr') ? " SELECTED" : "";
-				$langselsp = ($langdef eq 'sp') ? " SELECTED" : "";
-				$langseldeu = ($langdef eq 'deu') ? " SELECTED" : "";
-				$langselenu = ($langdef eq 'enu') ? " SELECTED" : "";
-				$langselena = ($langdef eq 'ena') ? " SELECTED" : "";
-				$langseleuv = ($langdef eq 'euv') ? " SELECTED" : "";
-				$langselcyr = ($langdef eq 'cyr') ? " SELECTED" : "";
-				$langselmy = ($langdef eq 'my') ? " SELECTED" : "";
-				$langselkor = ($langdef eq 'kor') ? " SELECTED" : "";
-				$langselafr = ($langdef eq 'afr') ? " SELECTED" : "";
-				$langselhin = ($langdef eq 'hin') ? " SELECTED" : "";
-				$colortag = "<TR>
-			<TD align=right>
-				$xlatphrase[541]\&nbsp\;
-			</TD>
-			<TD align=left>
-				<SELECT NAME=\"CDEFAULTLANG\" onChange=\"reset_autotimer()\">
-				 	<OPTION VALUE=\"enu\"$langselenu>$LANGUAGE_ID{'enu'}
-				 	<OPTION VALUE=\"ena\"$langselena>$LANGUAGE_ID{'ena'}
-				 	<OPTION VALUE=\"euv\"$langseleuv>$LANGUAGE_ID{'euv'}
-			 		<OPTION VALUE=\"fr\"$langselfr>Fráncáís ($LANGUAGE_ID{'fr'})
-				 	<OPTION VALUE=\"deu\"$langseldeu>Dëutsch ($LANGUAGE_ID{'deu'})
-				 	<OPTION VALUE=\"sp\"$langselsp>Español ($LANGUAGE_ID{'sp'})
-				        <OPTION VALUE=\"cyr\"$langselcyr>Cyrillic ($LANGUAGE_ID{'cyr'})
-				        <OPTION VALUE=\"my\"$langselmy>Malay ($LANGUAGE_ID{'my'})
-				        <OPTION VALUE=\"kor\"$langselkor>Korean ($LANGUAGE_ID{'kor'})
-				        <OPTION VALUE=\"afr\"$langselafr>Afrikaans ($LANGUAGE_ID{'afr'})
-				        <OPTION VALUE=\"hin\"$langselafr>Hindi ($LANGUAGE_ID{'hin'})
-				</SELECT>
-			</TD>
-		</TR>\n";
-				$FORM{'language'} = join('', $colortag, $FORM{'language'});
-			} elsif ($entrykey eq 'IP_ACCESS_FILTER') {
-				$FORM{'language'} = "		<TR>
-			<TD align=right width=50\%>
-				$xlatphrase[385]\&nbsp\;
-			</TD>
-			<TD align=left width=50\%>
-				<INPUT TYPE=TEXT NAME=\"C$entrykey\" VALUE=\"$entryvalue\" onChange=\"reset_autotimer()\">
-			</TD>
-		</TR>\n";
-			} else {
-				if ($entrykey eq 'BACKGROUND') {
-					$colortag = "		<TR>
-			<TD align=right><font size=1>$entrykey:\&nbsp\;</font></TD>
-			<TD align=left><INPUT TYPE=FILE NAME=\"C$entrykey\" VALUE=\"$entryvalue\" onChange=\"reset_autotimer()\"></TD>
-		</TR>\n";
-				} else {
-					if (($entrykey =~ /COLOR/) 
-						|| ($entrykey =~ 'LINK')
-						|| ($entrykey =~ 'ALINK')
-						|| ($entrykey =~ 'VLINK')
-						|| ($entrykey eq 'TEXT') ) {
-						$gotfocus = "onFocus=\"return tGotFocus(this)\"";
-					} else {
-						$gotfocus = "";
-					}
-					$colortag = "		<TR>
-			<TD align=right nowrap><font size=1>$entrykey:\&nbsp\;</font></TD>
-			<TD align=left><INPUT TYPE=TEXT NAME=\"C$entrykey\" SIZE=8 MAXLENGTH=7 VALUE=\"$entryvalue\" $gotfocus onChange=\"reset_autotimer()\"></TD>
-		</TR>\n";
-				}
-				$FORM{'colors'} = join('', $FORM{'colors'}, $colortag);
-			}
-		}
-		&show_admin_request("maintcfg");
-	} elsif ($FORM{'dtl'} eq '7') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/GP");
-		&show_admin_request($mainttmplt);
-	} elsif ($FORM{'dtl'} eq '8') {
-#Begin filtering
-		$filterbydate = $FORM{'filterbydate'};
-		$day_filter = $FORM{'day_filter'};
-		$date_filter = $FORM{'date_filter'};
-		$cnd1_filter = $FORM{'cnd1'};
-		$cnd2_filter = $FORM{'cnd2'};
-		$cnd3_filter = $FORM{'cnd3'};
-		$cnd4_filter = $FORM{'cnd4'};
-#End filtering
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/CC");
-		&show_admin_request("maintcnd");
-	} elsif ($FORM{'dtl'} eq '9') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/RG");
-		&show_admin_request("regcnd");
-	} elsif ($FORM{'dtl'} eq '10') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/IM");
-		&show_admin_request("upimport");
-	} elsif ($FORM{'dtl'} eq '11') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "SA/LC");
-		&show_admin_request("frlicadmin");
-	} elsif ($FORM{'dbop'} ne '') {
-		&show_dbop_response;
-	} else {
-		&show_illegal_access_warning;
-	}
-} else {
-	&logger::logerr("Unable to get session with &get_session($FORM{'tid'})");
-	&show_illegal_access_warning;
-}
-
-sub show_license_request {
-}
-
-sub show_admin_downloads {
-	@dlrecs = &get_data("downloads.dat");
-	$bFirst=1;
-	if ($#dlrecs eq 0) {
-		$download = "<OPTION VALUE=\"nya\">No downloads are currently available.\n";
-		$SYSTEM{'downloadcount'} = 1;
-	} else {
-		$downloadcount=0;
-		foreach $dlrec (@dlrecs) {
-			$msg = "";
-			if ($bFirst) {
-				$bFirst = 0;
-			} else {
-				chop ($dlrec);
-				@flds = split(/&/, $dlrec);
-				$dlfile = join($pathsep, $pubroot, "downloads/$flds[2]");
-				open (TMPFILE, "<$dlfile") or $msg="nya";
-				if ($msg eq 'nya') {
-					$download = "<OPTION VALUE=\"nya\">$flds[1] (Coming Soon)\n";
-				} else {
-					binmode(TMPFILE);
-					$fsize = (stat(TMPFILE))[7];
-					close TMPFILE;
-					$download = "<OPTION VALUE=\"$flds[2]\">$flds[1] ($fsize bytes)\n";
-				}
-				$downloadcount++;
-				$downloads = join('', $downloads , $download);
-			}
-		}
-		if ($downloadcount == 0) { $downloadcount = 1;}
-		if ($downloadcount > 10) { $downloadcount = 10;};
-		$SYSTEM{'downloadcount'} = $downloadcount;
-	}
-	$SYSTEM{'downloads'} = $downloads;
-	@dlrecs = ();
-	$downloads = "";
-	$download = "";
-	&show_template("download");
-}
-
-#sub show_admin_request {    ##moved to smilib
-#	my ($key) = @_;
-#	&get_template($key);
-#	@lines = &get_template($key);
-#	foreach $line (@lines) {
-#		$line = &xlatline($line);
-#	}
-#}
-
-sub show_dbop_response {
-	if ($FORM{'dbop'} eq 'tnew') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Define New Test");
-		$FORM{'newtest'} = "Y";
-		@lines = &get_template("tdefframe");
-		&print_response;
-	} elsif ($FORM{'dbop'} eq'tdel') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Delete Test $FORM{'tstid'}");
-		@trecs = &get_test_list($SESSION{'clid'});
-		foreach $trec (@trecs) {
-			chop ($trec);
-			($id, $trash) = split(/\&/, $trec);
-			if ($FORM{'tstid'} ne $id) {
-				push @newtests, $trec;
-			}
-		}
-		@trecs = @newtests;
-		&save_test_list($SESSION{'clid'});
-		$showmessage = "Test $FORM{'tstid'} has been deleted.";
-		&show_message_with_close($showmessage);
-	} elsif ($FORM{'dbop'} eq 'tupd') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Edit Test $FORM{'tstid'}");
-		$TEST{'new'} = "N";
-		&get_test_profile($SESSION{'clid'}, $FORM{'tstid'});
-		@lines = &get_template("tdefframe");
-		&print_response;
-	} elsif ($FORM{'dbop'} eq 'cnew') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "New Client");
-		$FORM{'newclient'} = "Y";
-		@lines = &get_template("cdef");
-		&print_response;
-	} elsif ($FORM{'dbop'} eq 'cdel') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Delete Client $FORM{'clid'}");
-		&open_results;
-		&client_delete_response;
-		&close_results;
-		$FORM{'dtl'} eq 8;
-	} elsif ($FORM{'dbop'} eq 'cupd') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Edit Client $FORM{'clid'}");
-		&get_client_profile($FORM{'clid'});
-		@lines = &get_template("cdef");
-		&print_response;
-	}
-}
-
-sub print_response {
-	foreach $line (@lines) {
-		$srch = "<%=CLIENT.REPORTING%>";
-		if ( $line =~ /$srch/i) {
-			&client_reporting_options($CLIENT{'clid'});
-		} else {
-			$line = &xlatline($line);
-		}
-	}
-}
-
-sub client_reporting_options {
-#	@rrecs = &get_test_list($_[0]);
-}
-
-sub client_delete_response {
-	&get_client_profile($FORM{'clid'});
-
-	print "Deleting $FORM{'clid'} $CLIENT{'clnmc'} ...<BR>\n";
-
-	# open preservation file
-	$archivefile = join($pathsep, $dataroot, "$FORM{'clid'}.dat");
-	$archivefile =~ s/$docroot/$archiveroot/g;
-	open (ARCHFILE, ">$archivefile");
-
-	# delete client profile
-	@crecs = &get_data("clients.dat");
-	$trash = join($pathsep, $dataroot, "clients.dat");
-	open (TMPFILE, ">$trash");
-	foreach $crec (@crecs) {
-		chop ($crec);
-		($id, $trash) = split(/&/, $crec);
-		if ($id eq $CLIENT{'clid'}) {
-			print ARCHFILE "$crec\n";
-			print "client profile $id archived $! ...<BR>\n";
-		} else {
-			print TMPFILE "$crec\n";
-		}
-	}
-	close TMPFILE;
-
-	# delete administrative logins
-	@crecs = &get_data("admin.dat");
-	$trash = join($pathsep, $dataroot, "admin.dat");
-	open (TMPFILE, ">$trash");
-	foreach $crec (@crecs) {
-		chop ($crec);
-		($id, $pwd, $pv, $clid) = split(/&/, $crec);
-		if ($clid eq $CLIENT{'clid'}) {
-			print ARCHFILE "$crec\n";
-			print "admin login $id archived $! ...<BR>\n";
-		} else {
-			print TMPFILE "$crec\n";
-		}
-	}
-	close TMPFILE;
-	close ARCHFILE;
-	$chmodok = chmod 0666, $archivefile;
-
-	# delete logos
-	$ulinkdir = join($pathsep, $pubroot, "graphic");
-	opendir (GDIR, $ulinkdir);
-	@dots = readdir(GDIR);
-	closedir GDIR;
-	$rmmask = "$CLIENT{'clid'}.";
-	foreach $rmfile (@dots) {
-		if ($rmfile =~ /$rmmask/ ) {
-			$ulinkfile = join($pathsep, $pubroot, "graphic", $rmfile);
-			$archivefile = $ulinkfile;
-			$archivefile =~ s/$docroot/$archiveroot/g;
-			rename $ulinkfile, $archivefile;
-			print "$ulinkfile archived $! ...<BR>\n";
-		}
-	}
-	@dots = ();
-
-	# delete cnd file
-	$tofile = join($pathsep, $dataroot, "cnd.$CLIENT{'clid'}");
-	$archivefile = $tofile;
-	$archivefile =~ s/$docroot/$archiveroot/g;
-	rename $tofile, $archivefile;
-	print "$tofile archived $! ...<BR>\n";
-
-	# delete reports file
-	$tofile = join($pathsep, $dataroot, "reports.$CLIENT{'clid'}");
-	$archivefile = $tofile;
-	$archivefile =~ s/$docroot/$archiveroot/g;
-	rename $tofile, $archivefile;
-	print "$tofile archived $! ...<BR>\n";
-
-	# delete tests file
-	$tofile = join($pathsep, $dataroot, "tests.$CLIENT{'clid'}");
-	$archivefile = $tofile;
-	$archivefile =~ s/$docroot/$archiveroot/g;
-	rename $tofile, $archivefile;
-	print "$tofile archived $! ...<BR>\n";
-
-	# delete test graphic files
-	opendir (GDIR, $testgraphic);
-	@dots = readdir(GDIR);
-	closedir GDIR;
-	$rmmask = "$CLIENT{'clid'}.";
-	foreach $rmfile (@dots) {
-		if ($rmfile =~ /$rmmask/ ) {
-			$ulinkfile = join($pathsep, $testgraphic, $rmfile);
-			$archivefile = $ulinkfile;
-			$archivefile =~ s/$docroot/$archiveroot/g;
-			rename $ulinkfile, $archivefile;
-			print "$ulinkfile archived $! ...<BR>\n";
-		}
-	}
-	@dots = ();
-
-	# delete test questions files
-	opendir (GDIR, $questionroot);
-	@dots = readdir(GDIR);
-	closedir GDIR;
-	$rmmask = ".$CLIENT{'clid'}";
-	foreach $rmfile (@dots) {
-		if ($rmfile =~ /$rmmask/ ) {
-			$ulinkfile = join($pathsep, $questionroot, $rmfile);
-			$archivefile = $ulinkfile;
-			$archivefile =~ s/$docroot/$archiveroot/g;
-			rename $ulinkfile, $archivefile;
-			print "$ulinkfile archived $! ...<BR>\n";
-		}
-	}
-	@dots = ();
-
-	# delete index page
-	$tofile = join($pathsep, $pubroot, "$CLIENT{'clid'}", "index.htm");
-	$cnt = unlink $tofile;
-	print "$tofile deleted $! ...<BR>\n";
-}
-
-sub open_results {
-	print "<HTML>
-<HEAD>
-	<SCRIPT language=\"JavaScript\">
-<!--
-function right(e) {
-	if (navigator.appName == 'Netscape' && (e.which == 3 || e.which == 2)) {
-		alert(\"<%=PHRASE.473%>\");
-		return false;
-	} else {
-		if (navigator.appName == 'Microsoft Internet Explorer' && (event.button == 2 || event.button == 3)) {
-			alert(\"<%=PHRASE.473%>\");
-			return false;
-		}
-	}
-	return true;
-}
-document.onmousedown=right;
-document.onmouseup=right;
-if (document.layers) window.captureEvents(Event.MOUSEDOWN);
-if (document.layers) window.captureEvents(Event.MOUSEUP);
-window.onmousedown=right;
-window.onmouseup=right;
-// -->
-	</SCRIPT>
-</HEAD>
-<BODY BACKGROUND=\"$SYSTEM{'BACKGROUND'}\" BGCOLOR==\"$SYSTEM{'BGCOLOR'}\"
-	TEXT=\"$SYSTEM{'TEXT'}\" LINK=\"$SYSTEM{'LINK'}\"
-	VLINK=\"$SYSTEM{'VLINK'}\" ALINK=\"$SYSTEM{'ALINK'}\">
-";
-}
-
-sub close_results {
-	print "</BODY>\n</HTML>\n";
-}

survey-nginx/cgi-bin/sitecfg.pl.bu20190705

@@ -1,143 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: sitecfg.pl.default,v 1.2 2006/07/25 20:08:04 psims Exp $
-#
-# Source File: sitecfg.pl
-
-require 'genutil.pl';
-require 'logger.pl';
-
-$ipfilter = "";
-$acceptpost = 1;
-$acceptget = 1;
-$allowmultilogin = 0;
-$blockrightclick = 1; # 1 for production, 0 for development.
-$forcehttps = 0;
-$autologout = 3600;
-$clientDir_umask = 0775;  # octal, for creating new client dirs
-
-$mmautontfyfrom="autonotify\@actscorp.com";
-$mmautontfyto="support\@actscorp.com";
-
-$SYSTEM{Version} = "4.00";
-$SYSTEM{'ipfilter'} = $ipfilter;
-$SYSTEM{'acceptpost'} = $acceptpost;
-$SYSTEM{'acceptget'} = $acceptget;
-$SYSTEM{'allowmultilogin'} = $allowmultilogin;
-$SYSTEM{'blockrightclick'} = $blockrightclick;
-$SYSTEM{'forcehttps'} = $forcehttps;
-$SYSTEM{'autologout'} = $autologout;
-$SYSTEM{'acceptpostchk'} = ($acceptpost == 1) ? "CHECKED" : "";
-$SYSTEM{'acceptgetchk'} = ($acceptget == 1) ? "CHECKED" : "";
-$SYSTEM{'allowmultiloginchk'} = ($allowmultilogin == 1) ? "CHECKED" : "";
-$SYSTEM{'supportedimagemedia'} = "art;bmp;gif;GIF;jpg;JPG;jpe;jpeg;png;PNG;pdf;PDF";
-$SYSTEM{'supportedaudiomedia'} = "aif;aifc;aiff;au;mid;rmi;snd;wav;";
-$SYSTEM{'supportedvideomedia'} = "avi;m1v;mov;mpa;mpe;mpeg;mpg";
-%CONTENT_TYPES=(
-	"aif" => "audio/x-aiff",
-	"aifc" => "audio/x-aiff",
-	"aiff" => "audio/x-aiff",
-	"art" => "image/x-jg",
-	"au" => "audio/basic",
-	"avi" => "video/avi",
-	"bmp" => "image/bmp",
-	"gif" => "image/gif",
-	"GIF" => "image/gif",
-	"jpe" => "image/jpeg",
-	"jpg" => "image/jpeg",
-	"JPG" => "image/jpeg",
-	"jpeg" => "image/jpeg",
-	"m1v" => "video/mpeg",
-	"mid" => "audio/mid",
-	"mov" => "video/quicktime",
-	"mpa" => "video/jpeg",
-	"mpe" => "video/jpeg",
-	"mpeg" => "video/jpeg",
-	"mpg" => "video/jpeg",
-	"pdf" => "application/pdf",
-	"PDF" => "application/pdf",
-	"png" => "image/png",
-	"PNG" => "image/png",
-	"rmi" => "audio/mid",
-	"snd" => "audio/basic",
-	"wav" => "audio/x-wav",
-	"other" => "text/html"
-);
-
-$osnt=0;
-$pathsep = "/";
-$colsep = '&';
-$fieldsep = ';';
-$idmax = 1000;
-
-$hostid = 4;
-require 'smilib.pl';
-require 'cybertestlib.pl';
-require 'maillib.pl';
-
-
-#
-# THIS IS DEVELOPMENT SETTING *ONLY*!  DO NOT COMMIT THIS CHANGE!!
-#
-$docroot = $ENV{DOCUMENT_ROOT};
-$docroot =~ s/\/htdocs\s*$//g;
-$urlroot = "/cgi-bin";
-$pubroot = join($pathsep, $docroot, "htdocs");
-$graphroot = join($pathsep, "", "graphic");
-$graphurl = join($pathsep, "", "graphic");
-$cgiroot = $urlroot;
-$cfgroot = join($pathsep, $docroot, "cgi-bin");
-
-$archiveroot = join($pathsep, $docroot, "archive");
-$secroot = join($pathsep, $docroot, "secure_html");
-$logroot = join($pathsep, $secroot, "log");
-$resptmplt = join($pathsep, $secroot, "template");
-$dataroot = join($pathsep, $secroot, "data");
-$questionroot = join($pathsep, $dataroot, "tests");
-$testgraphic = join($pathsep, $questionroot, "graphic");
-$testroot = join($pathsep, $secroot, "tests");
-$testpending = join($pathsep, $secroot, "tests", "pending");
-$testinprog = join($pathsep, $secroot, "tests", "inprog");
-$testcomplete = join($pathsep, $secroot, "tests", "complete");
-#$mail_server_domain = "mail.actscorp.com";
-$mail_server_domain = "localhost";
-#for above line, for Unix use smtp name from /etc/rc.config, for W2K use domain name or
-#IP address where TestManager is running	
-
-$PATHS{'graphroot'} = $graphroot;
-$PATHS{'graphurl'} = $graphurl;
-$PATHS{'cgiroot'} = $cgiroot;
-$PATHS{'pubroot'} = $pubroot;
-$PATHS{'logroot'} = $logroot;
-$PATHS{'dataroot'} = $dataroot;
-$PATHS{'secroot'} = $secroot;
-$PATHS{'logroot'} = $logroot;
-$PATHS{'resptmplt'} = $resptmplt;
-$PATHS{'questionroot'} = $questionroot;
-$PATHS{'testroot'} = $testroot;
-$PATHS{'urlroot'} = $urlroot;
-$PATHS{'archiveroot'} = $archiveroot;
-$PATHS{'download'} = $download;
-
-#
-# This require MUST BE AFTER %PATHS because it calls routines in SMILIB using
-# the paths from above to load English as the default language.
-#
-require 'languagelib.pl';
-
-########################################################################
-####################  UI Utility Settings & Functions  ###########
-########################################################################
-$UI{ERROR_FONT_COLOR} 	= "#FF0000";
-$UI{ERROR_BG_COLOR} 	= "#000000";
-$UI{OK_FONT_COLOR} 		= "#00FF00";
-$UI{OK_BG_COLOR} 		= "#000000";
-$UI{PCNT_FMT} = "%.1f";   # format for percentages (see perldoc -f sprintf)
-$UI{DATETIME_FMT} = "%b %e, %Y, %l:%M %p %Z";   # format for datetimes
-$UI{DEFAULT_AVAILON_HR}    =  0;  # 0-23
-$UI{DEFAULT_AVAILON_MIN}   =  0;  # 0-59
-$UI{DEFAULT_AVAILTHRU_HR}  =  0;  # 0-23
-$UI{DEFAULT_AVAILTHRU_MIN} =  0;  # 0-59
-
-# end with True because this is a require file
-1

survey-nginx/cgi-bin/sitecfg.pl.bu20190708

@@ -1,147 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: sitecfg.pl.default,v 1.2 2006/07/25 20:08:04 psims Exp $
-#
-# Source File: sitecfg.pl
-
-require 'genutil.pl';
-require 'logger.pl';
-
-$ipfilter = "";
-$acceptpost = 1;
-$acceptget = 1;
-$allowmultilogin = 0;
-$blockrightclick = 1; # 1 for production, 0 for development.
-$forcehttps = 0;
-$autologout = 3600;
-$clientDir_umask = 0775;  # octal, for creating new client dirs
-
-$mmautontfyfrom="autonotify\@actscorp.com";
-$mmautontfyto="support\@actscorp.com";
-
-$SYSTEM{Version} = "4.00";
-$SYSTEM{'ipfilter'} = $ipfilter;
-$SYSTEM{'acceptpost'} = $acceptpost;
-$SYSTEM{'acceptget'} = $acceptget;
-$SYSTEM{'allowmultilogin'} = $allowmultilogin;
-$SYSTEM{'blockrightclick'} = $blockrightclick;
-$SYSTEM{'forcehttps'} = $forcehttps;
-$SYSTEM{'autologout'} = $autologout;
-$SYSTEM{'acceptpostchk'} = ($acceptpost == 1) ? "CHECKED" : "";
-$SYSTEM{'acceptgetchk'} = ($acceptget == 1) ? "CHECKED" : "";
-$SYSTEM{'allowmultiloginchk'} = ($allowmultilogin == 1) ? "CHECKED" : "";
-$SYSTEM{'supportedimagemedia'} = "art;bmp;gif;GIF;jpg;JPG;jpe;jpeg;png;PNG;pdf;PDF";
-$SYSTEM{'supportedaudiomedia'} = "aif;aifc;aiff;au;mid;rmi;snd;wav;mp3;MP3";
-$SYSTEM{'supportedvideomedia'} = "avi;m1v;mov;mpa;mpe;mpeg;mpg;mp4;MP4";
-%CONTENT_TYPES=(
-	"aif" => "audio/x-aiff",
-	"aifc" => "audio/x-aiff",
-	"aiff" => "audio/x-aiff",
-	"art" => "image/x-jg",
-	"au" => "audio/basic",
-	"avi" => "video/avi",
-	"bmp" => "image/bmp",
-	"gif" => "image/gif",
-	"GIF" => "image/gif",
-	"jpe" => "image/jpeg",
-	"jpg" => "image/jpeg",
-	"JPG" => "image/jpeg",
-	"jpeg" => "image/jpeg",
-	"m1v" => "video/mpeg",
-	"mid" => "audio/mid",
-	"mov" => "video/quicktime",
-	"mp3" => "audio/mpeg",
-	"MP3" => "audio/mpeg",
-	"mp4" => "video/mp4",
-	"MP4" => "video/mp4",
-	"mpa" => "video/jpeg",
-	"mpe" => "video/jpeg",
-	"mpeg" => "video/jpeg",
-	"mpg" => "video/jpeg",
-	"pdf" => "application/pdf",
-	"PDF" => "application/pdf",
-	"png" => "image/png",
-	"PNG" => "image/png",
-	"rmi" => "audio/mid",
-	"snd" => "audio/basic",
-	"wav" => "audio/x-wav",
-	"other" => "text/html"
-);
-
-$osnt=0;
-$pathsep = "/";
-$colsep = '&';
-$fieldsep = ';';
-$idmax = 1000;
-
-$hostid = 4;
-require 'smilib.pl';
-require 'cybertestlib.pl';
-require 'maillib.pl';
-
-
-#
-# THIS IS DEVELOPMENT SETTING *ONLY*!  DO NOT COMMIT THIS CHANGE!!
-#
-$docroot = $ENV{DOCUMENT_ROOT};
-$docroot =~ s/\/htdocs\s*$//g;
-$urlroot = "/cgi-bin";
-$pubroot = join($pathsep, $docroot, "htdocs");
-$graphroot = join($pathsep, "", "graphic");
-$graphurl = join($pathsep, "", "graphic");
-$cgiroot = $urlroot;
-$cfgroot = join($pathsep, $docroot, "cgi-bin");
-
-$archiveroot = join($pathsep, $docroot, "archive");
-$secroot = join($pathsep, $docroot, "secure_html");
-$logroot = join($pathsep, $secroot, "log");
-$resptmplt = join($pathsep, $secroot, "template");
-$dataroot = join($pathsep, $secroot, "data");
-$questionroot = join($pathsep, $dataroot, "tests");
-$testgraphic = join($pathsep, $questionroot, "graphic");
-$testroot = join($pathsep, $secroot, "tests");
-$testpending = join($pathsep, $secroot, "tests", "pending");
-$testinprog = join($pathsep, $secroot, "tests", "inprog");
-$testcomplete = join($pathsep, $secroot, "tests", "complete");
-#$mail_server_domain = "mail.actscorp.com";
-$mail_server_domain = "localhost";
-#for above line, for Unix use smtp name from /etc/rc.config, for W2K use domain name or
-#IP address where TestManager is running	
-
-$PATHS{'graphroot'} = $graphroot;
-$PATHS{'graphurl'} = $graphurl;
-$PATHS{'cgiroot'} = $cgiroot;
-$PATHS{'pubroot'} = $pubroot;
-$PATHS{'logroot'} = $logroot;
-$PATHS{'dataroot'} = $dataroot;
-$PATHS{'secroot'} = $secroot;
-$PATHS{'logroot'} = $logroot;
-$PATHS{'resptmplt'} = $resptmplt;
-$PATHS{'questionroot'} = $questionroot;
-$PATHS{'testroot'} = $testroot;
-$PATHS{'urlroot'} = $urlroot;
-$PATHS{'archiveroot'} = $archiveroot;
-$PATHS{'download'} = $download;
-
-#
-# This require MUST BE AFTER %PATHS because it calls routines in SMILIB using
-# the paths from above to load English as the default language.
-#
-require 'languagelib.pl';
-
-########################################################################
-####################  UI Utility Settings & Functions  ###########
-########################################################################
-$UI{ERROR_FONT_COLOR} 	= "#FF0000";
-$UI{ERROR_BG_COLOR} 	= "#000000";
-$UI{OK_FONT_COLOR} 		= "#00FF00";
-$UI{OK_BG_COLOR} 		= "#000000";
-$UI{PCNT_FMT} = "%.1f";   # format for percentages (see perldoc -f sprintf)
-$UI{DATETIME_FMT} = "%b %e, %Y, %l:%M %p %Z";   # format for datetimes
-$UI{DEFAULT_AVAILON_HR}    =  0;  # 0-23
-$UI{DEFAULT_AVAILON_MIN}   =  0;  # 0-59
-$UI{DEFAULT_AVAILTHRU_HR}  =  0;  # 0-23
-$UI{DEFAULT_AVAILTHRU_MIN} =  0;  # 0-59
-
-# end with True because this is a require file
-1

survey-nginx/cgi-bin/sitecfg.pl.was01-24-2020

@@ -1,148 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: sitecfg.pl.default,v 1.2 2006/07/25 20:08:04 psims Exp $
-#
-# Source File: sitecfg.pl
-
-require 'genutil.pl';
-require 'logger.pl';
-
-$ipfilter = "";
-$acceptpost = 1;
-$acceptget = 1;
-$allowmultilogin = 0;
-$blockrightclick = 1; # 1 for production, 0 for development.
-$forcehttps = 0;
-$autologout = 3600;
-$clientDir_umask = 0775;  # octal, for creating new client dirs
-
-$mmautontfyfrom="autonotify\@actscorp.com";
-$mmautontfyto="support\@actscorp.com";
-
-$SYSTEM{Version} = "4.00";
-$SYSTEM{'ipfilter'} = $ipfilter;
-$SYSTEM{'acceptpost'} = $acceptpost;
-$SYSTEM{'acceptget'} = $acceptget;
-$SYSTEM{'allowmultilogin'} = $allowmultilogin;
-$SYSTEM{'blockrightclick'} = $blockrightclick;
-$SYSTEM{'forcehttps'} = $forcehttps;
-$SYSTEM{'autologout'} = $autologout;
-$SYSTEM{'acceptpostchk'} = ($acceptpost == 1) ? "CHECKED" : "";
-$SYSTEM{'acceptgetchk'} = ($acceptget == 1) ? "CHECKED" : "";
-$SYSTEM{'allowmultiloginchk'} = ($allowmultilogin == 1) ? "CHECKED" : "";
-$SYSTEM{'supportedimagemedia'} = "art;bmp;gif;GIF;jpg;JPG;jpe;jpeg;png;PNG;pdf;PDF";
-$SYSTEM{'supportedaudiomedia'} = "aif;aifc;aiff;au;mid;rmi;snd;wav;mp3;MP3";
-$SYSTEM{'supportedvideomedia'} = "avi;m1v;mov;mpa;mpe;mpeg;mpg;mp4;MP4";
-%CONTENT_TYPES=(
-	"aif" => "audio/x-aiff",
-	"aifc" => "audio/x-aiff",
-	"aiff" => "audio/x-aiff",
-	"art" => "image/x-jg",
-	"au" => "audio/basic",
-	"avi" => "video/avi",
-	"bmp" => "image/bmp",
-	"gif" => "image/gif",
-	"GIF" => "image/gif",
-	"jpe" => "image/jpeg",
-	"jpg" => "image/jpeg",
-	"JPG" => "image/jpeg",
-	"jpeg" => "image/jpeg",
-	"m1v" => "video/mpeg",
-	"mid" => "audio/mid",
-	"mov" => "video/quicktime",
-	"mp3" => "audio/mpeg",
-	"MP3" => "audio/mpeg",
-	"mp4" => "video/mp4",
-	"MP4" => "video/mp4",
-	"mpa" => "video/jpeg",
-	"mpe" => "video/jpeg",
-	"mpeg" => "video/jpeg",
-	"mpg" => "video/jpeg",
-	"pdf" => "application/pdf",
-	"PDF" => "application/pdf",
-	"png" => "image/png",
-	"PNG" => "image/png",
-	"rmi" => "audio/mid",
-	"snd" => "audio/basic",
-	"wav" => "audio/x-wav",
-	"other" => "text/html"
-);
-
-$osnt=0;
-$pathsep = "/";
-$colsep = '&';
-$fieldsep = ';';
-$idmax = 1000;
-
-$hostid = 4;
-require 'smilib.pl';
-require 'cybertestlib.pl';
-require 'maillib.pl';
-
-
-#
-# THIS IS DEVELOPMENT SETTING *ONLY*!  DO NOT COMMIT THIS CHANGE!!
-#
-$docroot = $ENV{DOCUMENT_ROOT};
-$docroot =~ s/\/htdocs\s*$//g;
-$urlroot = "/cgi-bin";
-$pubroot = join($pathsep, $docroot, "htdocs");
-$graphroot = join($pathsep, "", "graphic");
-$graphurl = join($pathsep, "", "graphic");
-$cgiroot = $urlroot;
-$cfgroot = join($pathsep, $docroot, "cgi-bin");
-
-$archiveroot = join($pathsep, $docroot, "archive");
-$secroot = join($pathsep, $docroot, "secure_html");
-$logroot = join($pathsep, $secroot, "log");
-$resptmplt = join($pathsep, $secroot, "template");
-$dataroot = join($pathsep, $secroot, "data");
-$questionroot = join($pathsep, $dataroot, "tests");
-$testgraphic = join($pathsep, $questionroot, "graphic");
-$testroot = join($pathsep, $secroot, "tests");
-$testpending = join($pathsep, $secroot, "tests", "pending");
-$testinprog = join($pathsep, $secroot, "tests", "inprog");
-$testcomplete = join($pathsep, $secroot, "tests", "complete");
-#$mail_server_domain = "mail.actscorp.com";
-$mail_server_domain = "localhost";
-#for above line, for Unix use smtp name from /etc/rc.config, for W2K use domain name or
-#IP address where TestManager is running	
-
-$PATHS{'graphroot'} = $graphroot;
-$PATHS{'graphurl'} = $graphurl;
-$PATHS{'cgiroot'} = $cgiroot;
-$PATHS{'pubroot'} = $pubroot;
-$PATHS{'logroot'} = $logroot;
-$PATHS{'dataroot'} = $dataroot;
-$PATHS{'secroot'} = $secroot;
-$PATHS{'logroot'} = $logroot;
-$PATHS{'resptmplt'} = $resptmplt;
-$PATHS{'questionroot'} = $questionroot;
-$PATHS{'testroot'} = $testroot;
-$PATHS{'urlroot'} = $urlroot;
-$PATHS{'archiveroot'} = $archiveroot;
-$PATHS{'download'} = $download;
-
-#
-# This require MUST BE AFTER %PATHS because it calls routines in SMILIB using
-# the paths from above to load English as the default language.
-#
-require 'languagelib.pl';
-
-########################################################################
-####################  UI Utility Settings & Functions  ###########
-########################################################################
-$UI{ERROR_FONT_COLOR} 	= "#FF0000";
-$UI{ERROR_BG_COLOR} 	= "#000000";
-$UI{OK_FONT_COLOR} 		= "#00FF00";
-$UI{OK_BG_COLOR} 		= "#000000";
-$UI{PCNT_FMT} = "%.1f";   # format for percentages (see perldoc -f sprintf)
-$UI{DATETIME_FMT} = "%b %e, %Y, %l:%M %p %Z";   # format for datetimes
-$UI{DEFAULT_AVAILON_HR}    =  0;  # 0-23
-$UI{DEFAULT_AVAILON_MIN}   =  0;  # 0-59
-$UI{DEFAULT_AVAILTHRU_YEAR}  =  2030;  # Actual year.
-$UI{DEFAULT_AVAILTHRU_HR}  =  0;  # 0-23
-$UI{DEFAULT_AVAILTHRU_MIN} =  0;  # 0-59
-
-# end with True because this is a require file
-1

survey-nginx/cgi-bin/sreports.pl.bu20131217

@@ -1,562 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: sreports.pl,v 1.4 2006/01/23 21:39:30 ddoughty Exp $
-#
-# Source File: sreports.pl
-
-# Get config
-require 'sitecfg.pl';
-require 'testlib.pl';
-require 'tstatlib.pl';
-
-$FORM{'frm'}="";
-
-&app_initialize;
-
-print "Content-Type: text/html\n\n";
-
-if (&get_session($FORM{'tid'})) {
-	&LanguageSupportInit();
-	$REPORT{'rptid'}="";
-	@rptdefs = &get_data("sitereports.dat");
-	@lbls = split(/&/, $rptdefs[0]);
-	foreach $rptdef (@rptdefs) {
-		chomp ($rptdef);
-		@flds = split(/&/, $rptdef);
-		if ($flds[0] eq $FORM{'rptno'}) {
-			for $i (0 .. $#lbls) {
-				$REPORT{$lbls[$i]} = $flds[$i];
-				$i++;
-			}
-		}
-	}
-	if ($FORM{'frm'} == '1' || ($FORM{'frm'} == '' && $REPORT{'rptid'} eq "ACT-004")) {
-		&show_index;
-	} else {
-		if ($FORM{'frm'} == '2') {
-			&show_detail;
-		}
-		else {
-			if ($FORM{'frm'} == '') {
-				 &show_frames;
-			} else {
-				print "<HTML>\n";
-				print "<HEAD></HEAD>\n";
-				print "<BODY BACKGROUND=\"$SYSTEM{'BACKGROUND'}\" BGCOLOR=\"$SYSTEM{'BGCOLOR'}\"
-	TEXT=\"$SYSTEM{'TEXT'}\" LINK=\"$SYSTEM{'LINK'}\"
-	VLINK=\"$SYSTEM{'VLINK'}\" ALINK=\"$SYSTEM{'ALINK'}\">
-</BODY>\n";
-				print "</HTML>\n";
-			}
-		}
-	}
-}
-
-sub show_frames {
-	print "<HTML>\n";
-	print "<HEAD></HEAD>\n";
-	print "<FRAMESET frameborder=0 cols=\"30%,*\">\n";
-	print "<FRAME name=\"rptindex\" frameborder=0 src=\"$cgiroot/sreports.pl?lang=$SESSION{'lang'}&tid=$SESSION{'tid'}&frm=1&rptno=$FORM{'rptno'}\">\n";
-	print "<FRAME name=\"rptdetail\" frameborder=0 src=\"$cgiroot/sreports.pl?lang=$SESSION{'lang'}&tid=$SESSION{'tid'}&frm=0\">\n";
-	print "</FRAMESET>\n";
-	print "</HTML>\n";
-}
-
-sub show_index {
-	&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Exec Report $FORM{'rptno'}");
-	print "<HTML>\n";
-	print "<HEAD>\n<TITLE>$REPORT{'rptid'} - $REPORT{'rptdesc'}</TITLE>\n</HEAD>\n";
-	print "<BODY BACKGROUND=\"$SYSTEM{'BACKGROUND'}\" BGCOLOR=\"$SYSTEM{'BGCOLOR'}\"
-	TEXT=\"$SYSTEM{'TEXT'}\" LINK=\"$SYSTEM{'LINK'}\"
-	VLINK=\"$SYSTEM{'VLINK'}\" ALINK=\"$SYSTEM{'ALINK'}\">
-\n";
-	print "<B>$REPORT{'rptid'}<BR>$REPORT{'rptdesc'}</B><BR>&nbsp;<BR>\n";
-	if ($REPORT{'rptid'} eq 'ACT-001') {
-	    opendir(DIR, "$logroot");
-   		@dircon = readdir(DIR);
-	    closedir DIR;
-		@sdircon = sort @dircon;
-		foreach $diritem (@sdircon) {
-			chomp ($diritem);
-			if ($diritem =~ /sess\.[0-9]/i ) {
-				@lines = &get_log($diritem);
-				foreach $line (@lines) {
-					chomp ($line);
-					($nm,$vlu)=split(/=/, $line);
-					$SESS{$nm}=$vlu;
-				}
-				$tmstr = &format_date_time("yy-mm-dd hh:nn", "1", "-10000", substr($SESS{'tid'}, 0, -4));
-				print "<FONT SIZE=2>$tmstr</FONT> <A HREF=\"$cgiroot/sreports.pl?tid=$SESSION{'tid'}&frm=2&rptno=$FORM{'rptno'}&dbfile=$SESS{'clid'}.$SESS{'uid'}&filter=$SESS{'tid'}\" TARGET=\"rptdetail\">$SESS{'uid'}.$SESS{'clid'}</A><BR>\n";
-			}
-		}
-	} elsif ($REPORT{'rptid'} eq 'ACT-002') {
-			print "<HR WIDTH=\"100%\">\n";
-			print "<B>Tests Pending:</B><BR>\n";
-		    opendir(DIR, "$testpending");
-   			@dircon = readdir(DIR);
-	    	closedir DIR;
-			@sdircon = sort @dircon;
-			foreach $diritem (@sdircon) {
-				chomp ($diritem);
-				if ($diritem =~ /[a-zA-Z0-9](.*).[a-zA-Z0-9](.*).[a-zA-Z0-9]/i ) {
-					print "<FONT SIZE=2><A HREF=\"$cgiroot/sreports.pl?tid=$SESSION{'tid'}&frm=2&location=0&rptno=$FORM{'rptno'}&dbfile=$diritem\" TARGET=\"rptdetail\">$diritem</A></FONT><BR>\n";
-				}
-			}
-			print "<HR WIDTH=\"100%\">\n";
-			print "<B>Tests in Progress:</B><BR>\n";
-		    opendir(DIR, "$testinprog");
-   			@dircon = readdir(DIR);
-	    	closedir DIR;
-			@sdircon = sort @dircon;
-			foreach $diritem (@sdircon) {
-				chomp ($diritem);
-				if ($diritem =~ /[a-zA-Z0-9](.*).[a-zA-Z0-9](.*).[a-zA-Z0-9]/i ) {
-					print "<FONT SIZE=2><A HREF=\"$cgiroot/sreports.pl?tid=$SESSION{'tid'}&frm=2&location=1&rptno=$FORM{'rptno'}&dbfile=$diritem\" TARGET=\"rptdetail\">$diritem</A></FONT><BR>\n";
-				}
-			}
-			print "<HR WIDTH=\"100%\">\n";
-			print "<B>Tests Completed:</B><BR>\n";
-		    opendir(DIR, "$testcomplete");
-   			@dircon = readdir(DIR);
-	    	closedir DIR;
-			@sdircon = sort @dircon;
-			foreach $diritem (@sdircon) {
-				chomp ($diritem);
-				if ($diritem =~ /[a-zA-Z0-9](.*).[a-zA-Z0-9](.*).[a-zA-Z0-9]/i ) {
-					print "<FONT SIZE=2><A HREF=\"$cgiroot/sreports.pl?tid=$SESSION{'tid'}&frm=2&location=2&rptno=$FORM{'rptno'}&dbfile=$diritem\" TARGET=\"rptdetail\">$diritem</A></FONT><BR>\n";
-				}
-			}
-	} elsif ($REPORT{'rptid'} eq 'ACT-004') {
-		# C_004
-		$faction="$cgiroot/IntegroStats.pl";
-		$ftarget="rptwindow";
-		$fparms="<input type=hidden name=\"tid\" value=\"$SESSION{'tid'}\">\n";
-		$fparms=join('',$fparms,"<input type=hidden name=\"tstid\" value=\"\">\n");
-		### DED 10/25/2002 Added rptdesc and rptid to pass to creportsf
-		$fparms=join('',$fparms,"<input type=hidden name=\"rptdesc\" value=\"$REPORT{'rptdesc'}\">\n");
-		$fparms=join('',$fparms,"<input type=hidden name=\"rptid\" value=\"$REPORT{'rptid'}\">\n");
-		$finputs="<table cellpadding=2 border=1>\n";
-		$finputs=join('',$finputs,"\t<tr>\n\t\t<td colspan=3 align=center valign=top>Advanced Options<br></td>\n</tr>\n");
-
-		$finputs=join('',$finputs,"<tr>\n");
-		$finputs=join('',$finputs,"\t\t<td valign=top><font size=2>\n<i>Question Statistics:</i><br>\n");
-		$finputs=join('',$finputs,"<input type=radio name=\"testsummary\" value=\"composite\" onClick=\"return reportOptions(this)\"> Question Statistics<br>\n");
-		$finputs=join('',$finputs,"\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;<input type=checkbox name=\"showobs\" onClick=\"return reportOptions(this)\"> include inactive questions<br>\n");
-		$finputs=join('',$finputs,"\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;<input type=checkbox name=\"exnoresp\"> exclude No Response from stats<br>\n");
-		$finputs=join('',$finputs,"\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;<i>User Comments:</i><br>\n");
-		$finputs=join('',$finputs,"\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;<input type=radio name=\"showcmts\" value=\"donot\" onClick=\"return reportOptions(this)\"> do not include<br>\n");
-		$finputs=join('',$finputs,"\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;<input type=radio name=\"showcmts\" value=\"withq\" onClick=\"return reportOptions(this)\"> include with question<br>\n");
-		$finputs=join('',$finputs,"\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;<input type=radio name=\"showcmts\" value=\"atend\" onClick=\"return reportOptions(this)\"> include at end<br>\n");
-		$finputs=join('',$finputs,"\t\t</font></td>\n");
-
-		### DED 12/23/04 Removed Test Stats & Other Options
-		#$finputs=join('',$finputs,"\t\t<td valign=top><font size=2>\n<i>Test Statistics</i><br>\n");
-		#$finputs=join('',$finputs,"<input type=radio name=\"testsummary\" value=\"bycnd\" onClick=\"return reportOptions(this)\"> Individual Test results<br>\n");
-		#$finputs=join('',$finputs,"\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;<input type=checkbox name=\"statsbysubj\" onClick=\"return reportOptions(this)\"> breakdown by subject area<br>\n");
-		#$finputs=join('',$finputs,"\t\t</font></td>\n");
-
-		#$finputs=join('',$finputs,"\t\t<td valign=top><font size=2>\n<i>Other Options:</i><br>");
-		#$finputs=join('',$finputs,"<input type=radio name=\"testsummary\" value=\"extractemail\" onClick=\"return reportOptions(this)\"> Extract From Tests<br>\n");
-		#$finputs=join('',$finputs,"\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;<input type=checkbox name=\"cndnme\" onClick=\"return reportOptions(this)\"> Candidate Name<br>\n");
-		#$finputs=join('',$finputs,"\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;<input type=checkbox name=\"cndeml\" onClick=\"return reportOptions(this)\"> Candidate Email Address<br>\n");
-		#$finputs=join('',$finputs,"\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;\&nbsp\;<input type=checkbox name=\"cndscr\" onClick=\"return reportOptions(this)\"> Candidate Score<br>\n");
-		#$finputs=join('',$finputs,"\t\t</font></td>\n");
-		$finputs=join('',$finputs,"\t</tr>\n");
-
-		$finputs=join('',$finputs,"\t</tr>\n");
-		$finputs=join('',$finputs,"\t\t<td align=left valign=top><font size=2>\n");
-		### DED 12/23/04
-		### 	Removed Filter-by-question options
-		#$finputs=join('',$finputs,"\&nbsp\;<br>\n");
-		#$finputs=join('',$finputs,"<input type=checkbox name=\"filterbyques\" onClick=\"return filterCheck(this.form)\"> Filter by question<br>\n");
-		#$finputs=join('',$finputs,"<input type=checkbox name=\"specfilter\" onClick=\"return filterCheck(this.form)\"> Filter by user<br>\n");
-		#$finputs=join('',$finputs,"\t\t</font></td>\n");
-		#$finputs=join('',$finputs,"\t\t<td align=right valign=top><font size=2>\n");
-		#my $j;
-		#$finputs=join('',$finputs,"From: <select name=\"mofm\">\n");
-		#for $i (526 .. 537) {
-			#$j=$i-525;
-			#$finputs=join('',$finputs,"<option value=\"$j\">$xlatphrase[$i]\n");
-		#}
-		#$finputs=join('',$finputs,"</select><select name=\"dyfm\">\n");
-		#for $i (1 .. 31) {
-			#$finputs=join('',$finputs,"<option value=\"$i\">$i\n");
-		#}
-		#$finputs=join('',$finputs,"</select><select name=\"yrfm\">\n");
-		#for $i (2000 .. 2099) {
-			#$finputs=join('',$finputs,"<option value=\"$i\">$i\n");
-		#}
-		#$finputs=join('',$finputs,"</select><br>\n");
-		#$finputs=join('',$finputs,"To: <select name=\"moto\">\n");
-		#for $i (526 .. 537) {
-			#$j=$i-525;
-			#$finputs=join('',$finputs,"<option value=\"$j\">$xlatphrase[$i]\n");
-		#}
-		#$finputs=join('',$finputs,"</select><select name=\"dyto\">\n");
-		#for $i (1 .. 31) {
-			#$finputs=join('',$finputs,"<option value=\"$i\">$i\n");
-		#}
-		#$finputs=join('',$finputs,"</select><select name=\"yrto\">\n");
-		#for $i (2000 .. 2099) {
-			#$finputs=join('',$finputs,"<option value=\"$i\">$i\n");
-		#}
-		#$finputs=join('',$finputs,"</select><br>\n");
-		#$finputs=join('',$finputs,"\t\t</font></td>\n");
-		#$finputs=join('',$finputs,"\t\t<td align=right valign=top><font size=2>\n");
-		#$finputs=join('',$finputs,"<input type=checkbox name=\"export\" onClick=\"return reportOptions(this)\"> download in text format<br>\n");
-		#$finputs=join('',$finputs,"\t\t</font></td>\n");
-		$finputs=join('',$finputs,"\t</tr>\n");
-
-		$finputs=join('',$finputs,"</table>\&nbsp\;<br>\n");
-		$fjscript="
-function onWdwLoad() {
-	var oform=document.rptform1;
-	//oform.mofm.selectedIndex=0;
-	//oform.dyfm.selectedIndex=0;
-	//oform.yrfm.selectedIndex=0;
-	//oform.moto.selectedIndex=oform.moto.options.length-1;
-	//oform.dyto.selectedIndex=oform.dyto.options.length-1;
-	//oform.yrto.selectedIndex=oform.yrto.options.length-1;
-	//oform.testsummary[0].checked=true;
-	oform.testsummary.checked=true;
-	oform.showcmts[0].checked=true;
-}
-function filterCheck(oform) {
-	if (oform.specfilter.checked==true || oform.filterbyques.checked==true) {
-		oform.action=\"$cgiroot/creportsf.pl\";
-	} else {
-		oform.action=\"$cgiroot/teststats.pl\";
-	}
-}
-function parmsC004(oform,tst) {
-	oform.tstid.value=tst;
-	oform.submit();
-}
-function reportOptions(oinp) {
-	var oform=oinp.form,idx;
-	if (oinp.name==\"testsummary\") {
-		idx=(oform.testsummary[0].checked) ? 0 : -1;
-		idx=(oform.testsummary[1].checked) ? 1 : idx;
-		idx=(oform.testsummary[2].checked) ? 2 : idx;
-		return testsummaryClick(oform,idx);
-	} else {
-		if (oinp.name==\"showcmts\") {
-			idx=(oform.showcmts[0].checked) ? 0 : -1;
-			idx=(oform.showcmts[1].checked) ? 1 : idx;
-			idx=(oform.showcmts[2].checked) ? 2 : idx;
-			return showcmtsClick(oform,idx);
-		} else {
-			if (oinp.name==\"statsbysubj\") {
-				return statsbysubjClick(oform,oinp.checked);
-			} else {
-				if (oinp.name==\"showobs\") {
-					return showobsClick(oform,oinp.checked);
-				} else {
-					if (oinp.name==\"export\") {
-						return exportClick(oform,oinp.checked);
-					} else {
-						return dataextractOpts(oform);
-					}
-				}
-			}
-		}
-	}
-}
-function dataextractOpts(oform) {
-	if (!(oform.testsummary[2].checked)) {
-		oform.testsummary[2].checked=true;
-		oform.showcmts[0].checked=false;
-		oform.showcmts[1].checked=false;
-		oform.showcmts[2].checked=false;
-		oform.statsbysubj.checked=false;
-		oform.showobs.checked=false;
-	}
-	return true;
-}
-function testsummaryClick(oform,i) {
-	if (i==0) {
-		if (!((oform.showcmts[0].checked) || (oform.showcmts[1].checked) || (oform.showcmts[2].checked))) {
-			oform.showcmts[0].checked=true;
-			oform.statsbysubj.checked=false;
-			oform.showobs.checked=false;
-			oform.cndnme.checked=false;
-			oform.cndeml.checked=false;
-			if (\"$CLIENT{'clcnd1'}\" != \"\") {
-				oform.cnd1.checked=false;
-			}
-			if (\"$CLIENT{'clcnd2'}\" != \"\") {
-				oform.cnd2.checked=false;
-			}
-			if (\"$CLIENT{'clcnd3'}\" != \"\") {
-				oform.cnd3.checked=false;
-			}
-			if (\"$CLIENT{'clcnd4'}\" != \"\") {
-				oform.cnd4.checked=false;
-			}
-			oform.cndscr.checked=false;
-		}
-	} else {
-		if (i==1) {
-			oform.showcmts[0].checked=false;
-			oform.showcmts[1].checked=false;
-			oform.showcmts[2].checked=false;
-			oform.statsbysubj.checked=false;
-			oform.showobs.checked=false;
-			oform.cndnme.checked=false;
-			oform.cndeml.checked=false;
-			if (\"$CLIENT{'clcnd1'}\" != \"\") {
-				oform.cnd1.checked=false;
-			}
-			if (\"$CLIENT{'clcnd2'}\" != \"\") {
-				oform.cnd2.checked=false;
-			}
-			if (\"$CLIENT{'clcnd3'}\" != \"\") {
-				oform.cnd3.checked=false;
-			}
-			if (\"$CLIENT{'clcnd4'}\" != \"\") {
-				oform.cnd4.checked=false;
-			}
-			oform.cndscr.checked=false;
-		} else {
-			if (i==2) {
-				oform.showcmts[0].checked=false;
-				oform.showcmts[1].checked=false;
-				oform.showcmts[2].checked=false;
-				oform.statsbysubj.checked=false;
-				oform.showobs.checked=false;
-			}
-		}
-	}
-	return true;
-}
-function showcmtsClick(oform,i) {
-	if (!(oform.testsummary[0].checked)) {
-		oform.testsummary[0].checked=true;
-		oform.statsbysubj.checked=false;
-		oform.showobs.checked=false;
-	}
-	return true;
-}
-function statsbysubjClick(oform,chkd) {
-	if (chkd) {
-		if (!(oform.testsummary[1].checked)) {
-			oform.testsummary[1].checked=true;
-			oform.showcmts[0].checked=false;
-			oform.showcmts[1].checked=false;
-			oform.showcmts[2].checked=false;
-			oform.showobs.checked=false;
-		}
-	}
-	return true;
-}
-function showobsClick(oform,chkd) {
-	if (chkd) {
-		if (!(oform.testsummary[0].checked)) {
-			oform.testsummary[0].checked=true;
-			oform.showcmts[0].checked=true;
-			oform.statsbysubj.checked=false;
-		}
-	}
-	return true;
-}
-function exportClick(oform,chkd) {
-	return true;
-}
-window.onload=onWdwLoad;
-";
-	print "<HTML>
-<HEAD>
-	<TITLE>$REPORT{'rptid'} - $REPORT{'rptdesc'}</TITLE>
-	<SCRIPT language=\"JavaScript\">
-<!--
-$fjscript
-function right(e) {
-	if (navigator.appName == 'Netscape' && (e.which == 3 || e.which == 2)) {
-		alert(\"This source and all graphics are proprietary and may not be viewed or copied.\");
-		return false;
-	} else {
-		if (navigator.appName == 'Microsoft Internet Explorer' && (event.button == 2 || event.button == 3)) {
-			alert(\"This source and all graphics are proprietary and may not be viewed or copied.\");
-			return false;
-		}
-	}
-	return true;
-}
-//document.onmousedown=right;
-//document.onmouseup=right;
-//if (document.layers) window.captureEvents(Event.MOUSEDOWN);
-//if (document.layers) window.captureEvents(Event.MOUSEUP);
-//window.onmousedown=right;
-//window.onmouseup=right;
-// -->
-	</SCRIPT>
-</HEAD>
-<BODY BACKGROUND=\"$SYSTEM{'BACKGROUND'}\" BGCOLOR=\"$SYSTEM{'BGCOLOR'}\"
-	TEXT=\"$SYSTEM{'TEXT'}\" LINK=\"$SYSTEM{'LINK'}\"
-	VLINK=\"$SYSTEM{'VLINK'}\" ALINK=\"$SYSTEM{'ALINK'}\">
-";
-	print "<FORM name=\"rptform1\" action=\"$faction\" METHOD=POST target=\"$ftarget\">\n$fparms\n";
-
-	print "<TABLE cellpadding=0 cellspacing=0 border=0 width=100\%>
-<TR>
-	<TD VALIGN=\"top\">$CLIENT{'logo'}</TD>
-	<TD ALIGN=\"right\">
-		<FONT COLOR=\"$SYSTEM{'HEADERCOLOR'}\" size=2>
-		<B>$REPORT{'rptdesc'}\&nbsp;-\&nbsp;$REPORT{'rptid'}</B><BR>
-		</FONT>
-	</TD>
-</TR>
-</TABLE>
-";
-	&print_report_C_004(); 
-	} else {
-		print "<CENTER>\n";
-		print "Report $FORM{rptno} is not yet available.\n";
-		print "</CENTER>\n";
-	}
-	print "</BODY>\n";
-	print "</HTML>\n";
-	&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "3", "Exec Report $FORM{'rptno'} completed");
-}
-
-sub show_detail {
-	print "<HTML>\n";
-	if ($REPORT{'rptid'} eq 'ACT-001') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Exec Log Report $FORM{'dbfile'}");
-		print "<HEAD>\n<TITLE>$REPORT{'rptid'} - Log File $FORM{'dbfile'}</TITLE>\n</HEAD>\n";
-		print "<BODY BACKGROUND=\"$SYSTEM{'BACKGROUND'}\" BGCOLOR=\"$SYSTEM{'BGCOLOR'}\"
-	TEXT=\"$SYSTEM{'TEXT'}\" LINK=\"$SYSTEM{'LINK'}\"
-	VLINK=\"$SYSTEM{'VLINK'}\" ALINK=\"$SYSTEM{'ALINK'}\">
-\n";
-		print "<H4>$REPORT{'rptid'} - $REPORT{'rptdesc'}</H4><BR>\n";
-		if ($FORM{'filter'}!='') {
-			print "<B>Session $FORM{'filter'}</B><BR>\n";
-			@lines = &get_log("sess.$FORM{'filter'}");
-			foreach $line (@lines) {
-				chomp ($line);
-				print "$line<BR>\n";
-			}
-			print "<HR WIDTH=\"100\%\">\n";
-		}
-		@lines = &get_log($FORM{'dbfile'});
-		foreach $line (@lines) {
-			chomp ($line);
-			if ($FORM{'filter'}!='') {
-				if ($line =~ /,$FORM{'filter'},/ ) {
-					print "$line<BR>\n";
-				}
-			} else {
-				print "$line<BR>\n";
-			}
-		}
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Exec Log Report $FORM{'dbfile'} completed");
-	} elsif ($REPORT{'rptid'} eq 'ACT-002') {
-			print "<HEAD>
-<TITLE>$REPORT{'rptid'} - Test File $FORM{'dbfile'}</TITLE>
-<HEAD>
-	<TITLE>$REPORT{'rptid'} - $REPORT{'rptdesc'}</TITLE>
-	<SCRIPT language=\"JavaScript\">
-<!--
-function right(e) {
-	if (navigator.appName == 'Netscape' && (e.which == 3 || e.which == 2)) {
-		alert(\"This source and all graphics are proprietary and may not be viewed or copied.\");
-		return false;
-	} else {
-		if (navigator.appName == 'Microsoft Internet Explorer' && (event.button == 2 || event.button == 3)) {
-			alert(\"This source and all graphics are proprietary and may not be viewed or copied.\");
-			return false;
-		}
-	}
-	return true;
-}
-document.onmousedown=right;
-document.onmouseup=right;
-if (document.layers) window.captureEvents(Event.MOUSEDOWN);
-if (document.layers) window.captureEvents(Event.MOUSEUP);
-window.onmousedown=right;
-window.onmouseup=right;
-// -->
-	</SCRIPT>
-</HEAD>
-<BODY BACKGROUND=\"$SYSTEM{'BACKGROUND'}\" BGCOLOR=\"$SYSTEM{'BGCOLOR'}\"
-	TEXT=\"$SYSTEM{'TEXT'}\" LINK=\"$SYSTEM{'LINK'}\"
-	VLINK=\"$SYSTEM{'VLINK'}\" ALINK=\"$SYSTEM{'ALINK'}\">
-\n";
-			$msg = "";
-			@locations = ( $testpending, $testinprog, $testcomplete);
-			$trash = join($pathsep, $locations[$FORM{'location'}], $FORM{'dbfile'});
-			open (TESTFILE, "<$trash")  or $msg="failed";
-			if ($msg eq 'failed') {
-				print "Unable to open file.";
-			} else {
-				@lines = <TESTFILE>;
-				close TESTFILE;
-				if ($trash =~ /$testinprog/ ) {
-					print "<A HREF=\"\#terminate\">TERMINATE THIS TEST</A><BR>\n";
-				}
-				foreach $line (@lines) {
-					chomp ($line);
-					print "$line<BR>\n";
-				}
-				if ($trash =~ /$testinprog/ ) {
-					print "<FORM METHOD=POST ACTION=\"$cgiroot/testterm.pl\">\n";
-					print "<INPUT TYPE=HIDDEN NAME=\"tid\" VALUE=\"$SESSION{'tid'}\">\n";
-					print "<INPUT TYPE=HIDDEN NAME=\"dbfile\" VALUE=\"$FORM{'dbfile'}\">\n";
-					print "<A NAME=\"terminate\">Reason for Terminating The Test:</A><BR>\n";
-					print "<TEXTAREA NAME=\"reason\" ROWS=\"4\" COLS=\"40\"></TEXTAREA><BR>\n";
-					print "<INPUT TYPE=SUBMIT VALUE=\"Terminate Test\">\n";
-					print "</FORM>\n";
-				}
-			}
-	} else {
-		print "<HEAD>\n<TITLE>$REPORT{'rptid'}</TITLE>\n</HEAD>\n";
-		print "<BODY>\n";
-		print "Report Not Yet Available.<BR>\n";
-	}
-	print "</BODY>\n";
-	print "</HTML>\n";
-}
-
-sub print_report_C_004 {
-	@trecs = &get_test_list_all();
-	@tmptrecs = ();
-	for (1 .. $#trecs) {
-		($id, $desc) = split(/&/, $trecs[$_]);
-		$trecs[$_] = join('&', "$desc", "$id");
-		push @tmptrecs, $trecs[$_];
-	}
-	@tmptrecs = sort @tmptrecs;
-	my $prev = 'nonesuch';
-	@trecs = grep($_ ne $prev && (($prev) = $_), @tmptrecs);
-	for (0 .. $#trecs) {
-		($desc,$id) = split(/&/, $trecs[$_]);
-		$testscompleted = CountTestFiles($testcomplete,"all",$id);
-		$testsinprogress = CountTestFiles($testinprog, "all",$id);
-		$testspending = CountTestFiles($testpending, "all",$id);
-		$href="javascript:parmsC004(document.rptform1,\'$id\')\;";
-		$tstoption ="	<TR>
-		<TD valign=top><FONT SIZE=2><a href=\"$href\">$id</a></FONT></TD>
-		<TD valign=top><FONT SIZE=2>$desc</FONT></TD>
-		<TD align=right valign=top><FONT SIZE=2>$testscompleted</FONT></TD>
-		<TD align=right valign=top><FONT SIZE=2>$testsinprogress</FONT></TD>
-		<TD align=right valign=top><FONT SIZE=2>$testspending</FONT></TD>
-	</TR>\n";
-		$tstoptions = join('', $tstoptions, $tstoption);
-	}
-	print "<CENTER><B>Test/Survey Summary Statistics</B><br>
-$finputs
-<TABLE cellpadding=1 cellspacing=1 border=0 width=\"100\%\">
-	<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>
-	<TR>
-		<TD valign=top><B><FONT SIZE=1>Test ID</FONT></B></TD>
-		<TD valign=top><B><FONT SIZE=1>Description</FONT></B></TD>
-		<TD align=right valign=top><B><FONT SIZE=1>Cmp</FONT></B></TD>
-		<TD align=right valign=top><B><FONT SIZE=1>InP</FONT></B></TD>
-		<TD align=right valign=top><B><FONT SIZE=1>Pnd</FONT></B></TD>
-	</TR>
-	<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>
-	$tstoptions
-	<TR><TD colspan=5><HR WIDTH=\"100\%\"></TD></TR>
-</TABLE>
-";
-}

survey-nginx/cgi-bin/tadmin.pl.bu20110216

@@ -1,321 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: tadmin.pl,v 1.10 2006/08/21 20:13:44 psims Exp $
-#
-# Source File: tadmin.pl
-
-# Get config
-require 'sitecfg.pl';
-require 'testlib.pl';
-require 'sbalib.pl';
-
-&app_initialize;
-
-print "Content-Type: text/html\n\n";
-
-if (&get_session($FORM{'tid'})) {
-	&LanguageSupportInit();
-
-	&get_client_profile($SESSION{'clid'});
-	$isregistrar = &get_a_key("cnd.$SESSION{'clid'}", $SESSION{'uid'}, "registrar");
-	if ($FORM{'dbop'} eq 'tnew') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Define New Test");
-		@lines = &get_template("tdef");
-		&test_new_response;
-	} elsif ($FORM{'dbop'} eq'tdel') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Delete Test $FORM{'tstid'}");
-		#hkh 03/04 get date&time stamp - bug#103
-		$deltime = &format_date_time("yymmddhhnnss", "2", "0"); 
-		&test_delete_response($SESSION{'clid'}, $FORM{'tstid'}, $deltime);
-		&test_files_delete($SESSION{'clid'}, $FORM{'tstid'}, $deltime);
-		&complete_inprog_pending_test_del($SESSION{'clid'}, $FORM{'tstid'}, $deltime);
-		&show_template("tdefframe");
-	} elsif ($FORM{'dbop'} eq 'tupd') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Edit Test $FORM{'tstid'}");
-		@lines = &get_template("tdef");
-		&test_update_response($SESSION{'clid'}, $FORM{'tstid'});
-	} elsif ($FORM{'dbop'} eq 'cnew') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "New Candidate");
-		if ($isregistrar eq "Y") {
-			$SESSION{'registrar'} = "Y";
-		}
-		@lines = &get_template("addcnd");
-		&candidate_new_response;
-	} elsif ($FORM{'dbop'} eq 'cdel') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Delete Candidate $FORM{'cndid'}");
-		#hkh 03/04 get date&time stamp - bug#103
-		$deltime = &format_date_time("yymmddhhnnss", "2", "0");
-		&candidate_delete_response($SESSION{'clid'}, $FORM{'cndid'}, $deltime);
-		&complete_inprog_pending_cand_test_del($SESSION{'clid'}, $FORM{'cndid'}, $deltime);
-		$filterbydate = $FORM{'filterbydate'};
-		$FORM{'dtl'} = 8;		#I have no idea why this must be set, but it needs to be
-		$FORM{'filterbydate'} = "Y";
-                $filterbydate = $FORM{'filterbydate'};
-                $day_filter = $FORM{'day_filter'};
-                $date_filter = $FORM{'date_filter'};
-                $cnd1_filter = $FORM{'cnd1'};
-                $cnd2_filter = $FORM{'cnd2'};
-                $cnd3_filter = $FORM{'cnd3'};
-                $cnd4_filter = $FORM{'cnd4'};
-		$CANDIDATE{'registrar'} = $isregistrar;
-		&show_template("maintcnd");
-	} elsif ($FORM{'dbop'} eq 'cupd') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Edit Candidate $FORM{'cndid'}");
-		if ($isregistrar eq "Y") {
-			$SESSION{'registrar'} = "Y";
-		}
-		@lines = &get_template("addcnd");
-		&candidate_update_response($SESSION{'clid'}, $FORM{'cndid'});
-	} elsif ($FORM{'dbop'} eq 'gnew') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "New Group Registration");
-		@lines = &get_template("grpdef");
-		&group_new_response;
-	} elsif ($FORM{'dbop'} eq 'gdel') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Delete Group Registration $FORM{'grpid'}");
-		&group_delete_response($SESSION{'clid'}, $FORM{'grpid'});
-		$showmessage = "Group $FORM{'grpid'} has been deleted.";
-		&show_message_with_close($showmessage);
-	} elsif ($FORM{'dbop'} eq 'gupd') {
-		&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Edit Group Registration $FORM{'grpid'}");
-		@lines = &get_template("grpdef");
-		&group_update_response($SESSION{'clid'}, $FORM{'grpid'});
-	} else {
-		&show_illegal_access_warning;
-	}
-}
-
-sub test_new_response {
-	$FORM{'newtest'} = "Y";
-	$TEST{'seq'} = $FORM{'seq'};
-    if ( ! setup_avail_settings(\%TEST ) ) {
-        &logger::logerr("Unable to setup availability window");
-    }
-	foreach $line (@lines) {
-		$line=&xlatline($line);
-	}
-}
-
-sub candidate_new_response {
-	$FORM{'new'} = "Y";
-	$FORM{'prevenb'} = 0;
-	$FORM{'nxtenb'} = 0;
-	foreach $line (@lines) {
-		$line=&xlatline($line);
-	}
-}
-
-sub group_new_response {
-	$FORM{'new'} = "Y";
-	foreach $line (@lines) {
-		$line=&xlatline($line);
-	}
-}
-
-sub test_update_response {
-	$TEST{'new'} = "N";
-	&get_test_profile($_[0], $_[1]);
-	$SUBJAREA{'subjskillcgt'}=&get_subjskill_cntgrdtbl($SESSION{'clid'}, $TEST{'id'}, "");
-	foreach $line (@lines) {
-		$line=&xlatline($line);
-	}
-}
-
-sub candidate_update_response {
-	my $cndid;
-	my $prevenb;
-	my $nxtenb;
-	$FORM{'new'} = "N";
-	($cndid,$prevenb,$nxtenb)=&get_candidate_list_nav($_[0],$_[1],'nop',$FORM{'sortedkey'});
-	$FORM{'prevenb'} = $prevenb unless $isregistrar eq 'Y';
-	$FORM{'nxtenb'} = $nxtenb unless $isregistrar eq 'Y';
-	&get_candidate_profile($_[0], $_[1]);
-	foreach $line (@lines) {
-		$line=&xlatline($line);
-	}
-}
-
-sub group_update_response {
-	$FORM{'new'} = "N";
-	&get_candidate_profile($_[0], $_[1]);
-	foreach $line (@lines) {
-		$line=&xlatline($line);
-	}
-}
-
-sub test_delete_response {
-	@trecs = &get_test_list($_[0]);
-#hkh 03/04 write test file to recycle dir before deleting test record - bug#103
-	$testfile = "tests.$clid";
-	$oldfile = join($pathsep, $dataroot, $testfile);
-	my $newfile = join($pathsep, $recydataroot, "$testfile.$_[2]");
-	cpbin("$oldfile", "$newfile", 1);
- 
-	foreach $trec (@trecs) {
-		chop ($trec);
-		($id, $trash) = split(/\&/, $trec);
-		if ($_[1] ne $id) {
-			push @newtests, $trec;
-		}
-	}
-	@trecs = @newtests;
-	&save_test_list($_[0]);
-}
-
-#hkh 03/04 write custom/mtx/question/logo etc. to recycle dir before deleting -
-#          bug#103
-sub test_files_delete {
-	if ( ! opendir(DIR, $questionroot) ) {
-		return 0;
-	}
-	my $regex = "^$_[1]".'\.'."$_[0]".'(.*)$';
-        @filenames = readdir(DIR);
-	closedir(DIR);
-	foreach my $srcfile ( @filenames ) {
-		if ( $srcfile =~ /^$_[1].$_[0](.*)$/ ) {
-			$oldfile = join($pathsep, $questionroot, $srcfile);
-			my $newfile = join($pathsep, $recyquestionroot, "$srcfile.$_[2]");
-			cpbin("$oldfile", "$newfile", 1);
-			$cnt = unlink $oldfile;
-#			print "$oldfile deleted $! ...<BR>\n";
-		}
-	}
-
-	# delete logo files
-	if ( ! opendir(DIR, $testgraphic) ) {
-		return 0;
-	}
-        @filenames = readdir(DIR);
-	closedir(DIR);
-	my $regex = "^$_[0]".'\.'."$_[1]".'(.*)$';
-	foreach my $srcfile ( @filenames ) {
-		if ( $srcfile =~ /^$_[0].$_[1].0(.*)$/ ) {
-			$oldfile = join($pathsep, $testgraphic, $srcfile);
-			my $newfile = join($pathsep, $recytestgraphic, "$srcfile.$_[2]");
-			cpbin("$oldfile", "$newfile", 1);
-			$cnt = unlink $oldfile;
-#			print "$oldfile deleted $! ...<BR>\n";
-		}
-	}
-}
-
-#hkh 03/04 write completed/inprog/pending files for the deleted test to recycle
-#          directory before deleting - bug#103
-sub complete_inprog_pending_test_del {
-	opendir(DIR, $testcomplete);
-	@filenames = readdir(DIR);
-	closedir DIR;
-	foreach $srcfile (@filenames) {
-		if ($srcfile =~ /^$clid\./ ) {
-			if (($srcfile =~ /\.$_[1]/) || ($srcfile =~ /\.$_[1].tim/)) {
-				$oldfile = join($pathsep, $testcomplete, $srcfile);
-				my $newfile = join($pathsep, $recytestcomplete, "$srcfile.$_[2]");
-				cpbin("$oldfile", "$newfile", 1);
-				$cnt = unlink $oldfile;
-			}
-		}
-	}
-
-	opendir(DIR, $testinprog);
-	@filenames = readdir(DIR);
-	closedir DIR;
-	foreach $srcfile (@filenames) {
-		if ($srcfile =~ /^$clid\./ ) {
-			if (($srcfile =~ /\.$_[1]/) || ($srcfile =~ /\.$_[1].tim/)) {
-				$oldfile = join($pathsep, $testinprog, $srcfile);
-				my $newfile = join($pathsep, $recytestinprog, "$srcfile.$_[2]");
-				cpbin("$oldfile", "$newfile", 1);
-				$cnt = unlink $oldfile;
-			}
-		}
-	}
-
-	opendir(DIR, $testpending);
-	@filenames = readdir(DIR);
-	closedir DIR;
-	foreach $srcfile (@filenames) {
-		if ($srcfile =~ /^$clid\./ ) {
-			if (($srcfile =~ /\.$_[1]/) || ($srcfile =~ /\.$_[1].tim/)) {
-				$oldfile = join($pathsep, $testpending, $srcfile);
-				my $newfile = join($pathsep, $recytestpending, "$srcfile.$_[2]");
-				cpbin("$oldfile", "$newfile", 1);
-				$cnt = unlink $oldfile;
-			}
-		}
-	}
-
-} 
-
-sub candidate_delete_response {
-#	&remove_pending_tests($_[0], $_[1]);
-#hkh 03/04 write candidate file to recycle dir before deleting cand record - bug#103
-	$srcfile = "cnd.$_[0]";
-	$oldfile = join($pathsep, $dataroot, $srcfile);
-	my $newfile = join($pathsep, $recydataroot, "$srcfile.$_[2]");
-	cpbin("$oldfile", "$newfile", 1);
- 
-	@crecs = &get_data("cnd.$_[0]");
-	$trash = join( $pathsep, $dataroot, "cnd.$_[0]");
-	open (TSTFILE, ">$trash");
-	foreach $crec (@crecs) {
-		($clid, $trash) = split(/\&/, $crec);
-		if ($_[1] ne $clid) {
-			print TSTFILE "$crec";
-		}
-	}
-	close TSTFILE;
-}
-
-sub complete_inprog_pending_cand_test_del {
-#hkh 03/04 write completed/inprog/pending files for the deleted cand. to recycle
-#    directory before deleting - bug#103
-	opendir(DIR, $testcomplete);
-	@filenames = readdir(DIR);
-	closedir DIR;
-	foreach $srcfile (@filenames) {
-		if ($srcfile =~ /^$_[0].$_[1]\./ ) {
-			$oldfile = join($pathsep, $testcomplete, $srcfile);
-			my $newfile = join($pathsep, $recytestcomplete, "$srcfile.$_[2]");
-			cpbin("$oldfile", "$newfile", 1);
-			$cnt = unlink $oldfile;
-		}
-	}
-
-	opendir(DIR, $testinprog);
-	@filenames = readdir(DIR);
-	closedir DIR;
-	foreach $srcfile (@filenames) {
-		if ($srcfile =~ /^$_[0].$_[1]\./ ) {
-			$oldfile = join($pathsep, $testinprog, $srcfile);
-			my $newfile = join($pathsep, $recytestinprog, "$srcfile.$_[2]");
-			cpbin("$oldfile", "$newfile", 1);
-			$cnt = unlink $oldfile;
-		}
-	}
-
-	opendir(DIR, $testpending);
-	@filenames = readdir(DIR);
-	closedir DIR;
-	foreach $srcfile (@filenames) {
-		if ($srcfile =~ /^$_[0].$_[1]\./ ) {
-			$oldfile = join($pathsep, $testpending, $srcfile);
-			my $newfile = join($pathsep, $recytestpending, "$srcfile.$_[2]");
-			cpbin("$oldfile", "$newfile", 1);
-			$cnt = unlink $oldfile;
-		}
-	}
-
-} 
-
-sub group_delete_response {
-#	&remove_pending_tests($_[0], $_[1]);
-#	@crecs = &get_data("cnd.$_[0]");
-#	$trash = join( $pathsep, $dataroot, "cnd.$_[0]");
-#	open (TSTFILE, ">$trash");
-#	foreach $crec (@crecs) {
-#		($clid, $trash) = split(/\&/, $crec);
-#		if ($_[1] ne $clid) {
-#			print TSTFILE "$crec";
-#		}
-#	}
-#	close TSTFILE;
-}

survey-nginx/cgi-bin/tdef.pl.bu20190705

@@ -1,845 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: tdef.pl,v 1.11 2006/05/22 16:06:41 psims Exp $
-#
-# Source File: tdef.pl
-
-# Get config
-use CGI qw/:standard/;
-
-require 'sitecfg.pl';
-require 'ui.pl';
-require 'sbalib.pl';
-
-use POSIX;
-
-if ( ! &go() ) {
-	&logger::logerr("Unable to successfully serve page");
-}
-
-sub go {
-	&app_initialize;
-	print "Content-Type: text/html\n\n";
-	if (&get_session($FORM{'tid'})) {
-		&LanguageSupportInit();
-
-		### DED 8/27/02 Preview CFA
-		if (($FORM{'cfa'} ne '') && ($FORM{'preview'} eq "Preview")) {
-			&preview_cfa();
-			return;
-		}
-		my ($ok, $msg) = &setAvailableDatetimes( \%FORM );
-		$FORM{'respmsg'} = "";
-		if ( ! $ok ) {
-			$FORM{'respmsg'} = &errorformat($msg);
-			$FORM{'savechanges'} = 'N';
-			$FORM{'frm'} = 1;
-		}
-		if ($FORM{'tstid'} eq '') { $FORM{'tstid'} = $FORM{'id'}; }
-		if ($FORM{'id'} eq '') { $FORM{'id'} = $FORM{'tstid'}; }
-		if ($FORM{'UploadImages'} ne '') {
-			&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Test Image Upload $FORM{'tstid'}");
-			&show_upload_form;
-			return 1;
-		} else {
-			if ($FORM{'savechanges'} eq 'Y' ) {
-
-				if ( defined($FORM{'newtest'}) && ($FORM{'newtest'} eq 'Y') && &is_duplicate_test_id($FORM{'tstid'}, $SESSION{'clid'})) {
-
-					#
-					# Disallow duplicates on new test defns ...
-					#
-					$msg = GetLanguageElement($SESSION{lang}, 552);
-					$msg .= qq{ "$FORM{'tstid'}" (};
-					$msg .= GetLanguageElement($SESSION{lang}, 553);
-					$msg .= qq{ "$FORM{'desc'}") };
-					$msg .= GetLanguageElement($SESSION{lang}, 554);
-					$FORM{'respmsg'} .= &errorformat($msg);
-					&logger::loguerr($msg);
-
-				} elsif ( defined($FORM{'newtest'}) && 
-				          ($FORM{'newtest'} eq 'Y') &&
-					 	  $FORM{'tstid'} =~ /\s/ ) {
-
-					#
-					# Disallow spaces in new test IDs ...
-					#
-					$msg = GetLanguageElement($SESSION{lang}, 555);
-					$FORM{'respmsg'} .= &errorformat($msg);
-					&logger::loguerr($msg);
-
-				} else {
-					if ($FORM{'flags'} ne '' || $FORM{'group'} ne '' || $FORM{'tstalwrotip'} ne '') {
-						@flags = split(/\./, $FORM{'flags'});
-						$flags[4] = $FORM{'group'};
-						$flags[5] = $FORM{'tstalwrotip'};
-						$FORM{'flags'} = join('.',@flags);
-					}
-					### DED 6/22/04 For Custom fields
-					### Not yet implemented
-					#$FORM{'showsubj'} .= ".$FORM{'showques1'}.$FORM{'lblques1'}.$FORM{'showques2'}.$FORM{'lblques2'}";
-
-					&put_test_profile($SESSION{'clid'}, $FORM{'id'}, \%FORM, $FORM{newtest});
-					if ($FORM{'seq'} eq 'std') {
-						&put_test_saskmatrix($SESSION{'clid'}, $FORM{'id'}, \%FORM);
-					}
-
-					&put_test_logo($SESSION{'clid'},$FORM{'id'}, \%UPLOADED_FILES);
-					&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "3", "Saved Test Definition $FORM{'id'}");
-					if ($FORM{'newtest'} eq 'Y') {
-						&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "Question File Created $FORM{'id'}");
-						&create_question_file($SESSION{'clid'}, $FORM{'id'});
-						$FORM{'newtest'} = "N";
-					}
-					$FORM{'frm'} = 1;
-#					$FORM{'respmsg'} .= GetLanguageElement($SESSION{lang}, 556);
-
-					#
-					#  Create an Instance of this test?
-					#
-					if ( ($FORM{instanceit} eq 'Y' || $FORM{instanceit} eq 'on') ) {
-					
-						$FORM{instancename} = strip_blanks($FORM{instancename});
-					       	$FORM{desc} = $FORM{instancedesc};
-						my ($rc, $msg) = &instance_test($SESSION{'clid'}, $FORM{'tstid'}, $FORM{instancename}, \%FORM);
-						if ( ! $rc ) {
-
-							&logger::logerr("&instance_test($SESSION{'clid'}, $FORM{'tstid'}, $FORM{instancename}) FAILED;");
-#hkh bug#157 delete any new files due to incomplete cloning
-						} else {
-							log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2",
-							          "Created an Instance of  test '$FORM{instancename}' from test/survey '$FORM{'tstid'}'");
-						}
-						$FORM{'respmsg'} .= $msg;
-					}
-
-					#
-					#  Clone this test?
-					#
-					if ( ($FORM{cloneit} eq 'Y' || $FORM{cloneit} eq 'on') ) {
-					
-						$FORM{clonename} = strip_blanks($FORM{clonename});
-					       	$FORM{desc} = $FORM{clonedesc};
-						my ($rc, $msg) = &clone_test($SESSION{'clid'}, $FORM{'tstid'}, $FORM{clonename}, \%FORM);
-						if ( ! $rc ) {
-
-							&logger::logerr("&clone_test($SESSION{'clid'}, $FORM{'tstid'}, $FORM{clonename}) FAILED;");
-#hkh bug#157 delete any new files due to incomplete cloning
-						} else {
-							log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2",
-							          "Cloned test/survey '$FORM{clonename}' from test/survey '$FORM{'tstid'}'");
-						}
-						$FORM{'respmsg'} .= $msg;
-					}
-				}
-				$TEST{'reload'}="Y";
-			} else {
-				$FORM{'respmsg'} .= GetLanguageElement($SESSION{lang}, 557);
-			}
-
-			push @templates, (tdefund, tdef, tdefstd, tdefadp);
-
-			if ($FORM{'newtest'} ne 'Y') {
-				&get_test_profile($SESSION{'clid'}, $FORM{'tstid'});
-				if ($FORM{'frm'} eq 0) {
-					$FORM{'frm'} = ($TEST{'seq'} eq 'std') ? 2 : 3;
-				}
-				# added for subject area support
-			}
-			$SUBJAREA{'subjskillcgt'}=&get_subjskill_cntgrdtbl($SESSION{'clid'}, $FORM{'tstid'}, "");
-			# FIXME:  This needs to go thru the language support facilities.
-			if ($FORM{'respmsg'} eq "") {
- 				$FORM{'respmsg'} .= GetLanguageElement($SESSION{lang}, 556);
-			} 
-			print $FORM{respmsg} if ( $FORM{respmsg} );
-			&get_client_profile($SESSION{'clid'});
-			&show_template($templates[$FORM{'frm'}]);
-			return 1;
-		}
-	}
-}
-
-
-sub setAvailableDatetimes {
-	my ($form) = @_;
-
-	$form->{availonminute}      ||= $UI{DEFAULT_AVAILON_MIN};
-	$form->{availonhour}        ||= $UI{DEFAULT_AVAILON_HR};
-	$form->{availthruminute}    ||= $UI{DEFAULT_AVAILTHRU_MIN};
-	$form->{availthruhour}      ||= $UI{DEFAULT_AVAILTHRU_HR};
-
-
-	if ( ! defined($form->{availonminute})   ||
-	     ! defined($form->{availonhour})     ||
-	     ! defined($form->{availonpmoffset}) ||
-	     ! defined($form->{availthruminute}) ||
-	     ! defined($form->{availthruhour})   ||
-	     ! defined($form->{availthrupmoffset}) ) {
-		logger::logerr("One of the 'availon...' or 'availthru...' form fields is undefined...aborting setAvailableDatetimes()");
-		return (0, GetLanguageElement($SESSION{lang}, 565));
-	}
-
-	if ( $form->{availonminute}     !~ /^\d+$/ ) {
-		logger::logerr("form field 'availonminute' is not of the expected integer format...aborting setAvailableDatetimes().  availonminute = $form->{availonminute}");
-		return (0, GetLanguageElement($SESSION{lang}, 565));
-	}
-
-	if ( $form->{availonhour}       !~ /^\d+$/ ) {
-		logger::logerr("form field 'availonhour' is not of the expected integer format...aborting setAvailableDatetimes()");
-		return (0, GetLanguageElement($SESSION{lang}, 565));
-	}
-
-	$form->{availonpmoffset} ||= 0;
-	$form->{availthrupmoffset} ||= 0;
-	if ( $form->{availonpmoffset}   !~ /^\d+$/ ) {
-		logger::logerr("form field 'availonpmoffset' [$form->{availonpmoffset}] is not of the expected integer format...aborting setAvailableDatetimes()");
-		return (0, GetLanguageElement($SESSION{lang}, 565));
-	}
-
-	if ( $form->{availthruminute}   !~ /^\d+$/ ) {
-		logger::logerr("form field 'availthruminute' is not of the expected integer format...aborting setAvailableDatetimes()");
-		return (0, GetLanguageElement($SESSION{lang}, 565));
-	}
-
-	if ( $form->{availthruhour}     !~ /^\d+$/ ) {
-		logger::logerr("form field 'availthruhour' is not of the expected integer format...aborting setAvailableDatetimes()");
-		return (0, GetLanguageElement($SESSION{lang}, 565));
-	}
-
-	if ( $form->{availthrupmoffset} !~ /^\d+$/ ) {
-		logger::logerr("form field 'availthrupmoffset' is not of the expected integer format...aborting setAvailableDatetimes()");
-		return (0, GetLanguageElement($SESSION{lang}, 565));
-	}
-
-	if ( $form->{availonhour} < 12 ) {
-		$form->{availonhour} += $form->{availonpmoffset};
-	} elsif ( $form->{availonpmoffset} == 0 ) {
-		$form->{availonhour} -= 12;
-	}
-
-	if ( $form->{availthruhour} < 12 ) {
-		$form->{availthruhour} += $form->{availthrupmoffset};
-	} elsif ( $form->{availthrupmoffset} == 0 ) {
-		$form->{availthruhour} -= 12;
-	}
-
-	$form->{availon} = sprintf("%02d/%02d/%04d-%02d:%02d",
-	                                $form->{availonmonth},
-	                                $form->{availonday},
-	                                $form->{availonyear},
-	                                $form->{availonhour},
-	                                $form->{availonminute});
-
-	$form->{availthru} = sprintf("%02d/%02d/%04d-%02d:%02d",
-	                                $form->{availthrumonth},
-	                                $form->{availthruday},
-	                                $form->{availthruyear},
-	                                $form->{availthruhour},
-	                                $form->{availthruminute});
-
-	my $on = POSIX::strftime("%s", 0, $form->{availonminute}, 
-	                                  $form->{availonhour}, 
-									  $form->{availonday}, 
-									  $form->{availonmonth} - 1, 
-									  $form->{availonyear} - 1900);
-
-	my $to = POSIX::strftime("%s", 0, $form->{availthruminute}, 
-	                                  $form->{availthruhour}, 
-									  $form->{availthruday}, 
-									  $form->{availthrumonth} - 1, 
-									  $form->{availthruyear} - 1900);
-
-	if ( ! valid_date( $form->{availonyear}, 
-	                   $form->{availonmonth}, 
-					   $form->{availonday}) ) {
-		&logger::loguerr("Bogus availability start date/time:  [$form->{availon}]");
-		return (0, GetLanguageElement($SESSION{lang}, 577));
-	}
-
-	if ( ! valid_date( $form->{availthruyear}, 
-	                   $form->{availthrumonth}, 
-					   $form->{availthruday}) ) {
-		&logger::loguerr("Bogus availability end date/time:  [$form->{availthru}]");
-		return (0, GetLanguageElement($SESSION{lang}, 577));
-	}
-
-	if ( $to <= $on ) {
-		&logger::loguerr("Test/survey starting time ($form->{availon}) later than ending time ($form->{availthru})");
-		return (0, GetLanguageElement($SESSION{lang}, 576));
-	}
-
-
-	return (1, "");
-}
-
-sub valid_test_id_syntax( $ ) {
-	my ($testid) = @_;
-
-	# No spaces allowed in test names...
-	if ( $testid =~ /\s/ ) {
-		return (0, GetLanguageElement($SESSION{lang}, 555)); #No spaces
-	}
-
-	if ( $testid !~ /\S/ ) {
-		return (0, GetLanguageElement($SESSION{lang}, 567)); #At least 1 char
-	}
-
-	return (1, GetLanguageElement($SESSION{lang}, 566)); #OK
-}
-
-# Return 1 if the test already exists, 0 if it does not.
-sub is_duplicate_test_id {
-	($id,$clid) = @_;
-
-	# FIXME:  Handle undefined test ID/description
-
-	@test_list = &get_test_list($clid);
-
-	foreach ( @test_list ) {
-
-		($this_id, $this_desc) = split(/&/, $_);
-		if ( $this_id eq $id ) {
-			return 1;
-		}
-	}
-
-	return 0;
-}
-
-#
-# Copy/duplicate the test $tstid and name the new cloned test $newtestid for 
-# client $clid.
-#
-sub instance_test( $ $ $ $ ) {
-	my ($clid, $oldtestid, $newtestid, $params) = @_;
-
-	my ($rc, $msg) = valid_test_id_syntax($newtestid);
-	if ( ! $rc ) {
-		&logger::loguerr("Invalid test ID syntax:  '$newtestid'");
-		return (0, errorformat($msg));
-	}
-
-	if ( &is_duplicate_test_id($newtestid, $SESSION{'clid'}) ) {
-		&logger::loguerr("The test ID '$newtestid' already exists and cannot serve as a test ID for a new instance test for client '$clid'.");
-		my $msg = GetLanguageElement($SESSION{lang}, 936);
-		$msg .= "  ".GetLanguageElement($SESSION{lang}, 564);
-		$msg .= "  ".GetLanguageElement($SESSION{lang}, 552);
-		$msg .= qq{ "$newtestid" };
-		$msg .= GetLanguageElement($SESSION{lang}, 554);
-		return (0, errorformat($msg));
-	}
-
-	if ( ! $params || ref($params) ne 'HASH' ) {
-		&logger::logerr("Missing new test parameters for Instance test ID '$newtestid', client '$clid'.");
-		return 0;
-		my $msg = GetLanguageElement($SESSION{lang}, 936);
-		$msg .= "  ".GetLanguageElement($SESSION{lang}, 564);
-		$msg .= "  ".GetLanguageElement($SESSION{lang}, 565);
-		return (0, errorformat($msg));
-	}
-
-
-	my $newtest = 'Y';
-
-	if ( ! &put_test_profile($clid, $newtestid, $params, $newtest, $oldtestid) ) {
-		&logger::logerr("put_test_profile($clid,$newtestid,$params,$newtest) FAILED");
-		my $msg = GetLanguageElement($SESSION{lang}, 936);
-		return (0, errorformat($msg));
-	}
-	if ( ! &link_question_file($clid, $oldtestid, $newtestid) ) {
-		&remove_created_test_file($clid, $newtestid);
-		&logger::logerr("link_question_file($clid, $oldtestid, $newtestid) FAILED");
-		my $msg = GetLanguageElement($SESSION{lang}, 937);
-		return (0, errorformat($msg));
-	}
-
-	if ( ! &link_sbacustom_files($clid, $oldtestid, $newtestid) ) {
-		&remove_created_test_file($clid, $newtestid);
-		&remove_created_question_file($clid, $newtestid);
-		&logger::logerr("link_sbacustom_files($clid, $oldtestid, $newtestid) FAILED");
-		my $msg = GetLanguageElement($SESSION{lang}, 938);
-		return (0, errorformat($msg));
-	}
-
-	if ( ! &link_test_logos($clid, $oldtestid, $newtestid) ) {
-		&remove_created_test_file($clid, $newtestid);
-		&remove_created_question_file($clid, $newtestid);
-		&remove_created_sbacustom_files($clid, $newtestid);
-		&logger::logerr("link_test_logos($clid, $oldtestid, $newtestid) FAILED");
-		my $msg = GetLanguageElement($SESSION{lang}, 939);
-		return (0, errorformat($msg));
-	}
-
-	my $msg = GetLanguageElement($SESSION{lang}, 940);
-	$msg .= "'$oldtestid'";
-	$msg .= GetLanguageElement($SESSION{lang}, 569);
-	$msg .= "'$newtestid'";
-
-	return (1, okformat($msg));
-}
-
-sub link_test_logos {
-	my ($clid, $srctestid, $newtestid) = @_;
-
-	if ( ! opendir(DIR, $testgraphic) ) {
-		&logger::logerr("Unable to opendir $testgraphic:  $!");
-		return 0;
-	}
-	@filenames = readdir(DIR);
-	closedir(DIR);
-
-#	my $regex = "^$clid".'\.'."$srctestid".'(.*)$';
-
-	foreach my $srcfile ( @filenames ) {
-
-		if ( $srcfile =~ /^$clid.$srctestid.0(.*)$/ ) {
-			my $newfile = join($pathsep, $testgraphic, "$clid.$newtestid.0$1");
-			my $oldfile = join($pathsep, $testgraphic, $srcfile);
-			if (! symlink($oldfile, $newfile)) {
-				&remove_created_logo_files($clid, $newtestid);
-				return 0;
-			}
-
-		}
-	}
-
-	return 1;
-}
-
-sub link_question_file {
-	my ($clid, $oldtestid, $newtestid) = @_;
-	my $oldfile = join($pathsep, $questionroot, "$oldtestid.$clid");
-	my $newfile = join($pathsep, $questionroot, "$newtestid.$clid");
-	if (! symlink($oldfile, $newfile)) {
-		&remove_created_question_file($clid, $newtestid);
-		return 0;
-	}
-	return 1;
-}
-
-sub link_sbacustom_files {
-	my ($clid, $oldtestid, $newtestid) = @_;
-	if ( ! opendir(DIR, $questionroot) ) {
-		&logger::logerr("Unable to opendir $questionroot:  $!");
-		return 0;
-	}
-	@filenames = readdir(DIR);
-	closedir(DIR);
-
-	#my $regex = "^$oldtestid".'\.'."$clid".'\.'.'(.*)$';
-	foreach my $srcfile ( @filenames ) {
-
-		if ( $srcfile =~ /^$oldtestid\.$clid\.(.*)$/ ) {
-			my $newfile = join($pathsep, $questionroot, "$newtestid.$clid.$1");
-			my $oldfile = join($pathsep, $questionroot, $srcfile);
-			if ( ! symlink($oldfile, $newfile)) {
-				&remove_created_sbacustom_files($clid, $newtestid);
-				return 0;
-			}
-		}
-	}
-
-	return 1;
-}
-
-#
-# Copy/duplicate the test $tstid and name the new cloned test $newtestid for 
-# client $clid.
-#
-sub clone_test( $ $ $ $ ) {
-	my ($clid, $oldtestid, $newtestid, $params) = @_;
-
-	my ($rc, $msg) = valid_test_id_syntax($newtestid);
-	if ( ! $rc ) {
-		&logger::loguerr("Invalid test ID syntax:  '$newtestid'");
-		return (0, errorformat($msg));
-	}
-
-	if ( &is_duplicate_test_id($newtestid, $SESSION{'clid'}) ) {
-		&logger::loguerr("The test ID '$newtestid' already exists and cannot serve as a test ID for a newly cloned test for client '$clid'.");
-		my $msg = GetLanguageElement($SESSION{lang}, 563);
-		$msg .= "  ".GetLanguageElement($SESSION{lang}, 564);
-		$msg .= "  ".GetLanguageElement($SESSION{lang}, 552);
-		$msg .= qq{ "$newtestid" };
-		$msg .= GetLanguageElement($SESSION{lang}, 554);
-		return (0, errorformat($msg));
-	}
-
-	if ( ! $params || ref($params) ne 'HASH' ) {
-		&logger::logerr("Missing new test parameters for clone test ID '$newtestid', client '$clid'.");
-		return 0;
-		my $msg = GetLanguageElement($SESSION{lang}, 563);
-		$msg .= "  ".GetLanguageElement($SESSION{lang}, 564);
-		$msg .= "  ".GetLanguageElement($SESSION{lang}, 565);
-		return (0, errorformat($msg));
-	}
-
-
-	my $newtest = 'Y';
-
-	if ( ! &put_test_profile($clid, $newtestid, $params, $newtest) ) {
-		&logger::logerr("put_test_profile($clid,$newtestid,$params,$newtest) FAILED");
-		my $msg = GetLanguageElement($SESSION{lang}, 563);
-		return (0, errorformat($msg));
-	}
-
-	if ( ! &clone_question_file($clid, $oldtestid, $newtestid) ) {
-		&remove_created_test_file($clid, $newtestid);
-		&logger::logerr("clone_question_file($clid, $oldtestid, $newtestid) FAILED");
-		my $msg = GetLanguageElement($SESSION{lang}, 731);
-		return (0, errorformat($msg));
-	}
-
-# hkh 01/04 clone mtx & custom files
-	if ( ! &clone_sbacustom_files($clid, $oldtestid, $newtestid) ) {
-		&remove_created_test_file($clid, $newtestid);
-		&remove_created_question_file($clid, $newtestid);
-		&logger::logerr("clone_sbacustom_files($clid, $oldtestid, $newtestid) FAILED");
-		my $msg = GetLanguageElement($SESSION{lang}, 733);
-		return (0, errorformat($msg));
-	}
-
-	if ( ! &clone_test_logos($clid, $oldtestid, $newtestid) ) {
-		&remove_created_test_file($clid, $newtestid);
-		&remove_created_question_file($clid, $newtestid);
-		&remove_created_sbacustom_files($clid, $newtestid);
-		&logger::logerr("clone_test_logos($clid, $oldtestid, $newtestid) FAILED");
-		my $msg = GetLanguageElement($SESSION{lang}, 734);
-		return (0, errorformat($msg));
-	}
-
-	my $msg = GetLanguageElement($SESSION{lang}, 568);
-	$msg .= "'$oldtestid'";
-	$msg .= GetLanguageElement($SESSION{lang}, 569);
-	$msg .= "'$newtestid'";
-
-	return (1, okformat($msg));
-}
-
-
-sub reassignifduplicate {
-	$vid = $_[1];
-	@vtrecs = &get_test_list($_[0]);
-	while (&test_exists($vid)) {
-			$vid++;
-	}
-	return $vid;
-}
-
-sub put_test_logo {
-	my ($clid, $testid) = @_;
-	my $upfile;
-	my $msg;
-	my $chmodok;
-	my $testimg = upload('testimg');
-	my @fileparts = split(/\./, param('testimg'));
-        my $test_logo_ext = $fileparts[$#fileparts];
-        @fileparts = ();
-	if ($SYSTEM{'supportedimagemedia'} =~ /$test_logo_ext/i ) {
-		@suexts = split(/\;/, $SYSTEM{'supportedimagemedia'});
-		# remove any old logos for this test
-		foreach $suext (@suexts) {
-			$prefile = join($pathsep, $pubroot, "graphic", "$clid.$testid");
-			$existingfile=&file_exists_with_extension($prefile, $suext);
-			if ($existingfile ne '') {
-				$cnt = unlink $existingfile;
-			}
-		}
-		# write the uploaded file
-		$upfile = join($pathsep, $pubroot, "graphic", "$clid.$testid.$test_logo_ext");
-		open (OUTFILE, ">$upfile") or $msg="failed";
-		if ($msg ne "failed") {
-			binmode(OUTFILE);
-			while ($bytesread=read($testimg,$buffer,1024)) {
-                           print OUTFILE $buffer;
-                        }
-			close OUTFILE;
-			$chmodok = chmod 0666, $upfile;
-		}
-	}
-}
-
-
-sub clone_test_logos {
-	my ($clid, $srctestid, $newtestid) = @_;
-
-	if ( ! opendir(DIR, $testgraphic) ) {
-		&logger::logerr("Unable to opendir $testgraphic:  $!");
-		return 0;
-	}
-    @filenames = readdir(DIR);
-	closedir(DIR);
-
-#	my $regex = "^$clid".'\.'."$srctestid".'(.*)$';
-
-	foreach my $srcfile ( @filenames ) {
-
-		if ( $srcfile =~ /^$clid.$srctestid.0(.*)$/ ) {
-			my $newfile = join($pathsep, $testgraphic, "$clid.$newtestid.0$1");
-			my $oldfile = join($pathsep, $testgraphic, $srcfile);
-#hkh bug#58		cpbin("$oldfile", "$newfile", 1);
-			if (! &get_io_file($oldfile, $newfile)) {
-				&remove_created_logo_files($clid, $newtestid);
-				return 0;
-			}
-
-#			if ( ! cpbin("$oldfile", "$newfile") ) {
-#				&logger::logerr("cpbin($oldfile, $newfile) FAILED");
-#				if ( scalar(@copied) ) {
-#					&logger::logwarn("DUE cpbin() FAILURE, THERE ARE NOW ORPHANED IMAGE FILES IN $testgraphic: @copied");
-					# NOTE:  We *could* delete the files we just copied,
-					# NOTE:  but that just seems like a bad idea given
-					# NOTE:  we could end-up deleting some original 
-					# NOTE:  graphics files accidentally if they were
-					# NOTE:  already there and thus caused cpbin() to fail.
-#				}
-#				return 0;
-#			} else {
-#				push( @copied, $newfile );
-#			}
-		}
-	}
-
-	return 1;
-}
-
-sub remove_created_test_file {
-	my ($clid, $newtestid) = @_;
-	@trecs = &get_test_list($clid);
-	foreach $trec (@trecs) {
-		chop ($trec);
-		($id, $trash) = split(/\&/, $trec);
-		if ($newtestid ne $id) {
-			push @newtests, $trec;
-		}
-	}
-	@trecs = @newtests;
-	&save_test_list($clid);
-}
-
-#hkh bug#157 delete new logofiles if clonning is not successful
-sub remove_created_logo_files {
-	my ($clid, $newtestid) = @_;
-	opendir(DIR, $testgraphic); 
-        @filenames = readdir(DIR);
-	closedir(DIR);
-	foreach my $srcfile ( @filenames ) {
-		if ( $srcfile =~ /^$clid.$newtestid.0(.*)$/ ) {
-			$ulinkfile = join($pathsep, $testgraphic, $srcfile);
-			$cnt = unlink $ulinkfile;
-		}
-	}
-}
-
-sub test_exists {
-	foreach $vtrec (@vtrecs) {
-		($vid, $vmore) = split(/&/, $vtrec);
-		if ($vid eq $_[0]) {
-			return 1;
-		}
-	}
-	return 0;
-}
-
-sub create_question_file {
-	my ($clid, $testid) = @_;
-	@lines = &get_question_list("default", "std");
-	$trash = join($pathsep, $questionroot, "$testid.$clid");
-	open (TMPFILE, ">$trash");
-	foreach $line (@lines) {
-		print TMPFILE "$line";
-	}
-	close TMPFILE;
-	$chmodok = chmod 0666, $trash;
-}
-
-
-sub clone_question_file {
-	my ($clid, $oldtestid, $newtestid) = @_;
-	@lines = &get_question_list($oldtestid, $clid);
-	$new_question_file = join($pathsep, $questionroot, "$newtestid.$clid");
-	if ( ! open (TMPFILE, ">$new_question_file") ) {
-		&logger::logerr("Unable to write to $new_question_file:  $!");
-		return undef;
-	}
-	$line1 = '0';
-	foreach $line (@lines) {
-#hkh bug#19 if oldtestid is diff. from question-id, replace q-id with newtestid
-		if ($line1 eq '0') {
-			$line1 = '1';
-			print TMPFILE "$line";
-		} else {
-	  		@fields = split /&/, $line;	
- 			$_ = shift(@fields);
-			s/.*\./$newtestid./;
-			unshift(@fields, $_);
-			$line = join "&", @fields;
-#hkh bug#19		$line =~ s/^$oldtestid/$newtestid/;
-			print TMPFILE "$line";
-		}
-	}
-	close TMPFILE;
-	$chmodok = chmod 0666, $new_question_file;
-}
-
-sub remove_created_question_file {
-	my ($clid, $newtestid) = @_;
-	$ulinkfile = join($pathsep, $questionroot, "$newtestid.$clid");
-	$cnt = unlink $ulinkfile;	
-}
-
-# hkh 01/04 
-sub clone_sbacustom_files {
-	my ($clid, $oldtestid, $newtestid) = @_;
-	if ( ! opendir(DIR, $questionroot) ) {
-		&logger::logerr("Unable to opendir $questionroot:  $!");
-		return 0;
-	}
-    @filenames = readdir(DIR);
-	closedir(DIR);
-
-	#my $regex = "^$oldtestid".'\.'."$clid".'\.'.'(.*)$';
-	foreach my $srcfile ( @filenames ) {
-
-		if ( $srcfile =~ /^$oldtestid\.$clid\.(.*)$/ ) {
-			my $newfile = join($pathsep, $questionroot, "$newtestid.$clid.$1");
-			my $oldfile = join($pathsep, $questionroot, $srcfile);
-#hkh bug#58		cpbin("$oldfile", "$newfile", 1) 
-			if ( ! &get_io_file($oldfile, $newfile)) {
-				&remove_created_sbacustom_files($clid, $newtestid);
-				return 0;
-			}
-		}
-	}
-
-	return 1;
-}
-
-sub remove_created_sbacustom_files {
-	my ($clid, $newtestid) = @_;
-	opendir(DIR, $questionroot); 
-        @filenames = readdir(DIR);
-	closedir(DIR);
-	foreach my $srcfile ( @filenames ) {
-		if ( $srcfile =~ /^$newtestid.$clid.(.*)$/ ) {
-			$ulinkfile = join($pathsep, $questionroot, $srcfile);
-			$cnt = unlink $ulinkfile;	
-		}
-	}
-
-}
-
-sub show_upload_form {
-	$iShownCount=0;
-	$qreclist = "";
-	&get_test_profile($SESSION{'clid'}, $FORM{'tstid'});
-	&show_template("uploadpagehdr");
-	print "<FORM METHOD=POST ACTION=\"$PATHS{'cgiroot'}/upimages.pl\" enctype=\"multipart/form-data\">\n";
-	print "<input type=hidden name=tid value=\"$SESSION{'tid'}\">\n";
-	print "<input type=hidden name=clid value=\"$SESSION{'clid'}\">\n";
-	print "<TABLE cellpadding=0 cellspacing=0 border=1 width=\"100%\">\n";
-	print "<TR>\n";
-	print "<TD align=\"left\"><Font Size=1>\n";
-	print "Upload Image\n";
-	print "</font></TD>\n";
-	print "<TD align=\"left\"><Font Size=1>\n";
-	print "\&nbsp;\n";
-	print "</font></TD>\n";
-	print "<TD align=\"left\"><Font Size=1>\n";
-	print "Question\n";
-	print "</font></TD>\n";
-	print "</TR>\n";
-	@qrecs = &get_question_list($FORM{'tstid'}, $SESSION{'clid'});
-	$bFirst = 1;
-	foreach $qrec (@qrecs) {
-		chop ($qrec);
-		if ($bFirst) {
-			@flds = split(/&/, $qrec);
-			$bFirst = 0;
-			$i = 0;
-			foreach $fld (@flds) {
-				if ($fld eq 'qim') {
-					$iqim = $i;
-				} else {
-					if ($fld eq 'id') {
-						$iid = $i;
-					} else {
-						if ($fld eq 'qtx') {
-							$iqtx = $i;
-						}
-					}
-				}
-				$i++;
-			}
-		} else {
-			@flds = split(/&/, $qrec);
-			if ($flds[$iqim] ne '0') {
-				$iShownCount++;
-				print "<TR>\n";
-				print "<TD align=\"left\"><Font Size=1>\n";
-				print "<INPUT TYPE=FILE NAME=\"$SESSION{'clid'}.$flds[$iid]\" MAXLENGTH=120 SIZE=20> \n";
-				$qreclist .= "$flds[$iid]::";
-				print "</font></TD>\n";
-				print "<TD align=\"left\"><Font Size=1>\n";
-				print "\&nbsp;$flds[$iid]:\&nbsp;\n";
-				print "</font></TD>\n";
-				print "<TD align=\"left\"><Font Size=1>\n";
-				print "$flds[$iqtx]\n";
-				print "</font></TD>\n";
-				print "</TR>\n";
-			}
-		}
-	}
-	$qreclist = substr($qreclist,0,-2);
-	unless ($iShownCount) {
-		print "<TR>\n";
-		print "<TD colspan=\"3\" align=\"left\">\n";
-		print "No questions were tagged as having images.\n";
-		print "</TD>\n";
-		print "</TR>\n";
-	}
-	print "<TR>\n";
-	print "<TD colspan=\"3\" align=\"center\">\n";
-	print "<INPUT TYPE=HIDDEN NAME=\"path\" VALUE=\"$testgraphic\">\n";
-	print "<INPUT TYPE=HIDDEN NAME=\"fieldlist\" VALUE=\"$qreclist\">\n";
-	print "<INPUT TYPE=SUBMIT VALUE=\"$xlatphrase[512]\">\n";
-	print "</TD>\n";
-	print "</TR>\n";
-	print "</TABLE>\n";
-	print "</FORM>\n";
-	print "</BODY>\n</HTML>\n";
-}
-
-sub preview_cfa {
-print "
-<HTML>
-<HEAD>
-<!-- Based on agreement.htt,v 1.2 2002/02/14 21:02:55 ed Exp $ -->
-<TITLE>Confidentiality Agreement</TITLE>
-</HEAD>
-<BODY BGCOLOR=\"#FFFFFF\" TEXT=\"#000000\" LINK=\"#0000FF\" VLINK=\"#800080\">
-<TABLE CELLSPACING=0 CELLPADDING=0 BORDER=0 width=\"100%\">
-	<TR>
-		<td align=\"left\">
-			<FONT SIZE=4>
-			&nbsp;<BR>
-			</FONT>
-		</td>
-	</TR>
-	<TR>
-		<td align=\"left\">
-			$FORM{'cfa'} <BR>
-			&nbsp;<BR>
-		</td>
-	</TR>
-	<TR>
-		<td align=\"center\">
-			<INPUT TYPE=BUTTON NAME=submit VALUE=\"$xlatphrase[487]\" onClick=window.close()>&nbsp;
-			<INPUT TYPE=BUTTON NAME=submit VALUE=\"$xlatphrase[488]\" onClick=window.close()>
-			</form>
-		</td>
-	</TR>
-</TABLE>
-</BODY>
-</HTML>\n";
-}

survey-nginx/cgi-bin/testdata.pl.bu20190705

@@ -1,531 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: testdata.pl,v 1.10 2006/11/29 14:44:59 ddoughty Exp $
-#
-# Source File: testdata.pl
-
-# Get config
-use FileHandle;
-use Reporter;
-use Data::Dumper;
-require 'sitecfg.pl';
-require 'testlib.pl';
-use strict;
-use vars qw(%FORM %SESSION %CLIENT %TEST_SESSION %SUBTEST_QUESTIONS %TEST
-	    %SUBTEST_SUMMARY %CANDIDATE %SUBTEST_ANSWERS %SYSTEM %REPORT
-	    %SUBTEST_RESPONSES);
-use vars qw($testcomplete $cgiroot $pathsep $dataroot $testgraphic $graphroot);
-
-&app_initialize;
-&LanguageSupportInit();
-&get_client_profile($SESSION{'clid'});
-
-# Make sure we have a valid session, and exit if we don't
-if (not &get_session($FORM{'tid'})) {
-    exit(0);
-}
-my $options;
-
-if (exists $FORM{'testid'}) {
-    @{$options}{qw(showquest displayquest active inactive remediation bysubject subjfilter bydiff difffilter answers)} =
-	@FORM{qw(showquest displayquest active inactive remediation bysubject subjfilter bydiff difffilter answers)};
-    &DisplayQuestions($SESSION{'clid'},$FORM{'testid'},$options);
-} else {
-    &ReportChooser($SESSION{'clid'});
-}
-
-# There should only be function definitions beyond this point.
-exit(0);
-
-sub ReportChooser {
-    my ($client) = @_;
-    print &Reporter::HTMLHeader("Test Data");
-    # options to be implemented -
-    # drop down menu to choose test
-    # checkbox and text field to choose subset of questions
-    # remediation checkbox
-    # show active checkbox
-    # show inactive checkbox
-    # filter by subjct multichoice
-    # filter by difficulty
-    print "<form name=\"testdatarpt\" action=\"/cgi-bin/creports.pl\" method=\"Post\" target=\"rptwindow\" enctype=\"multipart/form-data\" >\n";
-    print "<input type=\"hidden\" name=\"tid\" value=\"$SESSION{'tid'}\">\n";
-    print "<input type=hidden name=\"rptno\" value=\"$FORM{'rptno'}\">\n";
-    print "<input type=hidden name=\"rptdesc\" value=\"$REPORT{'rptdesc'}\">\n";
-    print "<input type=hidden name=\"rptid\" value=\"$REPORT{'rptid'}\">\n";
-
-    print "<table>\n";
-    #print "<tr><th>Test</th><th>Questions</th><th>S
-    print "<tr valign=\"top\"><td><b>Select Test:</b><br><select name=\"testid\">\n";
-    my @tests = &get_test_list($client);
-    shift @tests;
-    my (@details,%subjects);
-    foreach my $testid (@tests) {
-	my ($id,$desc) = split(/&/,$testid);
-	print "<option value=\"$id\">$desc</option>\n";
-	my $tmp = &get_question_definitions($client,$id);
-	push @details, $tmp;
-	@subjects{map($_->{'subj'},@$tmp)} = 1;
-    }
-    print "</select></td>";
-    print "<td><b>Show Questions:</b><br><input type=\"radio\" name=\"showquest\" value=\"all\" checked>All<br>".
-	"<input type=\"radio\" name=\"showquest\" value=\"subset\">Subset: <input type=\"text\" name=\"displayquest\"></td>";
-    print "<td><b>Display:</b><br><input type=\"checkbox\" name=\"active\" checked>Active Questions<br>".
-	"<input type=\"checkbox\" name=\"inactive\">Inactive Questions<br>".
-	"<input type=\"checkbox\" name=\"answers\">Question Answers<br>".
-	"<input type=\"checkbox\" name=\"remediation\">Remediation<br></td>";
-    print "</tr>\n";
-    print "</table><table>\n";
-    print "<tr><td colspan=\"3\"><b>Filter By:</b></tr>\n";
-    #my @subjects = qw(astronomy geology physics);
-    print "<tr valign=\"top\"><td><input type=\"checkbox\" name=\"bysubject\">Subject:<select name=\"subjfilter\" MULTIPLE>";
-    foreach my $subject (sort keys %subjects) {
-	print "<option value=\"$subject\">$subject</option>\n";
-    }
-    my @difficulties = ([0,'basic'],[1,'intermediate'],[2,'advanced']);
-    print "</td><td><input type=\"checkbox\" name=\"bydiff\">Difficulty:<select name=\"difffilter\">";
-    foreach my $difficulty (@difficulties) {
-	print "<option value=\"$difficulty->[0]\">$difficulty->[1]</option>\n";
-    }
-    print "</select></td>";
-    print "</tr>\n";
-    print "</table>\n";
-    print "<input type=\"submit\" value=\"Get Test\">\n";
-    print &Reporter::HTMLFooter();
-}
-
-sub DisplayQuestions {
-    my ($client,$test,$options) = @_;
-    &get_test_profile($client,$test);
-    my $details = &get_question_definitions($client,$test);
-    print &Reporter::HTMLHeaderPlain("Test Data for $TEST{'desc'}");
-    print "<h1>Test Data for $TEST{'desc'}</h1>\n";
-    print "<form>\n";
-    my (@questnum,%subjects,$difficulty);
-    if ($options->{'showquest'} eq 'subset') {
-	$options->{'displayquest'} =~ s/\s+//g; #eliminate whitespace
-	foreach (split(/,/,$options->{'displayquest'})) {
-	    if (/^\d+$/) {$questnum[$_] = 1;}
-	    if (/^(\d+)-$/) {foreach ($1 .. (scalar(@$details)+1)) {$questnum[$_]=1;}}
-	    if (/^-(\d+)$/) {foreach (1 .. $1) {$questnum[$_]=1;}}
-	    if (/^(\d+)-(\d+)$/) {foreach ($1 .. $2) {$questnum[$_]=1;}}
-	}
-    }
-    if ($options->{'bysubject'}) {
-	%subjects = map(($_=>1),split(/,/,$options->{'subjfilter'}));
-    }
-    if ($options->{'bydiff'}) {
-	$difficulty = $options->{'difffilter'};
-    }
-    my $questcount = 0;
-    foreach my $question (@$details) {
-	### DED 7/28/04 Some questions have qil blank; look for !N instead of Y
-	#if (not (($options->{'active'} and $question->{'qil'} eq 'N') or
-	#	 ($options->{'inactive'} and $question->{'qil'} eq 'Y'))) {
-	if (not (($options->{'active'} and $question->{'qil'} ne 'Y') or
-		 ($options->{'inactive'} and $question->{'qil'} eq 'Y'))) {
-	    next;
-	}
-	if ($options->{'bysubject'} and not $subjects{$question->{'subj'}}) {next;}
-	if ($options->{'bydiff'} and ($question->{'skilllevel'} != $options->{'difffilter'})) {next;}
-	my (undef, $qindex) = split(/\./,$question->{'id'});
-	if (($options->{'showquest'} eq 'subset') and not $questnum[$qindex]) {next;}
-	$questcount++;
-	if ($question->{'qil'} eq 'Y') {
-	    print "<font color=\"red\"><h3>$question->{'id'} - Inactive</h3></font>\n";
-	} else {
-	    print "<h3>$question->{'id'}</h3>\n";
-	}
-	print "Subject: $question->{'subj'}, Skill: ".(qw(basic intermediate advanced))[$question->{'skilllevel'}].
-	    "<p>\n";
-	if ($question->{'qim'}) {
-	    print $question->{'illustration'}."<br>\n";
-	}
-	if ($question->{'qtp'} eq 'tf') {
-	    print formatTF($question,$options);
-	} elsif ($question->{'qtp'} eq 'esa') {
-	    print formatESA($question,$options);
-	} elsif ($question->{'qtp'} eq 'nrt') {
-	    print formatNRT($question,$options);
-	} elsif ($question->{'qtp'} eq 'mch' or $question->{'qtp'} eq 'ord') {
-	    print formatMCHORD($question,$options);
-	} elsif ($question->{'qtp'} eq 'mcs' or $question->{'qtp'} eq 'mcm') {
-	    print formatMC($question,$options);
-	} elsif ($question->{'qtp'} eq 'mtx' or $question->{'qtp'} eq 'mtr') {
-	    print formatMT($question,$options);
-	} else {
-	    #print "<pre>".Dumper($question)."</pre>";
-	}
-	if ($options->{"remediation"}) {
-	    if ($question->{'qrm'}) {
-		print "Remdiation:<br>\n$question->{'qrm'}<br>\n";
-	    } else {
-		print "No Remediation.<br>\n";
-	    }
-	}
-	print "<hr>\n";
-    }
-    print "</form\n";
-    if (not $questcount) {
-	print "<h3>No Matching Questions Found.</h3>\n";
-    }
-    #print "<pre>".Dumper($details,$options)."</pre>";
-    print &Reporter::HTMLFooter();
-}
-
-sub formatTF {
-    my ($question,$options) = @_;
-    my ($optTrue,$optFalse) = ('','');
-    #my $outline = "<h3>$question->{'id'}</h3>\n";
-    my $outline = "$question->{'qtx'}<p>\n";
-    if ($options->{'answers'}) {
-	$optTrue = ($question->{'qca'}=~/(true|yes)/i ? "checked" : "" );
-	$optFalse = ($question->{'qca'}=~/(false|no)/i ? "checked" : "" );
-    }
-    my ($true,$false) = ($question->{'qca'}, $question->{'qia'});
-    if ($question->{'qca'} !~ /(true|yes)/i) {
-	($true,$false) = ($false,$true);
-    }
-    $outline .= "<input type=\"radio\" name=\"$question->{'id'}\" value=\"$true\" $optTrue>$true<BR>\n";
-    $outline .= "<input type=\"radio\" name=\"$question->{'id'}\" value=\"$false\" $optFalse>$false<P>\n";
-    return $outline;
-}
-
-sub formatESA {
-    my ($question,$options) = @_;
-    my ($tmp);
-    #my @esaanswers = split(/\n/,$question->{'qca'});
-    my $len;
-    $tmp = "<ul>\n";
-    foreach (split(/[;\n]/,$question->{'qca'})) {
-	$tmp .= "<li>$_</li>\n";
-	$len = ($len < length($_)? length($_): $len);
-    }
-    $tmp .= "</ul>\n";
-    $len += 5;
-    my $anslist = "<input type=\"text\" name=\"$question->{'id'}\" VALUE=\"\" SIZE=$len>";
-    my $qtext = $question->{'qtx'};
-    if ($qtext =~ /<box>/ ) {
-	$qtext =~ s/<box>/$anslist/g;
-    } else {
-	$qtext .= "<p>$anslist\n";
-    }
-    my $outline .= "$qtext<p>\n";
-    if ($options->{'answers'}) {
-	$outline .= "Answers:<br>\n";
-	$outline .= $tmp;
-    }
-    return $outline;
-}
-
-sub formatMCHORD {
-    my ($question,$options) = @_;
-    my $tmp = $question->{'qca'};
-    $tmp =~ s/\r/\n/g; $tmp =~ s/\n\n/\n/g;
-    my @ansopt = split(/\n/,$tmp);
-    $tmp = $question->{'qia'};
-    $tmp =~ s/\r/\n/g; $tmp =~ s/\n\n/\n/g;
-    my @desc = split(/\n/,$tmp);
-    my @albls = set_answer_labels($question->{'qalb'});
-    my $outline = "$question->{'qtx'}<p>\n";
-    my $num = (@ansopt > @desc? @ansopt: @desc);
-    $outline .= "<table>\n";
-    my @answers;
-    if ($options->{'answers'}) {@answers = @albls;}
-    for (my $i=0; $i<$num; $i++) {
-	if ($question->{'qtp'} eq 'mch') {
-	    $outline .= "<tr><td align=\"left\"><INPUT TYPE=TEXT SIZE=\"2\" NAME=\"$question->{'id'}.$i\" value=\"$answers[$i]\">".
-		"&nbsp;$ansopt[$i]&nbsp;</td>";
-	    $outline .= "<TD align=\"left\" width=80>&nbsp;&nbsp;</TD>";
-	    $outline .= "<TD align=\"left\"><b>$albls[$i]</b>&nbsp;$desc[$i]</TD></TR>\n";
-	} else {
-	    my $answer = ($options->{'answers'}?" value=\"".($i+1)."\"":"");
-	    $outline .= "<tr><td align=\"left\"><INPUT TYPE=TEXT SIZE=\"2\" NAME=\"$question->{'id'}.$i\"$answer>".
-		"&nbsp;$ansopt[$i]&nbsp;</td>";
-	}
-	$outline .= "</tr>\n";
-    }
-    $outline .= "</table><p>\n";
-    return $outline;
-}
-
-sub formatNRT {
-    my ($question,$options) = @_;
-    my $outline = "$question->{'qtx'}<p>\n";
-    my $nrtmaxlen = $question->{'qca'};
-    my $nrtcols = 50;
-    my $nrtrows = $nrtmaxlen/$nrtcols;
-    $nrtrows = ($nrtrows > 5) ? 5 : $nrtrows;
-    $outline .= "<textarea name=\"$question->{'id'}\" ROWS=\"$nrtrows\" COLS=\"$nrtcols\" wrap=\"on\"></TEXTAREA>\n";
-    return $outline;
-}    
-
-sub formatMC {
-    my ($question,$options) = @_;
-    my ($inptyp);
-    if (($question->{'qtp'} eq 'mcs' ) || ($question->{'qtp'} eq 'mca')) {
-	$inptyp = "RADIO";
-    } elsif ($question->{'qtp'} eq 'mcm' ) {
-	$inptyp = "CHECKBOX";
-    } else{
-	return undef;
-    }
-    if ($question->{'anslay'} eq "h") {
-	$inptyp .= ":".$question->{'anslay'};
-    }
-    my @albls = set_answer_labels($question->{'qalb'});
-    my $qca = $question->{'qca'};
-    $qca =~ s/\r/\n/g; $qca =~ s/\n\n/\n/g;
-    my %qansopt = map(($_=>{'correct' =>1}), split(/\n/, $qca));
-    my $qia = $question->{'qia'};
-    $qia =~ s/\r/\n/g; $qia =~ s/\n\n/\n/g;
-    foreach (split(/\n/, $qia)) {$qansopt{$_}->{'correct'} = 0;}
-    my @order;
-    push @order,split(/\n/, $qca), split(/\n/, $qia);
-
-    my $outline="$question->{'qtx'}<p>\n";
-    my $iord=0;
-    foreach (@order) {
-	my $qans;
-	if ($question->{'qalb'} ne "x") {
-	    $qansopt{$_}->{'formatted'} = $albls[$iord].") $_";
-	} else {
-	    $qansopt{$_}->{'formatted'} = $_;
-	}
-	$qansopt{$_}->{'index'} = $iord++;
-    }
-
-    if ($inptyp eq 'RADIO:h') {
-	my $colspan = scalar(keys(%qansopt))+2;
-	$outline  = "<TABLE cellspacing=10>\n";
-	$outline .= "	<TR><TD colspan=$colspan>";
-	$outline .= "		<TABLE width=100%>\n";
-	$outline .= "			<TR><TD align=left>$question->{'left_be'}</TD>";
-	$outline .= "			<TD align=right>$question->{'right_be'}</TD></TR>\n";
-	$outline .= "		</TABLE>\n";
-	$outline .= "	</TD></TR>\n";
-	$outline .= "	<TR><TD>&nbsp</TD>";
-    }
-    foreach my $qans (@order) {
-	my $optselected = (($options->{'answers'} and $qansopt{$qans}->{'correct'}) ? "CHECKED" : "");
-	if ($inptyp eq 'RADIO') {
-	    $outline .= "<INPUT TYPE=$inptyp NAME=\"$question->{'id'}\" VALUE=\"$qansopt{$qans}->{'index'}\" $optselected>$qansopt{$qans}->{'formatted'}<BR>\n";
-	} elsif ($inptyp eq 'RADIO:h') {
-	    $outline .= "<TD align=center><INPUT TYPE=RADIO NAME=\"$question->{'id'}\" VALUE=\"$qansopt{$qans}->{'index'}\" $optselected></TD>";
-	} else {
-	    my $akey = "$question->{'id'}.$qansopt{$qans}->{'index'}";
-	    $outline .= "<INPUT TYPE=$inptyp NAME=\"$akey\" VALUE=\"$qansopt{$qans}->{'index'}\" $optselected>$qansopt{$qans}->{'formatted'}<BR>\n";
-	}
-    }
-    if ($inptyp eq 'RADIO:h') {
-	$outline .= "<TD>&nbsp</TD></TR>\n";
-	$outline .= "	<TR><TD>&nbsp</TD>";
-	foreach my $qans (@order) {
-	    $outline .= "<TD align=center>$qansopt{$qans}->{'formatted'}</TD>";
-	}
-	$outline .= "<TD>&nbsp</TD></TR>\n";
-	$outline .= "</TABLE>\n";
-    }
-    return $outline."<P>\n";;
-}
-
-sub formatMT {
-    my ($question,$options) = @_;
-    
-    my $outline = "$question->{'qtx'}<p>\n";
-    # Split qia into row and col headers
-    my $qia = $question->{'qia'};
-    $qia =~ s/\r/\n/g;
-    $qia =~ s/\n\n/\n/g;
-    my ($qrowhdr, $qcolhdr) = split(/RC/,$qia);
-    my @qrowhdr = split(/\n/, $qrowhdr);
-    my @qcolhdr = split(/\n/, $qcolhdr);
-
-    #@optvalues = split(/\?/, $_[2]);
-    #shift @optvalues;
-    my @optvalues = ();
-    my $i=0;
-    my @chmatrix;
-    if ($question->{'qtp'} eq 'mtx') {
-	# Mark previous selections with "CHECKED"
-	foreach my $row (0 .. $#qrowhdr) {
-	    foreach my $col (0 .. $#qcolhdr) {
-		if ($optvalues[$i] != "xxx") {
-		    $chmatrix[$row][$col]="CHECKED";
-		} else {
-		    $chmatrix[$row][$col]="";
-		}
-		$i++;
-	    }
-	}
-    } else {
-	# Mark previous selections with "SELECTED"
-	foreach my $row (0 .. $#qrowhdr) {
-	    foreach my $col (0 .. $#qcolhdr) {
-		my $rank = $optvalues[$i];
-		foreach my $irank (0 .. 5) {
-		    if ($irank eq $rank) {
-			$chmatrix[$i][$irank]="SELECTED";
-		    } else {
-			$chmatrix[$i][$irank]="";
-		    }
-		}
-		$i++;
-	    }
-	}
-    }
-
-    # Build matrix html
-    $outline="<table border=2>\n<tr><td>&nbsp;</td>";
-    foreach (0 .. $#qcolhdr) {
-	$outline .= "<td>$qcolhdr[$_]</td>";
-    }
-    $outline .= "</tr>\n";
-    $i=0;
-    foreach my $row (0 .. $#qrowhdr) {
-	$outline .= "<tr><td>$qrowhdr[$row]</td>";
-	foreach my $col (0 .. $#qcolhdr) {
-	    if ($question->{'qtp'} eq 'mtx') {
-		$outline .= "<td align=center><input type=checkbox name=\"qrs$row$col\" value=\"1\" $chmatrix[$row][$col]></td>";
-	    } else {
-		$outline .= "<td align=center><select name=\"qrs$row$col\"><option value='' $chmatrix[$i][0]>\&nbsp\;</option><option value=1 $chmatrix[$i][1]>1</option><option value=2 $chmatrix[$i][2]>2</option><option value=3 $chmatrix[$i][3]>3</option><option value=4 $chmatrix[$i][4]>4</option><option value=5 $chmatrix[$i][5]>5</option></select></td>";
-	    }
-	    $i++;
-	}
-	$outline .= "</tr>\n";
-    }
-    $outline .= "</table>\n";
-    return $outline;
-}
-
-sub get_question_definitions {
-    my ($clid, $testid) = @_;
-    my $qcount = 0;
-    my $questions = [];
-    my @qrecs = &get_question_list($testid, $clid);
-    chomp $qrecs[0];
-    my @flds = split(/&/,shift(@qrecs));
-    foreach my $qrec (@qrecs) {
-	chomp ($qrec);
-	#($id, $qtyp) = split(/&/, $qrec);
-	my @rowdata = split(/&/, $qrec);
-	my $i=0;
-	my $question = {};
-	@{$question}{@flds} = @rowdata;
-	($question->{'subj'},$question->{'skilllevel'}) = split(/\./,$question->{'subj'});
-	$question->{'tf'} = ($question->{'qtp'} eq 'tf') ? "SELECTED" : "";
-	$question->{'mcs'} = ($question->{'qtp'} eq 'mcs') ? "SELECTED" : "";
-	$question->{'mcm'} = ($question->{'qtp'} eq 'mcm') ? "SELECTED" : "";
-	$question->{'esa'} = ($question->{'qtp'} eq 'esa') ? "SELECTED" : "";
-	$question->{'nrt'} = ($question->{'qtp'} eq 'nrt') ? "SELECTED" : "";
-	$question->{'qtx'} =~ s/\;/\n/g;
-	$question->{'qca'} =~ s/\;/\n/g;
-	$question->{'qia'} =~ s/\;/\n/g;
-	
-	$question->{'lbla'} = ($question->{'qalb'} eq 'a') ? "SELECTED" : "";
-	$question->{'lblA'} = ($question->{'qalb'} eq 'A') ? "SELECTED" : "";
-	$question->{'lbln'} = ($question->{'qalb'} eq 'n') ? "SELECTED" : "";
-	$question->{'lblr'} = ($question->{'qalb'} eq 'r') ? "SELECTED" : "";
-	$question->{'lblR'} = ($question->{'qalb'} eq 'R') ? "SELECTED" : "";
-	
-	$question->{'tft'} = ($question->{'qtp'} eq 'tf' && $question->{'qca'} eq 'TRUE') ? "CHECKED" : "";
-	$question->{'tff'} = ($question->{'qtp'} eq 'tf' && $question->{'qca'} eq'FALSE') ? "CHECKED" : "";
-	$question->{'tfy'} = ($question->{'qtp'} eq 'tf' && $question->{'qca'} eq 'YES') ? "CHECKED" : "";
-	$question->{'tfn'} = ($question->{'qtp'} eq 'tf' && $question->{'qca'} eq'NO') ? "CHECKED" : "";
-	
-	$question->{'qim0'} = ($question->{'qim'} eq '0') ? "SELECTED" : "";
-	$question->{'qim1'} = "";
-	$question->{'qim2'} = "";
-	my $illus = join($pathsep, $testgraphic, "$clid.$question->{'id'}");
-	my $supportedmedia = join(';', $SYSTEM{'supportedimagemedia'}, $SYSTEM{'supportedaudiomedia'}, $SYSTEM{'supportedvideomedia'});
-	my $illusfile = &file_exists_with_extension($illus, $supportedmedia);
-	$question->{'illustration'} = "";
-	$question->{'defthumbnail'} = "<IMG NAME=\"qimage\" SRC=\"$graphroot/noimageassigned.gif\" width=100 BORDER=0>";
-	if ($question->{'qim'} eq '1') {
-	    $question->{'qim1'} = "SELECTED";
-	} elsif ($question->{'qim'} eq '2') {
-	    $question->{'qim2'} = "SELECTED";
-	} elsif ($question->{'qim'} eq '3' ) {
-	    $question->{'qim3'} = "SELECTED";
-	    $question->{'illustration'} = "<A NAME=\"qimage\" HREF=\"$question->{'flr'}\" TARGET=\"illustrated\">Reference Page</A>";
-	}
-	if ($illusfile ne '') {
-	    my @filesegs = split(/\./, $illusfile);
-	    my $fext = $filesegs[$#filesegs];
-	    @filesegs = () ;
-	    if ($SYSTEM{'supportedimagemedia'} =~ m/$fext/i ) {
-		if ($question->{'qim'} eq '1') {
-		    $question->{'illustration'} = "<A NAME=\"qimage\" HREF=\"$cgiroot/imagepop.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" TARGET=\"illustrated\">Illustration</A>";
-		    $question->{'defthumbnail'} = "<A NAME=\"qimage\" HREF=\"$cgiroot/imagepop.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" TARGET=\"illustrated\"><IMG NAME=\"qimagetn\" SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" width=100 BORDER=0></A>";
-		} else {
-		    $question->{'illustration'} = "<IMG NAME=\"qimage\" SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" BORDER=0>";
-		    $question->{'defthumbnail'} = "<A NAME=\"qimage\" HREF=\"$cgiroot/imagepop.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" TARGET=\"illustrated\"><IMG NAME=\"qimagetn\" SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" width=100 BORDER=0></A>";
-		}
-	    } elsif ($SYSTEM{'supportedvideomedia'} =~ m/$fext/i ) {
-		$question->{'illustration'} = "<EMBED SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" AUTOSTART=\"TRUE\" LOOP=\"false\" VOLUME=\"100\" CONTROLS=\"console\" HIDDEN=\"false\">";
-	    } elsif ($SYSTEM{'supportedaudiomedia'} =~ m/$fext/i ) {
-		$question->{'illustration'} = "<EMBED SRC=\"$cgiroot/image.pl?tid=$SESSION{'tid'}\&img=$clid.$question->{'id'}.$fext\" AUTOSTART=\"TRUE\" LOOP=\"false\" VOLUME=\"100\" WIDTH=\"100\" HEIGHT=\"50\" CONTROLS=\"small console\" HIDDEN=\"false\">";
-	    }
-	}
-	#if ($question->{'qnxt'} eq '' ) {
-	#$question->{'qnxt'} = ($qcount < $#qrecs) ? $qcount + 1 : $#qrecs;
-	#} else {
-	#if ($question->{'qnxt'} > $#qrecs) {
-	#$question->{'qnxt'} = $#qrecs;
-	#}
-	#}
-	#if ($question->{'qprv'} eq '' ) {
-	#$question->{'qprv'} = ($qcount == 1) ? 1 : $qcount - 1;
-	#} else {
-	#if ($question->{'qprv'} > $#qrecs) {
-	#$question->{'qprv'} = $#qrecs;
-	#}
-	#}
-	$question->{'totdef'} = $#qrecs;
-	$question->{'chkobs'} = ($question->{'qil'} eq 'Y') ? "CHECKED" : "";
-	if ($question->{'qtx'} =~ /:::/) {
-	    ($question->{'qtx'}, $question->{'left_be'}, $question->{'right_be'}) = split(/:::/, $question->{'qtx'});
-	}
-	if ($question->{'layout'} =~ /:/) {
-	    ($question->{'layout'}, $question->{'anslay'}) = split(/:/, $question->{'layout'});
-	    $question->{'anslayhchk'} = ($question->{'anslay'} eq 'h') ? "CHECKED" : "";
-	} else {
-	    $question->{'anslay'} = "";
-	}
-	$question->{'anslayvchk'} = ($question->{'anslay'} ne 'h') ? "CHECKED" : "";
-	$question->{'layout2chk'} = ($question->{'layout'} eq '2') ? "CHECKED" : "";
-	$question->{'layout3chk'} = ($question->{'layout'} eq '3') ? "CHECKED" : "";
-	$question->{'layout4chk'} = ($question->{'layout'} eq '4') ? "CHECKED" : "";
-	$question->{'layout5chk'} = ($question->{'layout'} eq '5') ? "CHECKED" : "";
-	$question->{'layout1chk'} = ($question->{'layout'} eq '1') ? "CHECKED" : "";
-	if ($question->{'layout'} eq '') {
-	    $question->{'layout'} = '1';
-	    $question->{'layout1chk'} = "CHECKED";
-	}
-# sac v start addition for comment input support
-	my @qflags = split(/\./,$question->{'flags'});
-	$question->{'qcmtprmpt'} = $qflags[0];
-	$question->{'chkqccmt'} = ($qflags[0] eq 'Y') ? "CHECKED" : "";
-	$question->{'qcprmpt'} = ($qflags[0] eq 'Y') ? $qflags[1] : "";
-	$question->{'promptcomments'}="";
-	if ($qflags[0] eq 'Y') {
-	    $question->{'promptcomments'}="
-<FONT SIZE=\"4\">\&nbsp;<br>
-<b><i>$qflags[1]</i></b><br>
-<TEXTAREA NAME=\"qcucmt\" cols=\"50\" rows=\"3\"
-	wrap=on onKeyPress=\"languagesupport(this)\"
-	onFocus=\"return tGotFocus(this)\"
-	onChange=\"return onConvert(this)\"></TEXTAREA>
-</FONT><br>\n";
-	    if (($question->{'layout'} eq '4') || ($question->{'layout'} eq '5') || ($question->{'qtyp'} eq 'nrt')) {
-		$question->{'promptcomments'}=join('',"\&nbsp;<br>",$question->{'promptcomments'});
-	    } else {
-		$question->{'promptcomments'}=join('',"<tr><td>",$question->{'promptcomments'},"</td></tr>");
-	    }
-	}
-# sac ^ end addition for comment input support
-	#return;
-	push @$questions, $question;
-    }
-    return $questions;
-}

survey-nginx/cgi-bin/tocrinp.pl.bu20120228

@@ -1,800 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: tocrinp.pl
-#
-# Source File: tocrinp.pl
-
-# Get config
-require 'sitecfg.pl';
-require 'testlib.pl';
-
-print "Content-Type: text/html\n\n";
-
-&app_initialize;
-
-if (&get_session($FORM{'tid'})) {
-	my $show_template = "selectpg";
-	&LanguageSupportInit();
-	$FORM{'respmsg'} = "";
-	if ($FORM{'dbop'} eq 'hc') {
-		# client selection header frame
-		$show_template="tocrclient";
-	} elsif ($FORM{'dbop'} eq 'ht') {
-		# test selection header frame
-		&get_client_profile($FORM{'clid'});
-		$show_template=($FORM{'clid'} eq '') ? "selectpg" : "tocrtest";
-	} elsif ($FORM{'dbop'} eq 'hu') {
-		# candidate selection header frame
-		&get_client_profile($FORM{'clid'});
-		$FORM{'testcandidates'}=&get_test_candidates($FORM{'clid'},$FORM{'tstid'},$FORM{'unscored'},$FORM{'completed'});
-		$FORM{'tccount'}=($FORM{'testcandidates'} eq '') ? 0 : 1;
-		$show_template=($FORM{'tstid'} eq '') ? "selectpg" : "tocrcnd";
-	} elsif ($FORM{'dbop'} eq 'dtl') {
-		if ($FORM{'cndid'} eq '') {
-			$show_template="selectpg";
-		} else {
-			my $dir = ($FORM{'unscored'} eq 'P') ? $testpending : $testcomplete;
-			&get_client_profile($FORM{'clid'});
-			&get_test_profile($FORM{'clid'},$FORM{'tstid'});
-			&get_candidate_profile($FORM{'clid'},$FORM{'cndid'});
-			&get_test_sequence( $CLIENT{'clid'}, $CANDIDATE{'uid'}, $TEST{'id'}, $dir);
-			&CreateOCRInputForm();
-			$show_template="";
-		}
-	} elsif ($FORM{'dbop'} eq 'post') {
-		# test replication detail save
-		if ($FORM{'cndid'} eq '') {
-			$show_template="selectpg";
-		} else {
-			$endtime = &format_date_time("dd-mmm-yyyy hh:nn:ss GMT", "1", "0");
-			my $dir = ($FORM{'unscored'} eq 'P') ? $testpending : $testcomplete;
-			&get_client_profile($FORM{'clid'});
-			&get_test_profile($FORM{'clid'},$FORM{'tstid'});
-			&get_candidate_profile($FORM{'clid'},$FORM{'cndid'});
-			&get_test_sequence( $CLIENT{'clid'}, $CANDIDATE{'uid'}, $TEST{'id'}, $dir);
-			&promote_test_sequence( $testpending, $testinprog, $TEST_STATES{'_PENDING'});
-			$tetmplt = 'tsubend';
-			$tsubtest = 2;
-			$TEST_SESSION{'subtest'} = $FORM{'tstid'};
-			&single_form_test_done($dir);
-			&make_anonymous();
-			$show_template="";
-		}
-	}
-	unless ($show_template eq '') { &show_template($show_template);}
-} else {
-	&show_illegal_access_warning;
-}
-
-sub get_test_candidates {
-	my ($clid,$tstid,$unscoredflag,$completedflag) = @_;
-	my $html="";
-	my @cnds=();
-	my @recs=();
-	my $rec;
-	my $reclid;
-	my $recndid;
-	my $rectst;
-	if ($unscoredflag ne '') {
-		opendir (TMPDIR, "$testpending");
-		@cnds = readdir(TMPDIR);
-		closedir TMPDIR;
-		my @recs=grep( /^$clid\.(.*)\.$tstid/ , @cnds);
-		@cnds=();
-		foreach $rec (@recs) {
-			($reclid,$recndid,$rectst)=&split_test_filename($rec,$clid,$tstid);
-			if (($reclid eq $clid) && ($rectst eq $tstid)) {
-				if (&get_candidate_profile($clid,$recndid)) {
-					$uniquenml = "$CANDIDATE{'nml'}:$CANDIDATE{'uid'}";
-					push(@cndsnml,$uniquenml);
-				}
-			}
-		}
-		@scndsnml = sort(@cndsnml);
-		@cndsnml=();
-		foreach $cnml (@scndsnml) {
-			($trash, $tmpcndid) = split(/:/,$cnml);
-			if (&get_candidate_profile($clid,$tmpcndid)) {
-					$html=join('',$html,"<option value=\"P$CANDIDATE{'uid'}\">$CANDIDATE{'nml'}, $CANDIDATE{'nmf'} $CANDIDATE{'nmm'}\n");
-			}
-		}
-		@scndsnml=();
-		@recs=();
-	}
-	if ($completedflag ne '') {
-		opendir (TMPDIR, "$testcomplete");
-		@cnds = readdir(TMPDIR);
-		closedir TMPDIR;
-		my @recs=grep( /^$clid\.(.*)\.$tstid/ , @cnds);
-		@cnds=();
-		foreach $rec (@recs) {
-			($reclid,$recndid,$rectst)=&split_test_filename($rec,$clid,$tstid);
-			if (($reclid eq $clid) && ($rectst eq $tstid)) {
-				if (&get_candidate_profile($clid,$recndid)) {
-					$uniquenml = "$CANDIDATE{'nml'}:$CANDIDATE{'uid'}";
-					push(@cndsnml,$uniquenml);
-				}
-			}
-		}
-		@scndsnml = sort(@cndsnml);
-		@cndsnml=();
-		foreach $cnml (@scndsnml) {
-			($trash, $tmpcndid) = split(/:/,$cnml);
-			if (&get_candidate_profile($clid,$tmpcndid)) {
-				$html=join('',$html,"<option value=\"C$CANDIDATE{'uid'}\">\*$CANDIDATE{'nml'}, $CANDIDATE{'nmf'} $CANDIDATE{'nmm'}\n");
-			}
-		}
-		@scndsnml=();
-		@recs=();
-	}
-	return $html;
-}
-
-sub CreateOCRInputForm() {
-	if ($TEST{'seq'} eq 'svy') {
-		@skilllevel = ( '','','','' );
-		$itemdescription = "Survey";
-	} else {
-		@skilllevel = ( 'Basic','Intermediate','Advanced','' );
-		$itemdescription = "Test";
-	}
-
-	$oshowqid = ($FORM{'showqid'} ne '') ? 1 : 0;
-	$oshowsubj = ($FORM{'showsubj'} ne '') ? 1 : 0;
-	$oshowskill = ($FORM{'showskill'} ne '') ? 1 : 0;
-	$oblackoutthrowoffs = ($FORM{'blackoutthrowoffs'} ne '') ? 1 : 0;
-	$tcolor=$FORM{'ocrtextcolor'};
-
-	$printwidth = "100\%";
-	$titlewidth = "40\%";
-	$titlecolwidth = "30\%";
-	$refpage = ($FORM{'showgraphics'} eq 'refpage') ? 1 : 0;
-	if ($refpage) {
-		$showgraphics = 1;
-	} else {
-		$showgraphics = ($FORM{'showgraphics'} eq 'ON') ? 1 : 0;
-	}
-
-	$ocrstyle=($FORM{'ocrstyle'} ne '') ? 1 : 0;
-	if ($ocrstyle) {
-		$scoreboxwarning = "MARK THE CIRCLES UNDER THE CORRECT ANSWER LABEL FOR EACH QUESTION USING A \#2 LEAD PENCIL ONLY.";
-	} else {
-		$printscoreboxes = ($FORM{'showscoreboxes'} ne '') ? 1 : 0;
-		$scoreboxwarning = ($printscoreboxes) ? "DO NOT MARK BOXES TO THE RIGHT OF THE QUESTION. (FOR SCORING USE ONLY)" : "";
-	}
-	if ($FORM{'showdates'} ne '') {
-		$testavailabilitydates = "Take On/After:<BR>$TEST{'availon'}<BR>Take On/Before:<BR>$TEST{'availthru'} <BR>\n";
-	} else {
-		$testavailabilitydates = "";
-	}
-	@questions = split(/&/,$SUBTEST_QUESTIONS{2});
-	@keyanswers = split(/&/,$SUBTEST_ANSWERS{2});
-	$masterid = 1;
-
-	$timed = ($TEST{'tmd'} eq 'Y') ? "Allotted Time: $TEST{'maxtm'} mins" : "";
-	$testmasterdir = join($pathsep, $secroot, "tests", "master");
-
-#	$scoreboxwarning = "MARK THE CIRCLES UNDER THE CORRECT ANSWER LABEL FOR EACH QUESTION USING A \#2 LEAD PENCIL ONLY.";
-	$scoreboxwarning = "";
-	$keyhdr = "ANSWER SHEET";
-	&PrintPageHeader();
-	&PrintSectionHeader();
-	&PrintQuestionsOCR();
-	&PrintSection();
-	@pagequestions = ();
-	print "</TABLE>\n";
-	print "<input type=submit name=\"recSave\" value=\"Post Data\"><br>\n";
-	print "$referencepage\n";
-	print "</FORM>\n";
-	print "</BODY>\n</HTML>\n";
-}
-
-sub PrintPageHeader {
-	my $tdate = &format_date_time("mm/dd/yyyy","2", "-10000", time);
-	my $scored = ($FORM{'unscored'} eq 'P') ? $xlatphrase[442] : $xlatphrase[11];
-	if ($FORM{'unscored'} ne 'P') {
-		my $qscore=$SUBTEST_SUMMARY{2}; 
-		my @qscores=split(/&/, $qscore);
-		$qtotal=$qscores[0]+$qscores[1];
-		$scored=join(' ',$scored,"<font size=1>$qscores[2]\% ($qscores[0] of $qtotal)</font>"); 
-	}
-	print "<HTML>
-<HEAD>
-<SCRIPT language=\"JavaScript\">
-<!--
-function onWdwLoad() {
-var hasFocus = null;
-
-	// Determine which form element has focus
-        FlagFocus();
-        
-        document.tocrform.tdate.focus();
-}
-
-function FlagFocus(){
-  for (var x=0; x<document.tocrform.length; ++x) {
-      document.tocrform.elements[x].onfocus = function(){
-        hasFocus = this;
-      }
-  }
-}
-
-function RadioSelect(event) {
-  var charCode = event.keyCode;
-
-  if (hasFocus.type == \"radio\"){
-    if (charCode > 47 && charCode < 58) {
-      if (document.tocrform.elements[hasFocus.name][charCode - 49] != undefined){
-        document.tocrform.elements[hasFocus.name][charCode - 49].checked = true;
-        NextFocus();         
-      }
-    }
-    else if (charCode > 95 && charCode < 106) {
-      if (document.tocrform.elements[hasFocus.name][charCode - 97] != undefined){
-        document.tocrform.elements[hasFocus.name][charCode - 97].checked = true;
-        NextFocus();
-      }
-    }
-    else if (charCode > 64 && charCode < 91) {
-      if (document.tocrform.elements[hasFocus.name][charCode - 65] != undefined){
-        document.tocrform.elements[hasFocus.name][charCode - 65].checked = true;
-        NextFocus();
-      }
-    }
-  }
-}
-
-function NextFocus() {
-  var RadioFound = false
-  
-  for (var x=0; x<document.tocrform.length; ++x) {
-    if (document.tocrform.elements[x].name == hasFocus.name){
-      RadioFound = true;
-    }
-    if ((document.tocrform.elements[x].name != hasFocus.name) && RadioFound) {
-      document.tocrform.elements[x].focus();
-      break;
-    }
-  }
-}
-window.onload=onWdwLoad;
-//-->
-</SCRIPT>
-</HEAD>
-<BODY BACKGROUND=\"$SYSTEM{'BACKGROUND'}\" BGCOLOR=\"$SYSTEM{'BGCOLOR'}\"
-	TEXT=\"$SYSTEM{'TEXT'}\" LINK=\"$SYSTEM{'LINK'}\"
-	VLINK=\"$SYSTEM{'VLINK'}\" ALINK=\"$SYSTEM{'ALINK'}\" onKeyUp=\"RadioSelect(event);\">
-<FORM METHOD=POST ACTION=\"$PATHS{'cgiroot'}/tocrinp.pl\" Name=\"tocrform\">
-<INPUT NAME=\"tid\" TYPE=HIDDEN VALUE=\"$SESSION{'tid'}\">
-<INPUT NAME=\"clid\" TYPE=HIDDEN VALUE=\"$FORM{'clid'}\">
-<INPUT NAME=\"tstid\" TYPE=HIDDEN VALUE=\"$FORM{'tstid'}\">
-<INPUT NAME=\"cndid\" TYPE=HIDDEN VALUE=\"$FORM{'cndid'}\">
-<INPUT NAME=\"unscored\" TYPE=HIDDEN VALUE=\"$FORM{'unscored'}\">
-<INPUT NAME=\"completed\" TYPE=HIDDEN VALUE=\"$FORM{'completed'}\">
-<INPUT NAME=\"lang\" TYPE=HIDDEN VALUE=\"$SESSION{'lang'}\">
-<INPUT NAME=\"dbop\" TYPE=HIDDEN VALUE=\"post\">
-<CENTER>
-<TABLE cellpadding=0 cellspacing=0 border=1 width=$printwidth $bordercolor>
-	<TR>
-		<TD colspan=2 valign=top width=$titlecolwidth>
-			<font size=2 $textcolor><B>
-			Test: $CLIENT{'clid'}.$CANDIDATE{'uid'}.$TEST{'id'}<BR>
-			Questions: $#questions<BR>
-			</B></font>
-		</TD>
-		<TD align=center valign=middle width=$titlewidth>
-			<font size=4 $textcolor><B>$TEST{'desc'}<BR>$keyhdr</B></font>
-		</TD>
-	</TR>
-</TABLE>
-<TABLE cellpadding=0 cellspacing=0 border=0 width=$printwidth $bordercolor>
-	<TR><TD colspan=5><FONT SIZE=1 $textcolor>\&nbsp\;<BR></FONT></TD></TR>
-	<TR>
-		<TD align=right valign=middle>
-			<font $textcolor>
-			<B>Date:\&nbsp\;</B>
-			</font>
-		</TD>
-		<TD valign=middle>
-			<B><input type=textbox name=\"tdate\" value=\"$tdate\" size=10></B>
-		</TD>
-		<TD valign=middle>
-			<B>\&nbsp\;</B><br>
-		</TD>
-		<TD align=right valign=middle>
-			<font $textcolor>
-			<B>Name:\&nbsp\;</B>
-			</font>
-		</TD>
-		<TD valign=middle>
-			<B>$CANDIDATE{'nml'}, $CANDIDATE{'nmf'} $CANDIDATE{'nmm'}</B>
-		</TD>
-	</TR>
-	<TR>
-		<TD valign=middle>
-			<font $textcolor>
-			\&nbsp\;<br>
-			</font>
-		</TD>
-		<TD valign=middle>
-			<font $textcolor>
-			<B>$scored</B>
-			</font>
-		</TD>
-		<TD valign=middle>
-			<font $textcolor>
-			\&nbsp\;<br>
-			</font>
-		</TD>
-		<TD align=right valign=middle>
-			<font $textcolor>
-			<B>Email:\&nbsp\;</B>
-			</font>
-		</TD>
-		<TD align=left valign=middle>
-			<B><input type=textbox name=\"eml\" size=25 value=\"$CANDIDATE{'eml'}\"></B>
-		</TD>
-	</TR>
-</TABLE>
-";
-}
-sub PrintSectionHeader {
-	my $noq=$#questions;
-	@ocrcoltbl0=();
-	@ocrcoltbl1=();
-	@ocrcoltbl2=();
-	$ocrcolumns = int($noq/50);
-	my $vernoq = $ocrcolumns*50;
-	if ($vernoq != $noq) {
-		$ocrcolumns++;
-	}
-	$ocrtblwidth=510/$ocrcolumns;
-	print "<TABLE cellpadding=0 cellspacing=0 border=1 width=$printwidth $bordercolor>\n";
-}
-
-sub PrintSection {
-	my $i;
-	print "<TR>\n<TD>\n";
-	print "<TABLE cellpadding=0 cellspacing=0 border=0 width=$ocrtblwidth $bordercolor>\n";
-	for $i (0 .. $#ocrcoltbl0) {
-		print "$ocrcoltbl0[$i]";
-	}
-	print "</TABLE>\n</TD>\n";
-	if ($ocrcolumns > 1) {
-		print "<TD>\n";
-		print "<TABLE cellpadding=0 cellspacing=0 border=0 width=$ocrtblwidth $bordercolor>\n";
-		for $i (0 .. $#ocrcoltbl1) {
-			print "$ocrcoltbl1[$i]";
-		}
-		print "</TABLE>\n</TD>\n";
-	}
-	if ($ocrcolumns > 2) {
-		print "<TD>\n";
-		print "<TABLE cellpadding=0 cellspacing=0 border=0 width=$ocrtblwidth $bordercolor>\n";
-		for $i (0 .. $#ocrcoltbl2) {
-			print "$ocrcoltbl2[$i]";
-		}
-		print "</TABLE>\n</TD>\n";
-	}
-	print "<\TR>\n";
-}
-
-sub PrintQuestionsOCR() {
-	my $trash;
-	my $r=0;
-	my $c=0;
-	my $rowhtml;
-	my $questionindex;
-	my $backcolor="";
-	$referencepage = "";
-	$allowupdate = 0;
-	$scored = 1;
-	my $prevanswer=$SUBTEST_RESPONSES{2}; 
-	my @prevanswers=split(/&/, $prevanswer);
-	$prevanswer="";
-	my $qscore=$SUBTEST_SUMMARY{2}; 
-	my @qscores=split(/\//, $qscore);
-	$qscore=""; 
-	my $etc = "";
-	foreach $questionindex (1 .. $#questions) {
-		&get_question_definition($TEST{'id'},$CLIENT{'clid'},$questions[$questionindex]);
-		$qtype = $QUESTION{'qtp'};
-		$anstype = $QUESTION{'qalb'};
-		($qsubj, $sklvl) = split(/\./, $QUESTION{'subj'});
-		if ($sklvl eq '') { $sklvl = 3; }
-		($keyresponse,$kflags) = split(/::/, $keyanswers[$questionindex]);
-
-		$scoreable = 1;
-		$credit = $noanswertag;
-		$checked = "";
-		$answerkey = "";
-		$studentkey = "";
-		$qanswermatch = "";
-		@txts = ();
-		$prevanswer = $prevanswers[$questionindex];
-		$prevanswer =~ s/\'//; 
-		if ($qscores[$questionindex] eq '') {
-			$backcolor="";
-		} else {
-			($qscore,$etc) = split(/\./,$qscores[$questionindex]);
-			$backcolor=($qscore == 0) ? "bgcolor=red" : "";
-		}
-
-		if ($qtype eq 'nrt') {
-			&PrintQuestionNRT($TEST{'seq'},$questionindex,$prevanswer);
-		} elsif ($qtype eq 'tf')	{
-			&PrintQuestionTF($TEST{'seq'},$questionindex,$prevanswer);
-		} elsif ($qtype eq 'esa')	{
-			&PrintQuestionESA($TEST{'seq'},$questionindex,$prevanswer);
-		} elsif ($qtype eq 'mcs')	{
-			&PrintQuestionMCS($TEST{'seq'},$questionindex,$prevanswer);
-		} elsif ($qtype eq 'mcm')	{
-			&PrintQuestionMCM($TEST{'seq'},$questionindex,$prevanswer);
-		} elsif ($qtype eq 'mch')	{
-			&PrintQuestionMCH($TEST{'seq'},$questionindex,$prevanswer);
-		} elsif ($qtype eq 'ord')	{
-			&PrintQuestionORD($TEST{'seq'},$questionindex,$prevanswer);
-		} elsif ($qtype eq 'mtx')	{
-			&PrintQuestionMTX($TEST{'seq'},$questionindex,$prevanswer);
-		}
-		$rowhtml = join('',"<TR>","<TD align=center valign=\"top\" width=50 $backcolor><font $textcolor><b>\n");
-		$rowhtml = join('',$rowhtml,"$questionindex.\n");
-		$rowhtml = join('',$rowhtml,"<!-- $keyresponse -->\n");
-		$rowhtml = join('',$rowhtml,"</b></font></TD>\n<TD colspan=2>\n");
-		$rowhtml = join('',$rowhtml,"<TABLE cellpadding=0 cellspacing=0 border=0>\n<TR>\n");
-		$rowhtml = join('',$rowhtml,$answerkey,"</TR>\n</TABLE>\n</TD>\n</TR>\n");
-		$c=int(($questionindex-1) / 50);
-		$r=(($questionindex-1) % 50);
-		if ($c == 0) {
-			push @ocrcoltbl0,$rowhtml;
-		} elsif ($c==1) {
-			push @ocrcoltbl1,$rowhtml;
-		} elsif ($c==2) {
-			push @ocrcoltbl2,$rowhtml;
-		}
-	}		
-}
-
-sub PrintQuestionNRT {
-	my ($ttyp,$qi,$prvresp) = @_;
-	my ($prevans,$prevucmt)=split(/::/,$prvresp);
-	$prevans=unmunge($prevans);
-	$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>\n");
-	$answerkey = join('',$answerkey,"<textarea name=\"q$qi-qrs\" rows=10 cols=60>$prevans</textarea>");
-	$answerkey = join('',$answerkey,"</font></td>\n");
-	$colspan=2;
-}
-
-sub PrintQuestionTF {
-	my ($ttyp,$qi,$prvresp) = @_;
-	my ($prevans,$prevucmt)=split(/::/,$prvresp);
-	$checked=($prevans eq 'TRUE') ? "CHECKED" : "";
-	$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>\n");
-	$answerkey = join('',$answerkey,"T");
-	$answerkey = join('',$answerkey,"\&nbsp;</font></td>\n");
-	$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>\n");
-	$answerkey = join('',$answerkey,"<input type=\"radio\" name=\"q$qi-qrs\" value=\"TRUE\" $checked>");
-	$answerkey = join('',$answerkey,"\&nbsp;</font></td>\n");
-	$checked=($prevans eq 'FALSE') ? "CHECKED" : "";
-	$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>\n");
-	$answerkey = join('',$answerkey,"F");
-	$answerkey = join('',$answerkey,"\&nbsp;</font></td>\n");
-	$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>\n");
-	$answerkey = join('',$answerkey,"<input type=\"radio\" name=\"q$qi-qrs\" value=\"FALSE\" $checked>");
-	$answerkey = join('',$answerkey,"\&nbsp;</font></td>\n");
-	$colspan=2;
-}
-
-sub PrintQuestionESA {
-	my ($ttyp,$qi,$prvresp) = @_;
-	my ($prevans,$prevucmt)=split(/::/,$prvresp);
-	$answerkey = join('',$answerkey,"<td valign=top width=550><font $textcolor>\n");
-	$lenresponse = length($keyresponse) + 4;
-	if ($keyprint == 1) {
-		$answerkey = "<input type=text size=$lenresponse value=\"$keyresponse\">";
-	} else {
-		$answerkey = "<input type=text size=$lenresponse value=\"$prevans\">";
-	}
-	$colspan=2;
-	$answerkey = join('',$answerkey,"</font></td>\n");
-}
-
-sub PrintQuestionMCS {
-	my ($ttyp,$qi,$prvresp) = @_;
-	my ($prevanslong,$prevucmt)=split(/::/,$prvresp);
-	my @prevansary = split(/\?/,$prevanslong);
-	foreach (@prevansary) {
-		if ($_ ne "xxx") {
-			$prevans=$_;
-		}
-	}
-	if ($ttyp eq 'svy') {
-		@txts = ();
-		if ($QUESTION{'qca'} ne '') {
-			push @txts, $QUESTION{'qca'};
-		}
-		@txts_wro = split(/\n/, $QUESTION{'qia'});
-		foreach $qia (@txts_wro) {
-			push @txts, $qia;
-		}
-		@kans  = split(/\?/,$keyresponse);
-		@albls=&set_answer_labels($anstype);
-		foreach $j (1 .. $#kans)	{
-			$jidx = $j-1;
-			@indexs = split(/=/, $kans[$j]);
-			$checked = ("$jidx" eq "$prevans") ? "CHECKED" : "";
-			$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>\n");
-			$answerkey = join('',$answerkey,"<input type=\"radio\" name=\"q$qi-qrs\" value=\"$jidx\" $checked>");
-			$answerkey = join('',$answerkey,"\&nbsp;</font></td>\n");
-			$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>\n");
-			$answerkey = join('',$answerkey,"$albls[$jidx].");
-			$answerkey = join('',$answerkey,"\&nbsp;</font></td>\n");
-		}
-	} else {
-		push @txts, $QUESTION{'qca'};
-		@txts_wro = split(/\n/, $QUESTION{'qia'});
-		foreach $qia (@txts_wro) {
-			push @txts, $qia;
-		}
-		@kans  = split(/\?/,$keyresponse);
-		@albls=&set_answer_labels($anstype);
-		foreach $j (1 .. $#kans)	{
-			$jidx = $j-1;
-			@indexs = split(/=/, $kans[$j]);
-			$checked = ("$jidx" eq "$prevans") ? "CHECKED" : "";
-			$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>");
-			$answerkey = join('',$answerkey,"\&nbsp;$albls[$jidx].");
-			$answerkey = join('',$answerkey,"</font></td>\n<td align=center valign=top width=10><font $textcolor>");
-			$answerkey = join('',$answerkey,"<input type=radio name=\"q$qi-qrs\" value=\"$jidx\" $checked>");
-			$answerkey = join('',$answerkey,"\&nbsp;</font></td>\n");
-		}
-	}
-	$colspan=2;
-}
-
-sub PrintQuestionMCM {
-	my ($ttyp,$qi,$prvresp) = @_;
-	my ($prevans,$prevucmt)=split(/::/,$prvresp);
-	if ($ttyp eq 'svy') {
-		@txts = ();
-		if ($QUESTION{'qca'} ne '') {
-			push @txts, $QUESTION{'qca'};
-		}
-		@txts_wro = split(/\n/, $QUESTION{'qia'});
-		foreach $qia (@txts_wro) {
-			push @txts, $qia;
-		}
-		@kans  = split(/\?/,$keyresponse);
-		@albls=&set_answer_labels($anstype);
-		foreach $j (1 .. $#kans)	{
-			$jidx = $j-1;
-			@indexs = split(/=/, $kans[$j]);
-			$checked = ("$prevans"=~ /$jidx/) ? "CHECKED" : "";
-			$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>\n");
-			$answerkey = join('',$answerkey,"<input type=\"checkbox\" name=\"q$qi-qrs$jidx\" value=\"$jidx\" $checked>");
-			$answerkey = join('',$answerkey,"\&nbsp;</font></td>\n");
-			$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>\n");
-			$answerkey = join('',$answerkey,"$albls[$jidx].");
-			$answerkey = join('',$answerkey,"\&nbsp;</font></td>\n");
-		}
-	} else {
-		push @txts, $QUESTION{'qca'};
-		@txts_wro = split(/\n/, $QUESTION{'qia'});
-		foreach $qia (@txts_wro) {
-			push @txts, $qia;
-		}
-		@kans  = split(/\?/,$keyresponse);
-		@albls=&set_answer_labels($anstype);
-		foreach $j (1 .. $#kans)	{
-			$jidx = $j-1;
-			@indexs = split(/=/, $kans[$j]);
-			$checked = ("$prevans"=~ /$jidx/) ? "CHECKED" : "";
-			$answerkey = join('',$answerkey,"<td align=center valign=top><font $textcolor>");
-			$answerkey = join('',$answerkey,"\&nbsp;$albls[$jidx].");
-			$answerkey = join('',$answerkey,"</font></td>\n<td align=center valign=top width=10><font $textcolor>");
-			$answerkey = join('',$answerkey,"<input type=checkbox name=\"q$qi-qrs$jidx\" value=\"$jidx\" $checked>");
-			$answerkey = join('',$answerkey,"\&nbsp;</font></td>\n");
-		}
-	}
-	$colspan=2;
-}
-
-sub PrintQuestionMCH {
-#&tutor.009
-#&a.4.3.6.5.7.8.0.1.2::MATCH.0:1:1:0
-#&xxxxxxxxx::
-#/0.ghibadcef.xxxxxxxxx
-	my ($ttyp,$qi,$prvresp) = @_;
-	my ($prevans,$prevucmt)=split(/::/,$prvresp);
-	my @prevanss=split(//,$prevans);
-	for (0 .. $#prevanss) {
-		$prevanss[$_] =~ s/x//;
-	}
-	if ($ttyp eq 'svy') {
-		@txts = split(/\n/, $QUESTION{'qca'});
-		@txts_wro = split(/\n/, $QUESTION{'qia'});
-		@ansopts = split(/\./, $keyresponse);
-		$ansopt = shift @ansopts;
-		@albls=&set_answer_labels($anstype);
-		$keyresponse = "";
-		for (0 .. $#ansopts) {
-			$cansord[$ansopts[$_]] = $albls[$_];
-#			$qanswermatch = join('',$qanswermatch, "<I>($cansord[$ansopts[$_]]) $txts_wro[$ansopts[$_]]</I><BR>\n");
-		}
-		foreach $cansord (@cansord) {
-			$keyresponse = join('', $keyresponse, $cansord);
-		}
-		for (0 .. $#ansopts) {
-			$answerkey = join('',$answerkey,"<td valign=top><font $textcolor>\n");
-			if ($keyprint == 1) {
-				$answerkey = join('',$answerkey,"<input type=text name=\"q$qi-qrs$jidx\" size=1 value=\"$cansord[$_]\"><BR>\n");
-			} else {
-				$answerkey = join('',$answerkey,"<input type=text name=\"q$qi-qrs$jidx\" size=1 value=\"$prevanss[$_]\"><BR>\n");
-			}
-			$answerkey = join('',$answerkey,"</font></td>\n");
-		}
-		@cansord = ();
-	} else {
-		@txts = split(/\n/, $QUESTION{'qca'});
-		@txts_wro = split(/\n/, $QUESTION{'qia'});
-		@ansopts = split(/\./, $keyresponse);
-		$trash = shift @ansopts;
-		@albls=&set_answer_labels($anstype);
-		$keyresponse = "";
-		for (0 .. $#ansopts) {
-			$cansord[$ansopts[$_]] = $albls[$_];
-#			$qanswermatch = join('',$qanswermatch, "$cansord[$ansopts[$_]].\&nbsp\;\&nbsp\;$txts_wro[$ansopts[$_]]<BR>\n");
-		}
-		foreach $cansord (@cansord) {
-			$keyresponse = join('', $keyresponse, $cansord);
-		}
-		for (0 .. $#ansopts) {
-			$answerkey = join('',$answerkey,"<td valign=top><font $textcolor>\n");
-			if ($keyprint == 1) {
-				$answerkey = join('',$answerkey,"<input type=text name=\"q$qi-qrs$jidx\" size=2 value=\"$cansord[$_]\"><BR>\n");
-			} else {
-				$answerkey = join('',$answerkey,"<input type=text name=\"q$qi-qrs$jidx\" size=2 value=\"$prevanss[$_]\"><BR>\n");
-			}
-			$answerkey = join('',$answerkey,"</font></td>\n");
-		}
-		@cansord = ();
-	}
-}
-
-sub PrintQuestionORD {
-#&tutor.010
-#&o.3.4.1.0.2::ORDERED.0:1:1:0
-#&xxxxx::
-#/0.45213.xxxxx
-	my ($ttyp,$qi,$prvresp) = @_;
-	my ($prevans,$prevucmt)=split(/::/,$prvresp);
-	my @prevanss=split(//,$prevans);
-	for (0 .. $#prevanss) {
-		$prevanss[$_] =~ s/x//;
-	}
-	if ($ttyp eq 'svy') {
-		@txts = split(/\n/, $QUESTION{'qca'});
-		@ansopts = split(/\./, $keyresponse);
-		$trash = shift @ansopts;
-		@albls=&set_answer_labels($anstype);
-		for (0 .. $#ansopts) {
-			$ansopt = $ansopts[$_];
-			$ansopt++;
-			$answerkey = join('',$answerkey,"<td valign=top><font $textcolor>\n");
-			if ($keyprint == 1) {
-				$answerkey = join('',$answerkey,"<input type=text name=\"q$qi-qrs$jidx\" size=1 value=\"$ansopt\"><BR>\n");
-			} else {
-				$answerkey = join('',$answerkey,"<input type=text name=\"q$qi-qrs$jidx\" size=1 value=\"$prevanss[$_]\"><BR>\n");
-			}
-			$answerkey = join('',$answerkey,"</font></td>\n");
-		}
-	} else {
-		@txts = split(/\n/, $QUESTION{'qca'});
-		@ansopts = split(/\./, $keyresponse);
-		$trash = shift @ansopts;
-		@albls=&set_answer_labels($anstype);
-		for (0 .. $#ansopts) {
-			$ansopt = $ansopts[$_];
-			$ansopt++;
-			$answerkey = join('',$answerkey,"<td valign=top><font $textcolor>\n");
-			if ($keyprint == 1) {
-				$answerkey = join('',$answerkey,"<input type=text name=\"q$qi-qrs$jidx\" size=1 value=\"$ansopt\"><BR>\n");
-			} else {
-				$answerkey = join('',$answerkey,"<input type=text name=\"q$qi-qrs$jidx\" size=1 value=\"$prevanss[$_]\"><BR>\n");
-			}
-			$answerkey = join('',$answerkey,"</font></td>\n");
-		}
-	}
-	$colspan=2;
-}
-
-#PrintQuestionMTX($TEST{'seq'},$questionindex,$prevanswer);
-sub PrintQuestionMTX {
-	my ($ttyp,$qi,$prvresp) = @_;
-	my ($prevanslong,$prevucmt)=split(/::/,$prvresp);
-	my @optvalues = split(/\?/,$prevanslong);
-
-	# Split qia into row and col headers
-	$qia = $QUESTION{'qia'};
-	$qia =~ s/\r/\n/g;
-	$qia =~ s/\n\n/\n/g;
-	@qia = split(/::/, $qia);
-	if ($qia[0] =~ /\n/) {
-		@qrowhdr = split(/\n/, $qia[0]);
-		@qcolhdr = split(/\n/, $qia[3]);
-		$qrowcount = $qia[1];
-		$qcolcount = $qia[2];
-	} else {
-		$qrowcount = $qia[0];
-		$qcolcount = $qia[1];
-		@qlbllist = split(/\n/, $qia[2]);
-	}
-	@qia = ();
-
-	# "CHECKBOX" version
-
-	# Mark previous selections with "CHECKED"
-	shift @optvalues;
-	$i=0;
-	foreach $row (0 .. $qrowcount-1)
-	{
-		foreach $col (0 .. $qcolcount-1)
-		{
-			if ($optvalues[$i] != "xxx")
-			{
-				$chmatrix[$row][$col]="CHECKED";
-			}
-			else
-			{
-				$chmatrix[$row][$col]="";
-			}
-			$i++;
-		}
-	}
-
-	# Build matrix html
-	$outline  = "<td align=center valign=top colspan=2>";
-	$outline .= "<table border=2>\n";
-	if ($#qlbllist == -1) {
-		$outline .= "  <tr>\n  <td>&nbsp;</td>";
-		foreach (0 .. $#qcolhdr) {
-			$outline .= "<td>$qcolhdr[$_]</td>";
-		}
-		$outline .= "</tr>\n";
-	}
-	$i=0;
-	foreach $row (0 .. $qrowcount-1) {
-		$outline .= "<tr>";
-		if ($#qlbllist == -1) {
-			$outline .= "<td>$qrowhdr[$row]</td>";
-		}
-		foreach $col (0 .. $qcolcount-1) {
-			if ($#qlbllist == -1) {
-				$outline .= "<td align=center>";
-			} else {
-				$outline .= "<td>";
-				$outline .= "<table border=0 width=100%><tr><td align=left>$qlbllist[$i]</td><td align=right>";
-			}
-			 if( $ttyp eq 'svy' || ($ttyp eq 'dmg' && $TEST{'group'} eq 'Y')) {
-				$outline .= "<input type=checkbox name=\"q$qi-qrs$row$col\" value=\"1\" $chmatrix[$row][$col]>";
-			} else {
-				$outline .= "<input type=checkbox name=\"qrs$row$col\" value=\"1\" $chmatrix[$row][$col]>";
-			}
-			if ($#qlbllist != -1) {
-				$outline .= "</td></tr></table>";
-			}
-			$outline .= "</td>";
-			$i++;
-		}
-		$outline .= "</tr>\n";
-	}
-	$outline .= "</table>\n";
-	$outline .= "</td>\n";
-	@qrowhdr = ();
-	@qcolhdr = ();
-	@qlbllist = ();
-	@chmatrix = ();
-
-	$answerkey = $outline;
-	$colspan=2;
-}

survey-nginx/cgi-bin/uploadmass.pl.bu20140621

@@ -1,347 +0,0 @@
-#!/usr/bin/perl
-#
-# $Id: uploadmass.pl,v 1.19 2006/09/11 19:17:18 psims Exp $
-#
-# Source File: uploadmass.pl
-
-# Get config
-use Text::ParseWords;
-use CGI qw/:standard/;
-
-require 'sitecfg.pl';
-require 'testlib.pl';
-require	'sbalib.pl';
-
-&app_initialize;
-
-print "Content-Type: text/html\n\n";
-
-if (&get_session($FORM{'tid'})) {
-	&LanguageSupportInit();
-	$n=0;
-	&open_results();
-	#if (defined($UPLOADED_FILES{'subjareas.csv'})) { $n++;upload_subjareas();}
-	#if (defined($UPLOADED_FILES{'tests.csv'})) { $n++;upload_tests();}
-	#if (defined($UPLOADED_FILES{'questions.csv'})) { $n++;upload_questions();}
-	#if (defined($UPLOADED_FILES{'cnds.csv'})) { $n++;upload_users();}
-	#if (defined($UPLOADED_FILES{'groups.csv'})) { $n++;upload_groups();}
-	#if (defined($UPLOADED_FILES{'customfile'})) { $n++;upload_customfile();}
-	$cndsfile = upload('cndsfile');
-	if (defined($cndsfile)) { $n++;upload_users($cndsfile);}
-
-	$testfile = upload('testfile');
-	if (defined($testfile)) { $n++;upload_test($testfile);}
-
-	if ($n==0) {
-		print "<H1>NO UPLOAD FILES PROVIDED. NOTHING IMPORTED.</H1><BR>\n";
-	}
-	&close_results();
-}
-
-sub upload_users {
-	&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "AD/UU");
-	# upload users
-	my $cndsfile = $_[0];
-	print "<H1>Importing USERS:</H1><NOBR><BR>\n";
-
-	@oldrecs = get_data("cnd.$SESSION{'clid'}");
-	$oldrec = $oldrecs[0];
-	$oldrec =~ (s/authtests/createdate/);
-	if ( !($oldrec =~ /createdby/) ) {
-		$oldrec =~ s/grpid/createdby/;
-	}
-	chomp ($oldrec);
-	@curflds = split(/&/, $oldrec);
-	for (0 .. $#curflds) { $RECFLDS{$curflds[$_]} = $_;};
-	$oldkeyidx = $RECFLDS{'uid'};
-	for (1 .. $#oldrecs) {
-		($ukey, $trash) = split(/&/, $oldrecs[$_]);
-		$OLDRECS{$ukey} = $trash;
-	}
-	$oldrechdr = shift @oldrecs;
-	$oldrechdr =~ (s/authtests/createdate/);
-
-	@udata = <$cndsfile>;
-
-	$newrechdr = "$udata[0]\n";
-	@flds = parse_line(',',0,$udata[0]);
-	$flds[$#flds] =~ s/\s+$// ; # HBI - Delete whitespace at the end of the last element.
-	for (0 .. $#flds) { $NEWFLDS{$flds[$_]} = $_;};
-	@flds=();
-	$uididx = $NEWFLDS{'uid'};
-	$nmfidx = $NEWFLDS{'nmf'};
-	$nmmidx = $NEWFLDS{'nmm'};
-	$nmlidx = $NEWFLDS{'nml'};
-	$pwdidx = $NEWFLDS{'pwd'};
-
-	@duprecs = ();
-	@badfmts = ();
-	@illchars = ();
-	@toolongs = ();
-	@sortedrecs = ();
-
-	$DEFAULT_FLDS{'authtests'} = time();	#authtests gets set to createdate in &put_candidate_profile(), but we have to set it here so it gets put in the file, so please don't delete this line
-	$DEFAULT_FLDS{'createdate'} = time();	#This sets createdate for existing cnds. The s/authtests/createdate/ gets done before this
-	$DEFAULT_FLDS{'grpid'} = "";
-	$DEFAULT_FLDS{'createdby'} = "$SESSION{'uid'}";
-	$DEFAULT_FLDS{'cnd1'} = "";
-	$DEFAULT_FLDS{'cnd2'} = "";
-	$DEFAULT_FLDS{'cnd3'} = "";
-	$DEFAULT_FLDS{'cnd4'} = "";
-	$DEFAULT_FLDS{'grpowner'} = "N";
-	my $groups = getGroups($SESSION{'clid'});
-	for (1 .. $#udata) {
-	    chomp($udata[$_]);
-	    $udata[$_] =~ s/\r//g;
-	    $udata[$_] =~ tr/'/\\'/d;
-	    @flds = parse_line(',',0,$udata[$_]);
-			$flds[$#flds] =~ s/\s+$// ; # HBI - Delete whitespace at the end of the last element.
-	    $newkey = $flds[$uididx];
-	    if ((length($flds[$uididx]) > 50) || (length($flds[$uididx]) < 3)) {
-		$badrec = "uid: $udata[$_]\n";
-		push @toolongs, "$badrec";
-		#print STDERR "$udata[$_]\n  (".join('|||',@flds).")\n";
-	    } elsif ((length($flds[$pwdidx]) > 50) || (length($flds[$pwdidx]) < 3)){
-		$badrec = "pwd: $udata[$_]\n";
-		push @toolongs, "$badrec";
-	    #} elsif (length($flds[$NEWFLDS{'sal'}]) > 15){
-	    #	$badrec = "sal: $udata[$_]\n";
-	    #	push @toolongs, "$badrec";
-	    #} elsif ((length($flds[$nmfidx]) > 20) || (length($flds[$nmfidx]) < 1)){
-	    } elsif (length($flds[$nmfidx]) < 1) {
-		$badrec = "nmf: $udata[$_]\n";
-		push @toolongs, "$badrec";
-	    #} elsif (length($flds[$nmmidx]) > 20){
-	    #	$badrec = "nmm: $udata[$_]\n";
-	    #    push @toolongs, "$badrec";
-	    #} elsif ((length($flds[$nmlidx]) > 20) || (length($flds[$nmlidx]) < 1)){
-	    } elsif (length($flds[$nmlidx]) < 1) {
-		$badrec = "nml: $udata[$_]\n";
-		push @toolongs, "$badrec";
-	    #} elsif (length($flds[$NEWFLDS{'adr'}]) > 50){
-	    #	$badrec = "adr: $udata[$_]\n";
-	    #	push @toolongs, "$badrec";
-	    #} elsif (length($flds[$NEWFLDS{'cty'}]) > 25){
-	    #	$badrec = "cty: $udata[$_]\n";
-	    #	push @toolongs, "$badrec";
-	    #} elsif (length($flds[$NEWFLDS{'ste'}]) > 4){
-	    #	$badrec = "ste: $udata[$_]\n";
-	    #	push @toolongs, "$badrec";
-	    #} elsif (length($flds[$NEWFLDS{'pst'}]) > 10){
-	    #	$badrec = "pst: $udata[$_]\n";
-	    #	push @toolongs, "$badrec";
-	    #} elsif (length($flds[$NEWFLDS{'ctry'}]) > 4){
-	    #	$badrec = "ctry: $udata[$_]\n";
-	    #	push @toolongs, "$badrec";
-	    #} elsif (length($flds[$NEWFLDS{'eml'}]) > 100){
-	    #	$badrec = "eml: $udata[$_]\n";
-	    #	push @toolongs, "$badrec";
-	    #} elsif (length($flds[$NEWFLDS{'cnd1'}]) > 16){
-	    #	$badrec = "cnd1: $udata[$_]\n";
-	    #	push @toolongs, "$badrec";
-	    #} elsif (length($flds[$NEWFLDS{'cnd2'}]) > 16){
-	    #	$badrec = "cnd2: $udata[$_]\n";
-	    #	push @toolongs, "$badrec";
-	    #} elsif (length($flds[$NEWFLDS{'grpid'}]) > 100){
-	    #	$badrec = "grpid: $udata[$_]\n";
-	    #	push @toolongs, "$badrec";
-	    } else {
-		# Check for illegal characters
-		$badrec = "";
-		foreach $key (keys %NEWFLDS) {
-		    $trash = $flds[$NEWFLDS{$key}];
-		    if ($key eq "sal") {
-			$trash =~ tr/. //d;
-		    } elsif ($key eq "adr") {
-			$trash =~ tr/\- ,\/.#//d;
-		    } elsif ( ($key eq "nmf") || ($key eq "nml") || ($key eq "cty") || ($key eq "ctry") ) {
-			$trash =~ tr/\- .'//d; 
-		    } elsif ($key eq "nmm") {
-			$trash =~ tr/. //d;
-		    } elsif ($key eq "pst") {
-			$trash =~ tr/\- //d;
-		    } elsif (($key eq "eml") || ($key eq "uid") || ($key eq "pwd")) {
-			$trash =~ tr/\-@.//d;
-		    } elsif ($key eq 'grpid') {
-			$trash =~ tr/:, //d;
-		    } elsif (($key eq "cnd1") || ($key eq "cnd2") || ($key eq "cnd3") || ($key eq "cnd4")) {
-			$trash =~ tr/ //d;
-		    }
-		    if ( $trash =~ /\W/ ) {
-			$badrec = "$key: $udata[$_]\n";
-			#print STDERR "$key ($flds[$NEWFLDS{$key}],$trash)\n";
-			push @illchars, "$badrec";
-		    }
-		}
-		# No illegal chars, so must be good
-		if ($badrec eq "") {
-		    $goodrec = "";
-		    if ($OLDRECS{$newkey} eq '') {
-			for (0 .. $#curflds) {
-			    $delem = "";
-			    $keyword=$curflds[$_];
-			    $jidx = $NEWFLDS{$keyword};
-			    if ($jidx ne '') {
-				$delem = $flds[$jidx];
-			    }
-			    if ($delem eq '') {
-				$delem = $DEFAULT_FLDS{$keyword};
-			    }
-			    if ($goodrec eq '') {
-				$goodrec = $delem;
-			    } else {
-				$goodrec = join('&', $goodrec, $delem);
-			    }
-			}
-			push @oldrecs, "$goodrec\n";
-			my ($ukey, $trash) = split(/&/, $goodrec);
-			$OLDRECS{$ukey} = $trash;
-		    } else {
-			$badrec = "$udata[$_]\n";
-			push @duprecs, "$badrec";
-		    }
-		    if ($flds[$NEWFLDS{'grpid'}]) {
-			# The are default group assignments
-			#print STDERR $flds[$NEWFLDS{'grpid'}]."\n";
-			foreach my $grp (split(/\s*::\s*/,$flds[$NEWFLDS{'grpid'}])) {
-			    if (not exists $groups->{$grp}) {
-				$groups->{$grp}->{'grpowner'} = 'grpadmin';
-				$groups->{$grp}->{'grpid'} = $grp;
-				$groups->{$grp}->{'grpnme'} = $grp;
-				$groups->{$grp}->{'grplist'} = [$flds[$uididx]];
-				$groups->{$grp}->{'validfrom'} = '01-01-2000';
-				$groups->{$grp}->{'validto'} = '12-31-2037';
-			    } else {
-				push @{$groups->{$grp}->{'grplist'}}, $flds[$uididx];
-			    }
-			}
-		    }
-		}
-	    }
-	}
-	@udata = ();
-	unless($#duprecs eq -1) {
-	    # duplicate, but add any groups the user may not already be a memeber of
-	    print "<B>Rejected: Duplicate user</B> (Group memeberships are added, though)<BR>\n";
-	    print "$newrechdr<BR>\n";
-	    for (0 .. $#duprecs) {
-		print "$duprecs[$_]<BR>\n";
-	    }
-	}
-	@duprecs = ();
-	#unless($#badfmts eq -1) {
-		#print "<B>Rejected: Required Element(s) Missing</B><BR>\n";
-		#print "$newrechdr<BR>\n";
-		#for (0 .. $#badfmts) {
-			#print "$badfmts[$_]<BR>\n";
-		#}
-	#}
-	unless($#toolongs eq -1) {
-		print "<B>Rejected: Field Is Wrong Length</B><BR>\n";
-		print "$newrechdr<BR>\n";
-		for (0 .. $#toolongs) {
-			print "$toolongs[$_]<BR>\n";
-		}
-	}
-	unless($#illchars eq -1) {
-		print "<B>Rejected: Illegal Characters</B><BR>\n";
-		print "$newrechdr<BR>\n";
-		for (0 .. $#illchars) {
-			print "$illchars[$_]<BR>\n";
-		}
-	}
-	@badfmts = ();
-	@toolongs = ();
-	@illchars = ();
-	@sortedrecs = sort @oldrecs;
-	@oldrecs=();
-	print "<B>Accepted and Existing:</B><BR>\n";
-	print "$oldrechdr<BR>\n";
- 	$tmpfile = join($pathsep, $dataroot, "cnd.$SESSION{'clid'}");
-	open (TMPFILE, ">$tmpfile") or $msg="failed";
-	print TMPFILE "$oldrechdr";
-	for (0 .. $#sortedrecs) {
-		print TMPFILE "$sortedrecs[$_]";
-		print "$sortedrecs[$_]<BR>\n";
-	};
-	close TMPFILE;
-	if ($groups) {
-	    my @newgrps;
-	    #print STDERR Dumper($groups);
-	    foreach my $grp (sort keys (%$groups)) {
-		push @newgrps, "$grp<br>\n";
-		# make entries unique, and sort for good measure
-		my %tmp = map(($_=>1),@{$groups{$grp}->{'grplist'}});
-		@{$groups{$grp}->{'grplist'}} = keys %tmp;
-	    }
-	    if (&setGroups($SESSION{'clid'},$groups)) {
-		print "<B>Created and Populated Groups:</B><BR>\n@newgrps";
-	    } else {
-		print "<B>***Failed*** to Create and Populate Groups:</B><BR>\n";
-	    }
-	} else {
-	    print "<B>No Groups Defined:</B><BR>\n";
-	}
-	print "</NOBR><BR>\n";
-}
-
-sub upload_groups {
-	&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "AD/UG");
-	# upload groups
-	print "<H1>Importing GROUPS:</H1><BR>\n";
-}
-
-sub upload_test {
-	# upload test file
-	&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "AD/UT");
-	my $testfile = $_[0];
-
-	# some browsers send path info - gotta remove it
-	my $testfilename = param('testfile');
-	$testfilename =~ s/\//;/g;
-	$testfilename =~ s/\\/;/g;
-	@testfilepath = split(/;/, $testfilename);
-	$testfilename = $testfilepath[$#testfilepath];
-
-	# make sure client id is in test file name
-	if ($testfilename =~ /.$SESSION{'clid'}$/ || $testfilename =~ /.$SESSION{'clid'}./) {
-		print "<H1>Importing Test file: $testfilename...</H1><BR>\n";
-		my $writefile = join($pathsep, $questionroot, $testfilename);
-		open (OUTFILE,">$writefile");
-		while (<$testfile>) {
-		   print OUTFILE $_;
-		}
-		close(OUTFILE);
-		print "<H1>Done.</H1><BR>\n";
-	} else {
-		print "<H1>Test file: $testfilename does not contain proper client id \"$SESSION{'clid'}\".</H1><BR>\n";
-	
-	}
-}
-
-sub upload_questions {
-	&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "AD/UQ");
-	# upload questions
-	print "<H1>Importing QUESTIONS:</H1><BR>\n";
-}
-
-sub upload_subjareas {
-	&log_entry($SESSION{'clid'}, $SESSION{'uid'}, "2", "AD/US");
-	# upload subject areas
-	print "<H1>Importing SUBJECT AREAS:</H1><BR>\n";
-
-	
-}
-
-sub open_results {
-	print "<HTML>
-	<BODY>
-";
-}
-
-sub close_results {
-	print "
-	</BODY>
-	</HTML>
-";
-}

survey-nginx/secure_html/log/sess.17215526550866

@@ -1,14 +1,15 @@
-useragent=Mozilla/5.0 (X11; Ubuntu; Linux x86_64; rv:128.0) Gecko/20100101 Firefox/128.0
-referer=https://vote.x4c.network/cgi-bin/visitor.pl
-browserapp=NSNV
-temptime=1721552655
-lastaccess=1721552656
-tid=17215526550866
+browserversion=5
+loggedout=1721553263
+uac=gadmin
 lang=enu
-clid=std
+lastaccess=1721553263
+temptime=1721552655
 loggedin=1721552655
-uid=root1
-home=root
+referer=https://vote.x4c.network/cgi-bin/visitor.pl
+clid=std
+useragent=Mozilla/5.0 (X11; Ubuntu; Linux x86_64; rv:128.0) Gecko/20100101 Firefox/128.0
 ipaddr=49.150.106.90
-browserversion=5
-uac=gadmin
+home=root
+browserapp=NSNV
+uid=root1
+tid=17215526550866

survey-nginx/secure_html/log/std.root1

@@ -17,3 +17,37 @@
 21-Jul-2024 09:04:15.490126 GMT,17215526550866,1
 21-Jul-2024 09:04:16.106463 GMT,17215526550866,2,SA/I
 21-Jul-2024 09:04:16.760684 GMT,17215526550866,2,SA/CM
+21-Jul-2024 09:14:23.668934 GMT,17215526550866,4,LO
+21-Jul-2024 09:14:30.926809 GMT,17215532700102,1
+21-Jul-2024 09:14:31.762662 GMT,17215532700102,2,SA/I
+21-Jul-2024 09:14:32.775107 GMT,17215532700102,2,SA/CM
+21-Jul-2024 09:29:39.5549 GMT,17215532700102,4,LO
+21-Jul-2024 09:29:46.579872 GMT,17215541860404,1
+21-Jul-2024 09:29:47.448383 GMT,17215541860404,2,SA/I
+21-Jul-2024 09:29:48.464566 GMT,17215541860404,2,SA/CM
+21-Jul-2024 09:30:40.698256 GMT,17215541860404,4,LO
+21-Jul-2024 09:30:48.212112 GMT,17215542480037,1
+21-Jul-2024 09:30:49.219737 GMT,17215542480037,2,SA/I
+21-Jul-2024 09:30:50.625271 GMT,17215542480037,2,SA/CM
+21-Jul-2024 09:46:23.653557 GMT,17215551830070,1
+21-Jul-2024 09:46:23.982202 GMT,17215551830070,2,SA/I
+21-Jul-2024 09:46:24.302440 GMT,17215551830070,2,SA/CM
+21-Jul-2024 09:46:55.511050 GMT,17215551830070,2,SA/CM
+21-Jul-2024 09:47:08.596339 GMT,17215551830070,2,SA/CM
+21-Jul-2024 09:47:26.716564 GMT,17215551830070,2,SA/CM
+21-Jul-2024 09:47:30.303055 GMT,17215551830070,2,SA/TM
+21-Jul-2024 09:47:50.944549 GMT,17215551830070,2,Edit Test aircraft
+21-Jul-2024 09:48:10.277500 GMT,17215551830070,2,SA/TO
+21-Jul-2024 09:49:55.139173 GMT,17215551830070,3,Help 0
+21-Jul-2024 09:50:13.620209 GMT,17215551830070,2,SA/TR
+21-Jul-2024 09:50:19.995144 GMT,17215551830070,2,SA/TR
+21-Jul-2024 09:53:21.543264 GMT,17215551830070,2,SA/CM
+21-Jul-2024 09:53:34.506917 GMT,17215551830070,2,Edit Client org.amtda
+21-Jul-2024 09:55:19.585640 GMT,17215551830070,2,SA/CM
+21-Jul-2024 09:57:41.265730 GMT,17215551830070,2,Edit Client smcvt.edu
+21-Jul-2024 10:30:57.196543 GMT,17215542480037,4,LO Forced
+21-Jul-2024 11:47:41.793208 GMT,17215624610775,1
+21-Jul-2024 11:47:42.15396 GMT,17215624610775,2,SA/I
+21-Jul-2024 11:47:45.409677 GMT,17215624610775,2,SA/CM
+21-Jul-2024 11:47:46.533638 GMT,17215624610775,2,SA/CM
+21-Jul-2024 11:48:12.496049 GMT,17215624610775,2,Edit Client smcvt.edu