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
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.
|
|
|
|
|