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