From 50091e8e3a0575934799d2049d1714514bf4c022 Mon Sep 17 00:00:00 2001 From: Patrick Donelan Date: Mon, 16 Feb 2009 00:13:58 +0000 Subject: [PATCH] Started working on Survey Multiple Choice bundle management. --- .../Asset/Wobject/Survey/ResponseJSON.pm | 59 +---- lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm | 209 ++++++++---------- t/Asset/Wobject/Survey/ResponseJSON.t | 38 +++- 3 files changed, 139 insertions(+), 167 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm b/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm index d5a305c61..a5f8a2f2d 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm @@ -461,56 +461,12 @@ sub recordResponses { my $self = shift; my ($responses) = validate_pos( @_, { type => HASHREF } ); - my %mcTypes = ( - 'Agree/Disagree' => 1, - Certainty => 1, - Concern => 1, - Confidence => 1, - Education => 1, - Effectiveness => 1, - Gender => 1, - Ideology => 1, - Importance => 1, - Likelihood => 1, - Party => 1, - 'Multiple Choice' => 1, - 'Oppose/Support' => 1, - Race => 1, - Risk => 1, - Satisfaction => 1, - Scale => 1, - Security => 1, - Threat => 1, - 'True/False' => 1, - 'Yes/No' => 1, - ); - my %sliderTypes = ( - 'Dual Slider - Range' => 1, - 'Multi Slider - Allocate' => 1, - Slider => 1, - ); - my %textTypes = ( - Currency => 1, - Email => 1, - 'Phone Number' => 1, - Text => 1, - 'Text Date' => 1, - 'TextArea' => 1, - ); - my %fileTypes = ( - 'File Upload' => 1, - ); - my %dateTypes = ( - Date => 1, - 'Date Range' => 1, - ); - my %hiddenTypes = ( - Hidden => 1, - ); + # Build a lookup table of non-multiple choice question types + my %knownTypes = map {$_ => 1} $self->survey->specialQuestionTypes; # We want to record responses against the "next" response section and questions, since these are # the items that have just been displayed to the user. - my $section = $self->nextResponseSection(); + my $section = $self->nextResponseSection(); my @questions = $self->nextQuestions(); # Handle terminal Section.. @@ -554,11 +510,12 @@ sub recordResponses { # Proceed if we're satisfied that response is valid.. if ( defined $answerValue && $answerValue =~ /\S/ ) { $aAnswered = 1; - if ( exists $mcTypes{ $question->{questionType} } ) { - $self->responses->{ $answer->{id} }->{value} = $answer->{recordedAnswer}; - } - else { + if ($knownTypes{$question->{questionType}}) { $self->responses->{ $answer->{id} }->{value} = $answerValue; + } else { + # Unknown type, must be a multi-choice bundle + # For Multi-choice, use recordedAnswer instead of answerValue + $self->responses->{ $answer->{id} }->{value} = $answer->{recordedAnswer}; } $self->responses->{ $answer->{id} }->{time} = time; $self->responses->{ $answer->{id} }->{comment} = $answerComment; diff --git a/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm b/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm index 3db23b48a..97140d484 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm @@ -59,6 +59,69 @@ use Storable qw/dclone/; # The maximum value of questionsPerPage is currently hardcoded here my $MAX_QUESTIONS_PER_PAGE = 20; +my %MULTI_CHOICE_BUNDLES = ( + 'Agree/Disagree' => [ 'Strongly disagree', (q{}) x 5, 'Strongly agree' ], + Certainty => [ 'Not at all certain', (q{}) x 9, 'Extremely certain' ], + Concern => [ 'Not at all concerned', (q{}) x 9, 'Extremely concerned' ], + Confidence => [ 'Not at all confident', (q{}) x 9, 'Extremely confident' ], + Education => [ + 'Elementary or some high school', + 'High school/GED', + 'Some college/vocational school', + 'College graduate', + 'Some graduate work', + 'Master\'s degree', + 'Doctorate (of any type)', + 'Other degree (verbatim)', + ], + Effectiveness => [ 'Not at all effective', (q{}) x 9, 'Extremely effective' ], + Gender => [qw( Male Female )], + Ideology => [ + 'Strongly liberal', + 'Liberal', + 'Somewhat liberal', + 'Middle of the road', + 'Slightly conservative', + 'Conservative', + 'Strongly conservative' + ], + Importance => [ 'Not at all important', (q{}) x 9, 'Extremely important' ], + Likelihood => [ 'Not at all likely', (q{}) x 9, 'Extremely likely' ], + 'Oppose/Support' => [ 'Strongly oppose', (q{}) x 5, 'Strongly support' ], + Party => + [ 'Democratic party', 'Republican party (or GOP)', 'Independant party', 'Other party (verbatim)' ], + Race => + [ 'American Indian', 'Asian', 'Black', 'Hispanic', 'White non-Hispanic', 'Something else (verbatim)' ], + Risk => [ 'No risk', (q{}) x 9, 'Extreme risk' ], + Satisfaction => [ 'Not at all satisfied', (q{}) x 9, 'Extremely satisfied' ], + Security => [ 'Not at all secure', (q{}) x 9, 'Extremely secure' ], + Threat => [ 'No threat', (q{}) x 9, 'Extreme threat' ], + 'True/False' => [qw( True False )], + 'Yes/No' => [qw( Yes No )], + Scale => [q{}], + 'Multiple Choice' => [q{}], +); + +my @SPECIAL_QUESTION_TYPES = ( + 'Dual Slider - Range', + 'Multi Slider - Allocate', + 'Slider', + 'Currency', + 'Email', + 'Phone Number', + 'Text', + 'Text Date', + 'TextArea', + 'File Upload', + 'Date', + 'Date Range', + 'Hidden', +); + +sub specialQuestionTypes { + return @SPECIAL_QUESTION_TYPES; +} + =head2 new ( $session, json ) Object constructor. @@ -461,24 +524,12 @@ sub getQuestionEditVars { =head2 getValidQuestionTypes -A convenience method. Returns a list of question types. If you add a question -type to the Survey, you must handle it in the following places: here, updateQuestionAnswers, -recordResponses (ResponseJSON) and administersurvey.js +A convenience method. Returns a list of question types. =cut sub getValidQuestionTypes { - return ( - 'Agree/Disagree', 'Certainty', 'Concern', 'Confidence', - 'Currency', 'Date', 'Date Range', 'Dual Slider - Range', - 'Education', 'Effectiveness', 'Email', 'File Upload', - 'Gender', 'Hidden', 'Ideology', 'Importance', - 'Likelihood', 'Multi Slider - Allocate', 'Multiple Choice', 'Oppose/Support', - 'Party', 'Phone Number', 'Race', 'Risk', - 'Satisfaction', 'Scale', 'Security', 'Slider', - 'Text', 'TextArea', 'Text Date', 'Threat', - 'True/False', 'Yes/No' - ); + return sort (@SPECIAL_QUESTION_TYPES, keys %MULTI_CHOICE_BUNDLES); } =head2 getAnswerEditVars ( $address ) @@ -888,9 +939,6 @@ sub updateQuestionAnswers { # Add the default set of answers. The question type determines both the number # of answers added and the answer text to use. When updating answer text # first update $address_copy to point to the answer - - # TODO: Rather than being hard-coded, these question type/answer bundles should - # be loaded dynamically and customizable by the user (see also getValidQuestionTypes) if ( $type eq 'Date Range' or $type eq 'Multi Slider - Allocate' @@ -919,108 +967,41 @@ sub updateQuestionAnswers { $address_copy[2] = 0; $self->update( \@address_copy, { 'text', 'Email:' } ); } - elsif ( $type eq 'Education' ) { - my @ans = ( - 'Elementary or some high school', - 'High school/GED', - 'Some college/vocational school', - 'College graduate', - 'Some graduate work', - 'Master\'s degree', - 'Doctorate (of any type)', - 'Other degree (verbatim)', - ); - $self->addAnswersToQuestion( \@address_copy, \@ans, { 7, 1 } ); - } - elsif ( $type eq 'Party' ) { - my @ans - = ( 'Democratic party', 'Republican party (or GOP)', 'Independant party', 'Other party (verbatim)' ); - $self->addAnswersToQuestion( \@address_copy, \@ans, { 3, 1 } ); - } - elsif ( $type eq 'Race' ) { - my @ans = ( 'American Indian', 'Asian', 'Black', 'Hispanic', 'White non-Hispanic', - 'Something else (verbatim)', ); - $self->addAnswersToQuestion( \@address_copy, \@ans, { 5, 1 } ); - } - elsif ( $type eq 'Ideology' ) { - my @ans = ( - 'Strongly liberal', - 'Liberal', - 'Somewhat liberal', - 'Middle of the road', - 'Slightly conservative', - 'Conservative', - 'Strongly conservative', - ); - $self->addAnswersToQuestion( \@address_copy, \@ans, {} ); - } - elsif ( $type eq 'Security' ) { - my @ans = ( 'Not at all secure', (q{}) x 9, 'Extremely secure', ); - $self->addAnswersToQuestion( \@address_copy, \@ans, {} ); - } - elsif ( $type eq 'Threat' ) { - my @ans = ( 'No threat', (q{}) x 9, 'Extreme threat', ); - $self->addAnswersToQuestion( \@address_copy, \@ans, {} ); - } - elsif ( $type eq 'Risk' ) { - my @ans = ( 'No risk', (q{}) x 9, 'Extreme risk' ); - $self->addAnswersToQuestion( \@address_copy, \@ans, {} ); - } - elsif ( $type eq 'Concern' ) { - my @ans = ( 'Not at all concerned', (q{}) x 9, 'Extremely concerned' ); - $self->addAnswersToQuestion( \@address_copy, \@ans, {} ); - } - elsif ( $type eq 'Effectiveness' ) { - my @ans = ( 'Not at all effective', (q{}) x 9, 'Extremely effective' ); - $self->addAnswersToQuestion( \@address_copy, \@ans, {} ); - } - elsif ( $type eq 'Confidence' ) { - my @ans = ( 'Not at all confident', (q{}) x 9, 'Extremely confident' ); - $self->addAnswersToQuestion( \@address_copy, \@ans, {} ); - } - elsif ( $type eq 'Satisfaction' ) { - my @ans = ( 'Not at all satisfied', (q{}) x 9, 'Extremely satisfied' ); - $self->addAnswersToQuestion( \@address_copy, \@ans, {} ); - } - elsif ( $type eq 'Certainty' ) { - my @ans = ( 'Not at all certain', (q{}) x 9, 'Extremely certain' ); - $self->addAnswersToQuestion( \@address_copy, \@ans, {} ); - } - elsif ( $type eq 'Likelihood' ) { - my @ans = ( 'Not at all likely', (q{}) x 9, 'Extremely likely' ); - $self->addAnswersToQuestion( \@address_copy, \@ans, {} ); - } - elsif ( $type eq 'Importance' ) { - my @ans = ( 'Not at all important', (q{}) x 9, 'Extremely important' ); - $self->addAnswersToQuestion( \@address_copy, \@ans, {} ); - } - elsif ( $type eq 'Oppose/Support' ) { - my @ans = ( 'Strongly oppose', (q{}) x 5, 'Strongly support' ); - $self->addAnswersToQuestion( \@address_copy, \@ans, {} ); - } - elsif ( $type eq 'Agree/Disagree' ) { - my @ans = ( 'Strongly disagree', (q{}) x 5, 'Strongly agree' ); - $self->addAnswersToQuestion( \@address_copy, \@ans, {} ); - } - elsif ( $type eq 'True/False' ) { - my @ans = qw( True False ); - $self->addAnswersToQuestion( \@address_copy, \@ans, {} ); - } - elsif ( $type eq 'Yes/No' ) { - my @ans = qw( Yes No ); - $self->addAnswersToQuestion( \@address_copy, \@ans, {} ); - } - elsif ( $type eq 'Gender' ) { - my @ans = qw( Male Female ); - $self->addAnswersToQuestion( \@address_copy, \@ans, {} ); - } - else { + elsif ( my $answerBundle = $self->getMultiChoiceBundle($type) ) { + # We found a known multi-choice bundle. + + # Mark any answer containing the string "verbatim" as verbatim + my $verbatims = {}; + for my $answerIndex (0 .. $#$answerBundle) { + if ($answerBundle->[$answerIndex] =~ /\(verbatim\)/) { + $verbatims->{$answerIndex} = 1; + } + } + # Add the bundle of multi-choice answers, along with the verbatims hash + $self->addAnswersToQuestion( \@address_copy, $answerBundle, $verbatims ); + } else { + # Default action is to add a single, default answer to the question push @{ $question->{answers} }, $self->newAnswer(); } - + return; } +=head2 getMultiChoiceBundle + +Returns a list of answers for each multi-choice bundle. + +Currently these are hard-coded but soon they will live in the database. + +=cut + +sub getMultiChoiceBundle { + my $self = shift; + my ($type) = validate_pos( @_, { type => SCALAR | UNDEF } ); + + return $MULTI_CHOICE_BUNDLES{$type}; +} + =head2 addAnswersToQuestion ($address, $answers, $verbatims) Helper routine for updateQuestionAnswers. Adds an array of answers to a question. diff --git a/t/Asset/Wobject/Survey/ResponseJSON.t b/t/Asset/Wobject/Survey/ResponseJSON.t index 1e25d7a2e..d278dd9d3 100644 --- a/t/Asset/Wobject/Survey/ResponseJSON.t +++ b/t/Asset/Wobject/Survey/ResponseJSON.t @@ -21,7 +21,7 @@ my $session = WebGUI::Test->session; #---------------------------------------------------------------------------- # Tests -my $tests = 78; +my $tests = 79; plan tests => $tests + 1; #---------------------------------------------------------------------------- @@ -430,6 +430,7 @@ cmp_deeply( [ 1, 'question 1-0 terminal' ], 'recordResponses: question terminal overrides section terminal', ); + is($rJSON->lastResponse(), 4, 'lastResponse advanced to next page of questions'); is($rJSON->questionsAnswered, 1, 'questionsAnswered=1, answered one question'); @@ -442,7 +443,7 @@ cmp_deeply( '1-0-0' => { comment => 'Section 1, question 0, answer 0 comment', 'time' => num(time(), 3), - value => 1, + value => 1, # 'recordedAnswer' value used because question is multi-choice }, '1-1' => { comment => undef, @@ -451,6 +452,36 @@ cmp_deeply( 'recordResponses: recorded responses correctly, two questions, one answer, comments, values and time' ); + +# Repeat with non multi-choice question, to check that submitted answer value is used +# instead of recordedValue +$rJSON->survey->question([1,0])->{questionType} = 'Text'; +$rJSON->lastResponse(2); +$rJSON->questionsAnswered(-1 * $rJSON->questionsAnswered); +$rJSON->recordResponses({ + '1-0comment' => 'Section 1, question 0 comment', + '1-0-0' => 'First answer', + '1-0-0comment' => 'Section 1, question 0, answer 0 comment', +}); +cmp_deeply( + $rJSON->responses, + { + '1-0' => { + comment => 'Section 1, question 0 comment', + }, + '1-0-0' => { + comment => 'Section 1, question 0, answer 0 comment', + 'time' => num(time(), 3), + value => 'First answer', # submitted answer value used this time because non-mc + }, + '1-1' => { + comment => undef, + } + }, + 'recordResponses: recorded responses correctly, two questions, one answer, comments, values and time' +); +$rJSON->survey->question([1,0])->{questionType} = 'Multiple Choice'; # revert change + $rJSON->survey->question([1,0,0])->{terminal} = 1; $rJSON->survey->question([1,0,0])->{terminalUrl} = 'answer 1-0-0 terminal'; $rJSON->responses({}); @@ -480,6 +511,9 @@ cmp_deeply( 'recordResponses: if the answer is all whitespace, it is skipped over' ); is($rJSON->questionsAnswered, 0, 'question was all whitespace, not answered'); +#delete $rJSON->{_session}; +#delete $rJSON->survey->{_session}; +#diag(Dumper($rJSON)); }