From 821635eb71d483548d7c39153a204f3da0fcdd7d Mon Sep 17 00:00:00 2001 From: Patrick Donelan Date: Tue, 3 Feb 2009 08:31:43 +0000 Subject: [PATCH] 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 --- lib/WebGUI/Asset/Wobject/Survey.pm | 2 +- .../Asset/Wobject/Survey/ResponseJSON.pm | 130 ++++++++---------- lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm | 42 +++--- t/Asset/Wobject/Survey/ResponseJSON.t | 8 +- t/Asset/Wobject/Survey/SurveyJSON.t | 2 +- 5 files changed, 84 insertions(+), 100 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Survey.pm b/lib/WebGUI/Asset/Wobject/Survey.pm index 18979ea84..92dfd8fa2 100644 --- a/lib/WebGUI/Asset/Wobject/Survey.pm +++ b/lib/WebGUI/Asset/Wobject/Survey.pm @@ -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 #------------------------------------------------------------------- diff --git a/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm b/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm index 7c16258d1..5f026de59 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm @@ -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; diff --git a/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm b/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm index 1c608a4bb..3153f8835 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm @@ -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) diff --git a/t/Asset/Wobject/Survey/ResponseJSON.t b/t/Asset/Wobject/Survey/ResponseJSON.t index 36c09a743..5469636bc 100644 --- a/t/Asset/Wobject/Survey/ResponseJSON.t +++ b/t/Asset/Wobject/Survey/ResponseJSON.t @@ -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; diff --git a/t/Asset/Wobject/Survey/SurveyJSON.t b/t/Asset/Wobject/Survey/SurveyJSON.t index d6261337f..78a6370c3 100644 --- a/t/Asset/Wobject/Survey/SurveyJSON.t +++ b/t/Asset/Wobject/Survey/SurveyJSON.t @@ -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 => [],