Refactored ResponseJSON and SurveyJSON
Added Params::Validate to ResponseJSON.pm Refactored ResponseJSON constructor and re-ordered params for consistency Added new ->session accessor Updates tests Removed unnecessary logging methods Further refactored SurveyJSON, gave private variables underscores, replaced direct hash access with accessors
This commit is contained in:
Patrick Donelan
parent
8833459c74
commit
821635eb71
5 changed files with 84 additions and 100 deletions
|
|
@ -1039,7 +1039,7 @@ sub loadResponseJSON {
|
|||
if ( !defined $jsonHash );
|
||||
|
||||
$self->{response}
|
||||
= WebGUI::Asset::Wobject::Survey::ResponseJSON->new( $jsonHash, $self->session->errorHandler, $self->survey );
|
||||
= WebGUI::Asset::Wobject::Survey::ResponseJSON->new( $self->survey, $jsonHash );
|
||||
} ## end sub loadResponseJSON
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -20,60 +20,63 @@ Package WebGUI::Asset::Wobject::Survey::ResponseJSON
|
|||
|
||||
Helper class for WebGUI::Asset::Wobject::Survey. It manages data
|
||||
from the user, sets the order of questions and answers in the survey,
|
||||
based on forks, and gotos, and also handles expiring the survey
|
||||
based on branches, and gotos, and also handles expiring the survey
|
||||
due to time limits.
|
||||
|
||||
This package is not intended to be used by any other Asset in WebGUI.
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
use strict;
|
||||
use JSON;
|
||||
use Data::Dumper;
|
||||
use Params::Validate qw(:all);
|
||||
Params::Validate::validation_options( on_fail => sub { WebGUI::Error::InvalidParam->throw( error => shift ) } );
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 new ( $json, $log, $survey )
|
||||
=head2 new ( $survey, $json )
|
||||
|
||||
Object constructor.
|
||||
|
||||
=head3 $json
|
||||
|
||||
Pass in some JSON to be serialized into a data structure. Useful JSON would
|
||||
contain a hash with "startTime", "surveyOrder", "responses", "lastReponse"
|
||||
and "questionsAnswered" keys, with appropriate values.
|
||||
|
||||
=head3 $log
|
||||
|
||||
The session logger, from $session->log. The class needs nothing else from the
|
||||
session object.
|
||||
|
||||
=head3 $survey
|
||||
|
||||
A WebGUI::Asset::Wobject::Survey::SurveyJSON object that represents the current
|
||||
survey.
|
||||
|
||||
=head3 $json
|
||||
|
||||
A JSON string used to construct a new Perl object. The string should represent
|
||||
a JSON hash made up of "startTime", "surveyOrder", "responses", "lastReponse"
|
||||
and "questionsAnswered" keys, with appropriate values.
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $json = shift;
|
||||
my $log = shift;
|
||||
my $survey = shift;
|
||||
my $temp = from_json($json) if defined $json;
|
||||
my $self = defined $temp ? $temp : {};
|
||||
$self->{survey} = $survey;
|
||||
$self->{log} = $log;
|
||||
$self->{responses} = defined $temp->{responses} ? $temp->{responses} : {};
|
||||
$self->{lastResponse} = defined $temp->{lastResponse} ? $temp->{lastResponse} : -1;
|
||||
$self->{questionsAnswered} = defined $temp->{questionsAnswered} ? $temp->{questionsAnswered} : 0;
|
||||
$self->{startTime} = defined $temp->{startTime} ? $temp->{startTime} : time();
|
||||
#an array of question addresses, with the third member being an array of answers
|
||||
$self->{surveyOrder} = defined $temp->{surveyOrder} ? $temp->{surveyOrder} : [];
|
||||
bless( $self, $class );
|
||||
return $self;
|
||||
} ## end sub new
|
||||
my ($survey, $json) = validate_pos(@_, {isa => 'WebGUI::Asset::Wobject::Survey::SurveyJSON' }, { type => SCALAR, optional => 1});
|
||||
|
||||
# Load json object if given..
|
||||
my $jsonData = $json ? from_json($json) : {};
|
||||
|
||||
# Create skeleton object..
|
||||
my $self = {
|
||||
# First define core members..
|
||||
_survey => $survey,
|
||||
_session => $survey->session,
|
||||
|
||||
# And now object defaults..
|
||||
responses => {},
|
||||
lastResponse => -1,
|
||||
questionsAnswered => 0,
|
||||
startTime => time(),
|
||||
surveyOrder => [],
|
||||
|
||||
# And finally, allow jsonData to override defaults and/or add other members
|
||||
%$jsonData,
|
||||
};
|
||||
|
||||
return bless( $self, $class );
|
||||
}
|
||||
|
||||
#----------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -125,6 +128,19 @@ sub createSurveyOrder {
|
|||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 session
|
||||
|
||||
Accessor method for the local WebGUI::Session reference
|
||||
|
||||
=cut
|
||||
|
||||
sub session {
|
||||
my $self = shift;
|
||||
return $self->{_session};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 shuffle ( @array )
|
||||
|
||||
Returns the contents of @array in a random order.
|
||||
|
|
@ -151,8 +167,8 @@ Serializes the object to JSON, after deleting the log and survey objects stored
|
|||
sub freeze {
|
||||
my $self = shift;
|
||||
my %temp = %{$self};
|
||||
delete $temp{log};
|
||||
delete $temp{survey};
|
||||
delete $temp{_session};
|
||||
delete $temp{_survey};
|
||||
return to_json( \%temp );
|
||||
}
|
||||
|
||||
|
|
@ -573,14 +589,14 @@ sub gotoExpression {
|
|||
|
||||
# (ab)use perl's eval to evaluate the processed expression
|
||||
my $result = eval "$processed->{expression}";
|
||||
$self->warn($@) if $@;
|
||||
$self->session->log->warn($@) if $@;
|
||||
|
||||
if ($result) {
|
||||
$self->debug("Truthy, goto [$processed->{target}]");
|
||||
$self->session->log->debug("Truthy, goto [$processed->{target}]");
|
||||
$self->goto($processed->{target});
|
||||
return $processed;
|
||||
} else {
|
||||
$self->debug("Falsy, not branching");
|
||||
$self->session->log->debug("Falsy, not branching");
|
||||
next;
|
||||
}
|
||||
}
|
||||
|
|
@ -622,22 +638,22 @@ sub processGotoExpression {
|
|||
my $expression = shift;
|
||||
my $responses = shift;
|
||||
|
||||
$self->debug("Processing gotoExpression: $expression");
|
||||
$self->session->log->debug("Processing gotoExpression: $expression");
|
||||
|
||||
# Valid gotoExpression tokens are..
|
||||
my $tokens = qr{\s|[-0-9=!<>+*/.()]};
|
||||
|
||||
my ( $target, $rest ) = $expression =~ /\s* ([^:]+?) \s* : \s* (.*)/x;
|
||||
|
||||
$self->debug("Parsed as Target: [$target], Expression: [$rest]");
|
||||
$self->session->log->debug("Parsed as Target: [$target], Expression: [$rest]");
|
||||
|
||||
if ( !defined $target ) {
|
||||
$self->warn('Target undefined');
|
||||
$self->session->log->warn('Target undefined');
|
||||
return;
|
||||
}
|
||||
|
||||
if ( !defined $rest || $rest eq '' ) {
|
||||
$self->warn('Expression undefined');
|
||||
$self->session->log->warn('Expression undefined');
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -650,11 +666,11 @@ sub processGotoExpression {
|
|||
$rest =~ s/(?<![!<>])=(?!=)/==/g;
|
||||
|
||||
if ( $rest !~ /^$tokens+$/ ) {
|
||||
$self->warn("Contains invalid tokens: $rest");
|
||||
$self->session->log->warn("Contains invalid tokens: $rest");
|
||||
return;
|
||||
}
|
||||
|
||||
$self->debug("Processed as: $rest");
|
||||
$self->session->log->debug("Processed as: $rest");
|
||||
|
||||
return {
|
||||
target => $target,
|
||||
|
|
@ -842,35 +858,7 @@ Note, this is an unsafe reference.
|
|||
|
||||
sub survey {
|
||||
my $self = shift;
|
||||
return $self->{survey};
|
||||
return $self->{_survey};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 log
|
||||
|
||||
Logs an error to the webgui log file, using the session logger.
|
||||
|
||||
=cut
|
||||
|
||||
sub log {
|
||||
my ( $self, $message ) = @_;
|
||||
if ( defined $self->{log} ) {
|
||||
$self->{log}->debug($message);
|
||||
}
|
||||
}
|
||||
|
||||
sub debug {
|
||||
my ( $self, $message) = @_;
|
||||
if ( defined $self->{log} ) {
|
||||
$self->{log}->debug($message);
|
||||
}
|
||||
}
|
||||
|
||||
sub warn {
|
||||
my ( $self, $message) = @_;
|
||||
if ( defined $self->{log} ) {
|
||||
$self->{log}->warn($message);
|
||||
}
|
||||
}
|
||||
1;
|
||||
|
|
|
|||
|
|
@ -78,20 +78,16 @@ sub new {
|
|||
my $class = shift;
|
||||
my ($session, $json) = validate_pos(@_, {isa => 'WebGUI::Session' }, { type => SCALAR, optional => 1});
|
||||
|
||||
# Load json object if given..
|
||||
my $jsonData = $json ? from_json($json) : {};
|
||||
|
||||
# Create skeleton object..
|
||||
my $self = {
|
||||
session => $session,
|
||||
sections => [],
|
||||
survey => {},
|
||||
_session => $session,
|
||||
_sections => $jsonData->{sections} || [],
|
||||
_survey => $jsonData->{survey} || {},
|
||||
};
|
||||
|
||||
# Load json object if given..
|
||||
if ($json) {
|
||||
my $decoded_json = from_json($json);
|
||||
$self->{sections} = $decoded_json->{sections} if defined $decoded_json->{sections};
|
||||
$self->{survey} = $decoded_json->{survey} if defined $decoded_json->{survey};
|
||||
}
|
||||
|
||||
bless( $self, $class );
|
||||
|
||||
# Initialise the survey data structure if empty..
|
||||
|
|
@ -111,8 +107,8 @@ components of this object.
|
|||
sub freeze {
|
||||
my $self = shift;
|
||||
return to_json(
|
||||
{ sections => $self->{sections},
|
||||
survey => $self->{survey},
|
||||
{ sections => $self->sections,
|
||||
survey => $self->{_survey},
|
||||
}
|
||||
);
|
||||
}
|
||||
|
|
@ -293,13 +289,13 @@ sub getObject {
|
|||
return unless $count;
|
||||
|
||||
if ( $count == 1 ) {
|
||||
return dclone $self->{sections}->[ sIndex($address) ];
|
||||
return dclone $self->sections->[ sIndex($address) ];
|
||||
}
|
||||
elsif ( $count == 2 ) {
|
||||
return dclone $self->{sections}->[ sIndex($address) ]->{questions}->[ qIndex($address) ];
|
||||
return dclone $self->sections->[ sIndex($address) ]->{questions}->[ qIndex($address) ];
|
||||
}
|
||||
else {
|
||||
return dclone $self->{sections}->[ sIndex($address) ]->{questions}->[ qIndex($address) ]->{answers}
|
||||
return dclone $self->sections->[ sIndex($address) ]->{questions}->[ qIndex($address) ]->{answers}
|
||||
->[ aIndex($address) ];
|
||||
}
|
||||
}
|
||||
|
|
@ -770,7 +766,7 @@ sub remove {
|
|||
if ( $count == 1 ) {
|
||||
# Make sure the first section isn't removed unless we REALLY want to
|
||||
if ( sIndex($address) != 0 || defined $movingOverride ) {
|
||||
splice( @{ $self->{sections} }, sIndex($address), 1 );
|
||||
splice( @{ $self->sections }, sIndex($address), 1 );
|
||||
}
|
||||
}
|
||||
elsif ( $count == 2 ) {
|
||||
|
|
@ -1077,7 +1073,7 @@ Returns a reference to all the sections in this object.
|
|||
|
||||
sub sections {
|
||||
my $self = shift;
|
||||
return $self->{sections};
|
||||
return $self->{_sections};
|
||||
}
|
||||
|
||||
=head2 totalSections
|
||||
|
|
@ -1157,7 +1153,7 @@ sub section {
|
|||
my $self = shift;
|
||||
my ($address) = validate_pos(@_, { type => ARRAYREF});
|
||||
|
||||
return $self->{sections}->[ $address->[0] ];
|
||||
return $self->sections->[ $address->[0] ];
|
||||
}
|
||||
|
||||
=head2 session
|
||||
|
|
@ -1168,7 +1164,7 @@ Accessor method for the local WebGUI::Session reference
|
|||
|
||||
sub session {
|
||||
my $self = shift;
|
||||
return $self->{session};
|
||||
return $self->{_session};
|
||||
}
|
||||
|
||||
=head2 questions ($address)
|
||||
|
|
@ -1185,7 +1181,7 @@ sub questions {
|
|||
my $self = shift;
|
||||
my ($address) = validate_pos(@_, { type => ARRAYREF});
|
||||
|
||||
return $self->{sections}->[ $address->[0] ]->{questions};
|
||||
return $self->sections->[ $address->[0] ]->{questions};
|
||||
}
|
||||
|
||||
=head2 question ($address)
|
||||
|
|
@ -1202,7 +1198,7 @@ sub question {
|
|||
my $self = shift;
|
||||
my ($address) = validate_pos(@_, { type => ARRAYREF});
|
||||
|
||||
return $self->{sections}->[ $address->[0] ]->{questions}->[ $address->[1] ];
|
||||
return $self->sections->[ $address->[0] ]->{questions}->[ $address->[1] ];
|
||||
}
|
||||
|
||||
=head2 answers ($address)
|
||||
|
|
@ -1219,7 +1215,7 @@ sub answers {
|
|||
my $self = shift;
|
||||
my ($address) = validate_pos(@_, { type => ARRAYREF});
|
||||
|
||||
return $self->{sections}->[ $address->[0] ]->{questions}->[ $address->[1] ]->{answers};
|
||||
return $self->sections->[ $address->[0] ]->{questions}->[ $address->[1] ]->{answers};
|
||||
}
|
||||
|
||||
=head2 answer ($address)
|
||||
|
|
@ -1236,7 +1232,7 @@ sub answer {
|
|||
my $self = shift;
|
||||
my ($address) = validate_pos(@_, { type => ARRAYREF});
|
||||
|
||||
return $self->{sections}->[ $address->[0] ]->{questions}->[ $address->[1] ]->{answers}->[ $address->[2] ];
|
||||
return $self->sections->[ $address->[0] ]->{questions}->[ $address->[1] ]->{answers}->[ $address->[2] ];
|
||||
}
|
||||
|
||||
=head2 sIndex ($address)
|
||||
|
|
|
|||
|
|
@ -40,7 +40,7 @@ skip $tests, "Unable to load ResponseJSON" unless $usedOk;
|
|||
####################################################
|
||||
|
||||
my $newTime = time();
|
||||
$responseJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new('{}', $session->log);
|
||||
$responseJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(buildSurveyJSON($session), '{}');
|
||||
isa_ok($responseJSON , 'WebGUI::Asset::Wobject::Survey::ResponseJSON');
|
||||
|
||||
is($responseJSON->lastResponse(), -1, 'new: default lastResponse is -1');
|
||||
|
|
@ -50,7 +50,7 @@ is_deeply( $responseJSON->responses, {}, 'new: by default, responses is an empty
|
|||
is_deeply( $responseJSON->surveyOrder, [], 'new: by default, responses is an empty arrayref');
|
||||
|
||||
my $now = time();
|
||||
my $rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(qq!{ "startTime": $now }!, $session->log);
|
||||
my $rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(buildSurveyJSON($session), qq!{ "startTime": $now }!);
|
||||
cmp_ok(abs($rJSON->startTime() - $now), '<=', 2, 'new: startTime set using JSON');
|
||||
|
||||
####################################################
|
||||
|
|
@ -85,7 +85,7 @@ ok( ! $rJSON->hasTimedOut(4*60), 'hasTimedOut, limit check');
|
|||
#
|
||||
####################################################
|
||||
|
||||
$rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(q!{}!, $session->log, buildSurveyJSON($session));
|
||||
$rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(buildSurveyJSON($session), q!{}!);
|
||||
|
||||
$rJSON->createSurveyOrder();
|
||||
cmp_deeply(
|
||||
|
|
@ -125,7 +125,7 @@ cmp_deeply(
|
|||
{
|
||||
no strict "refs";
|
||||
no warnings;
|
||||
my $rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(q!{}!, $session->log, buildSurveyJSON($session));
|
||||
my $rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(buildSurveyJSON($session), q!{}!);
|
||||
$rJSON->survey->section([0])->{randomizeQuestions} = 0;
|
||||
my $shuffleName = "WebGUI::Asset::Wobject::Survey::ResponseJSON::shuffle";
|
||||
my $shuffleCalled = 0;
|
||||
|
|
|
|||
|
|
@ -2090,7 +2090,7 @@ isa_ok($surveyJSON->session, 'WebGUI::Session', 'session() accessor works');
|
|||
sub summarizeSectionSkeleton {
|
||||
my ($skeleton) = @_;
|
||||
my $summary = [];
|
||||
foreach my $section (@{ $skeleton->{sections} }) {
|
||||
foreach my $section (@{ $skeleton->{_sections} }) {
|
||||
my $summarySection = {
|
||||
title => $section->{title},
|
||||
questions => [],
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue