You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

287 lines
9.2 KiB

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