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

#!/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.