From d14cf19e9d8a04adc9ad934661c619987c677157 Mon Sep 17 00:00:00 2001
From: Patrick Donelan <pat@patspam.com>
Date: Thu, 28 May 2009 07:23:43 +0000
Subject: [PATCH] Added Survey tests for more question types

---
 lib/WebGUI/Asset/Wobject/Survey.pm            |  31 +---
 .../Asset/Wobject/Survey/ExpressionEngine.pm  |   1 -
 .../Asset/Wobject/Survey/ResponseJSON.pm      |  18 ++-
 t/Asset/Wobject/Survey.t                      |  28 ++--
 t/Asset/Wobject/Survey/ExpressionEngine.t     |   1 -
 t/Asset/Wobject/Survey/ResponseJSON.t         | 137 +++++++++++++++++-
 t/Asset/Wobject/Survey/Test.t                 |  88 +++++------
 7 files changed, 209 insertions(+), 95 deletions(-)

diff --git a/lib/WebGUI/Asset/Wobject/Survey.pm b/lib/WebGUI/Asset/Wobject/Survey.pm
index 2e61cf788..b56e8e86e 100644
--- a/lib/WebGUI/Asset/Wobject/Survey.pm
+++ b/lib/WebGUI/Asset/Wobject/Survey.pm
@@ -385,9 +385,7 @@ sub responseJSON {
     my $self = shift;
     my ($json, $responseId) = validate_pos(@_, { type => SCALAR | UNDEF, optional => 1 }, { type => SCALAR, optional => 1});
     
-    if (!defined $responseId) {
-        $responseId = $self->responseId;
-    }
+    $responseId ||= $self->responseId;
      
     if (!$self->{_responseJSON} || $json) {
 
@@ -769,7 +767,7 @@ sub www_submitObjectEdit {
         return $self->addType($params->{addtype},\@address);        
     }
 
-    # Update the addressed object
+    # Update the addressed object (and have it automatically persisted)
     $self->surveyJSON_update( \@address, $params );
 
     # Return the updated Survey structure
@@ -1853,37 +1851,12 @@ sub persistResponseJSON {
 
 #-------------------------------------------------------------------
 
-=head2 responseIdCookies
-
-Mutator for the responseIdCookies that determines whether cookies are used as
-part of the L<"responseId"> lookup process.
-
-Useful for disabling cookie operations during tests, since WebGUI::Test::getPage
-currently does not support cookies.
-
-=cut
-
-sub responseIdCookies {
-    my $self = shift;
-    my ($x) = validate_pos(@_, {type => SCALAR, optional => 1});
-    
-    if (defined $x) {
-        $self->{_responseIdCookies} = $x;
-    }
-
-    # Defaults to true..
-    return defined $self->{_responseIdCookies} ? $self->{_responseIdCookies} : 1;
-}
-
-#-------------------------------------------------------------------
-
 =head2 responseId( [userId] )
 
 Accessor for the responseId property, which is the unique identifier for a single 
 L<WebGUI::Asset::Wobject::Survey::ResponseJSON> instance. See also L<"responseJSON">.
 
 The responseId of the current user is returned, or created if one does not already exist.
-If the user is anonymous, the IP is used. Or an emailed or linked code can be used.
 
 =head3 userId (optional)
 
diff --git a/lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm b/lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm
index e66966628..a854ebee2 100644
--- a/lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm
+++ b/lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm
@@ -536,7 +536,6 @@ sub run {
             # (re)Instantiate the survey instance using the responseId
             use WebGUI::Asset::Wobject::Survey;
             $asset = WebGUI::Asset::Wobject::Survey->newByResponseId( $session, $mostRecentlyCompletedResponseId );
-            $asset->responseIdCookies(0);
             if ( !$asset ) {
                 $session->log->warn("Unable to instantiate asset by responseId: $mostRecentlyCompletedResponseId");
                 return;
diff --git a/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm b/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm
index 082b5f342..eef81ec7d 100644
--- a/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm
+++ b/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm
@@ -556,18 +556,22 @@ sub recordResponses {
             # Server-side Validation and storing of extra data for special q types goes here
             # Any answer that fails validation should be skipped with 'next'
             
-            
-            if ( $questionType eq 'Number' ) {
+            if ( $questionType eq 'Country' ) {
+                # Must be a valid country
+                next if !grep { $_ eq $recordedAnswer } WebGUI::Form::Country->getCountries;
+            }
+            elsif ( $questionType eq 'Date' ) {
+                # Must be a valid date (until we get date i18n this is limited to YYYY/MM/DD)
+                next if $recordedAnswer !~ m|^\d{4}/\d{2}/\d{2}$|;
+            } 
+            elsif ( $questionType eq 'Number' || $questionType eq 'Slider' ) {
                 if ( $answer->{max} =~ /\d/ and $recordedAnswer > $answer->{max} ) {
                     next;
                 }
                 elsif ( $answer->{min} =~ /\d/ and $recordedAnswer < $answer->{min} ) {
                     next;
                 }
-                elsif ( $answer->{step} =~ /\d/ and $recordedAnswer % $answer->{step} != 0 ) {
-                    next;
-                }
-            }
+            } 
             elsif ( $questionType eq 'Year Month' ) {
                 # store year and month as "YYYY Month"
                 $recordedAnswer = $responses->{ "$aId-year" } . " " . $responses->{ "$aId-month" };
@@ -576,7 +580,7 @@ sub recordResponses {
                 # In the case of a mc question, only selected answers will have a defined recordedAnswer
                 # Thus we skip any answers where recordedAnswer is not defined
                 next if !defined $recordedAnswer || $recordedAnswer !~ /\S/;
-            }
+            } 
 
             # If we reach here, answer validated ok
             $aValid = 1;
diff --git a/t/Asset/Wobject/Survey.t b/t/Asset/Wobject/Survey.t
index 5ce4e0560..f641d877b 100644
--- a/t/Asset/Wobject/Survey.t
+++ b/t/Asset/Wobject/Survey.t
@@ -38,28 +38,31 @@ $import_node = WebGUI::Asset->getImportNode($session);
 $survey = $import_node->addChild( { className => 'WebGUI::Asset::Wobject::Survey', } );
 isa_ok($survey, 'WebGUI::Asset::Wobject::Survey');
 
+my $sJSON = $survey->surveyJSON;
+
 # Load bare-bones survey, containing a single section (S0)
-$survey->surveyJSON_update([0], { variable => 'S0' });
+$sJSON->update([0], { variable => 'S0' });
 
 # Add 2 questions to S0
-$survey->surveyJSON_newObject([0]);    # S0Q0
-$survey->surveyJSON_update([0,0], { variable => 'S0Q0', questionType => 'Yes/No' });
-$survey->surveyJSON_newObject([0]);    # S0Q1
-$survey->surveyJSON_update([0,1], { variable => 'S0Q1', questionType => 'Yes/No' });
+$sJSON->newObject([0]);    # S0Q0
+$sJSON->update([0,0], { variable => 'S0Q0', questionType => 'Yes/No' });
+$sJSON->newObject([0]);    # S0Q1
+$sJSON->update([0,1], { variable => 'S0Q1', questionType => 'Yes/No' });
 
 # Add a new section (S1)
-$survey->surveyJSON_newObject([]);     # S1
-$survey->surveyJSON_update([1], { variable => 'S1' });
+$sJSON->newObject([]);     # S1
+$sJSON->update([1], { variable => 'S1' });
 
 # Add 2 questions to S1
-$survey->surveyJSON_newObject([1]);    # S1Q0
-$survey->surveyJSON_update([1,0], { variable => 'S1Q0' });
-$survey->surveyJSON_newObject([1]);    # S1Q1
-$survey->surveyJSON_update([1,1], { variable => 'S1Q1' });
+$sJSON->newObject([1]);    # S1Q0
+$sJSON->update([1,0], { variable => 'S1Q0' });
+$sJSON->newObject([1]);    # S1Q1
+$sJSON->update([1,1], { variable => 'S1Q1' });
+
+$survey->persistSurveyJSON;
 
 # Now start a response as admin user
 $session->user( { userId =>3 } );
-$survey->responseIdCookies(0);
 
 my $responseId = $survey->responseId;
 my $s = WebGUI::Asset::Wobject::Survey->newByResponseId($session, $responseId);
@@ -73,7 +76,6 @@ $s->surveyEnd();
 # Uncache canTake
 delete $s->{canTake};
 delete $s->{responseId};
-$s->responseIdCookies(0);
 ok(!$s->canTakeSurvey, 'Cannot take survey a second time (maxResponsesPerUser=1)');
 cmp_deeply($s->responseId, undef, '..and similarly cannot get responseId');
 
diff --git a/t/Asset/Wobject/Survey/ExpressionEngine.t b/t/Asset/Wobject/Survey/ExpressionEngine.t
index 239ab6c59..9f1d018f5 100644
--- a/t/Asset/Wobject/Survey/ExpressionEngine.t
+++ b/t/Asset/Wobject/Survey/ExpressionEngine.t
@@ -214,7 +214,6 @@ SKIP: {
     $survey->surveyJSON->answer([0,1,0])->{recordedAnswer} = 'ext_s0q1a0';
     $survey->surveyJSON->answer([0,1,0])->{value} = 50; # worth 50 points
     
-    $survey->responseIdCookies(0);    # disable cookies so that test code doesn't die
     my $responseId = $survey->responseId($user->userId);
     
     my $rJSON = $survey->responseJSON(undef, $responseId);
diff --git a/t/Asset/Wobject/Survey/ResponseJSON.t b/t/Asset/Wobject/Survey/ResponseJSON.t
index 8ac6c8b12..890a7c27b 100644
--- a/t/Asset/Wobject/Survey/ResponseJSON.t
+++ b/t/Asset/Wobject/Survey/ResponseJSON.t
@@ -22,7 +22,7 @@ my $session = WebGUI::Test->session;
 
 #----------------------------------------------------------------------------
 # Tests
-my $tests = 104;
+my $tests = 114;
 plan tests => $tests + 1;
 
 #----------------------------------------------------------------------------
@@ -749,6 +749,106 @@ is($rJSON->pop, undef, 'additional pop has no effect');
 $rJSON = WebGUI::Asset::Wobject::Survey::ResponseJSON->new(buildSurveyJSON($session));
 
 # Use Section 1 (containing 2 questions) for testing. This allows us to test 2 different responses at once.
+########
+# Country
+for my $q (0,1) {
+    $rJSON->survey->updateQuestionAnswers([1,$q], 'Country');
+    $rJSON->survey->answer([1,$q,0])->{recordedAnswer} = '-';
+}
+$rJSON->reset;
+$rJSON->lastResponse(2);
+$rJSON->recordResponses( {
+    '1-0-0' => 'Australia',
+    '1-1-0' => 'JTville',
+});
+cmp_deeply(
+    $rJSON->responses->{'1-0-0'}, 
+    {
+        'verbatim' => undef,
+        'comment' => undef,
+        'time' => num(time(), 3),
+        'value' => 'Australia'
+    }, 
+    'Valid value recorded correctly'
+);
+is($rJSON->responses->{'1-1-0'}, undef, 'Invalid country ignored');
+
+########
+# Date
+for my $q (0,1) {
+    $rJSON->survey->updateQuestionAnswers([1,$q], 'Date');
+    $rJSON->survey->answer([1,$q,0])->{recordedAnswer} = '-';
+}
+$rJSON->reset;
+$rJSON->lastResponse(2);
+$rJSON->recordResponses( {
+    '1-0-0' => '2009/05/01',
+    '1-1-0' => '12345',
+});
+cmp_deeply(
+    $rJSON->responses->{'1-0-0'}, 
+    {
+        'verbatim' => undef,
+        'comment' => undef,
+        'time' => num(time(), 3),
+        'value' => '2009/05/01'
+    }, 
+    'Valid value recorded correctly'
+);
+is($rJSON->responses->{'1-1-0'}, undef, 'Invalid date ignored');
+
+########
+# Number
+for my $q (0,1) {
+    $rJSON->survey->updateQuestionAnswers([1,$q], 'Number');
+    $rJSON->survey->answer([1,$q,0])->{recordedAnswer} = '-';
+    $rJSON->survey->answer([1,$q,0])->{min} = '-5';
+    $rJSON->survey->answer([1,$q,0])->{max} = '10';
+}
+$rJSON->reset;
+$rJSON->lastResponse(2);
+$rJSON->recordResponses( {
+    '1-0-0' => '-3',
+    '1-1-0' => '11',
+});
+cmp_deeply(
+    $rJSON->responses->{'1-0-0'}, 
+    {
+        'verbatim' => undef,
+        'comment' => undef,
+        'time' => num(time(), 3),
+        'value' => '-3'
+    }, 
+    'Valid value recorded correctly'
+);
+is($rJSON->responses->{'1-1-0'}, undef, 'Invalid number ignored');
+
+########
+# Slider
+for my $q (0,1) {
+    $rJSON->survey->updateQuestionAnswers([1,$q], 'Slider');
+    $rJSON->survey->answer([1,$q,0])->{recordedAnswer} = '-';
+    $rJSON->survey->answer([1,$q,0])->{min} = '-5';
+    $rJSON->survey->answer([1,$q,0])->{max} = '10';
+    $rJSON->survey->answer([1,$q,0])->{step} = '1';
+}
+$rJSON->reset;
+$rJSON->lastResponse(2);
+$rJSON->recordResponses( {
+    '1-0-0' => '-3',
+    '1-1-0' => '11',
+});
+cmp_deeply(
+    $rJSON->responses->{'1-0-0'}, 
+    {
+        'verbatim' => undef,
+        'comment' => undef,
+        'time' => num(time(), 3),
+        'value' => '-3'
+    }, 
+    'Valid value recorded correctly'
+);
+is($rJSON->responses->{'1-1-0'}, undef, 'Invalid slider value ignored');
 
 ########
 # Yes/No
@@ -785,6 +885,41 @@ cmp_deeply(
     'No recorded correctly'
 );
 
+########
+# True/False
+$rJSON->survey->updateQuestionAnswers([1,0], 'True/False');
+$rJSON->survey->updateQuestionAnswers([1,1], 'True/False');
+for my $q (0,1) {
+    $rJSON->survey->answer([1,$q,0])->{recordedAnswer} = 'True';
+    $rJSON->survey->answer([1,$q,1])->{recordedAnswer} = 'False';
+}
+$rJSON->reset;
+$rJSON->lastResponse(2);
+$rJSON->recordResponses( {
+    '1-0-0' => 1, # Multi-choice answers are submitted like this, 
+    '1-1-1' => 1, # with the selected answer set to 1
+});
+cmp_deeply(
+    $rJSON->responses->{'1-0-0'}, 
+    {
+        'verbatim' => undef,
+        'comment' => undef,
+        'time' => num(time(), 3),
+        'value' => 'True'
+    }, 
+    'True recorded correctly'
+);
+cmp_deeply(
+    $rJSON->responses->{'1-1-1'}, 
+    {
+        'verbatim' => undef,
+        'comment' => undef,
+        'time' => num(time(), 3),
+        'value' => 'False'
+    }, 
+    'False recorded correctly'
+);
+
 ####################################################
 #
 # logical sections
diff --git a/t/Asset/Wobject/Survey/Test.t b/t/Asset/Wobject/Survey/Test.t
index 545fd9360..6123d5d79 100644
--- a/t/Asset/Wobject/Survey/Test.t
+++ b/t/Asset/Wobject/Survey/Test.t
@@ -37,74 +37,76 @@ my $import_node = WebGUI::Asset->getImportNode($session);
 $s = $import_node->addChild( { className => 'WebGUI::Asset::Wobject::Survey', } );
 isa_ok( $s, 'WebGUI::Asset::Wobject::Survey' );
 
-$s->responseIdCookies(0);
+my $sJSON = $s->surveyJSON;
 
 # N.B. Survey starts off with a single empty section (S0)
 
 # Add some sections and questions
-$s->surveyJSON_newObject( [] ); # S1
-$s->surveyJSON_newObject( [] ); # S2
-$s->surveyJSON_newObject( [] ); # S3
-$s->surveyJSON_newObject( [] ); # S4
-$s->surveyJSON_newObject( [] ); # S5
-$s->surveyJSON_newObject( [] ); # S6
+$sJSON->newObject( [] ); # S1
+$sJSON->newObject( [] ); # S2
+$sJSON->newObject( [] ); # S3
+$sJSON->newObject( [] ); # S4
+$sJSON->newObject( [] ); # S5
+$sJSON->newObject( [] ); # S6
 
 # Name the sections
 for my $sIndex (0..6) {
-    $s->surveyJSON_update( [$sIndex], { variable => "S$sIndex" } );
+    $sJSON->update( [$sIndex], { variable => "S$sIndex" } );
 }
 
 # ..and now some questions
-$s->surveyJSON_newObject( [0] ); # S0Q0
-$s->surveyJSON_newObject( [1] ); # S1Q0
-$s->surveyJSON_newObject( [2] ); # S2Q0
-$s->surveyJSON_newObject( [3] ); # S3Q0
-$s->surveyJSON_newObject( [3] ); # S3Q1
-$s->surveyJSON_newObject( [3] ); # S3Q2
-$s->surveyJSON_newObject( [4] ); # S4Q0
-$s->surveyJSON_newObject( [5] ); # S5Q0
-$s->surveyJSON_newObject( [5] ); # S5Q1
-$s->surveyJSON_newObject( [5] ); # S5Q2
+$sJSON->newObject( [0] ); # S0Q0
+$sJSON->newObject( [1] ); # S1Q0
+$sJSON->newObject( [2] ); # S2Q0
+$sJSON->newObject( [3] ); # S3Q0
+$sJSON->newObject( [3] ); # S3Q1
+$sJSON->newObject( [3] ); # S3Q2
+$sJSON->newObject( [4] ); # S4Q0
+$sJSON->newObject( [5] ); # S5Q0
+$sJSON->newObject( [5] ); # S5Q1
+$sJSON->newObject( [5] ); # S5Q2
 
 # Name the questions
-$s->surveyJSON_update( [ 0, 0 ], { variable => 'S0Q0' } );
-$s->surveyJSON_update( [ 1, 0 ], { variable => 'S1Q0' } );
-$s->surveyJSON_update( [ 2, 0 ], { variable => 'S2Q0' } );
-$s->surveyJSON_update( [ 3, 0 ], { variable => 'S3Q0' } );
-$s->surveyJSON_update( [ 3, 1 ], { variable => 'S3Q1' } );
-$s->surveyJSON_update( [ 3, 2 ], { variable => 'S3Q2' } );
-$s->surveyJSON_update( [ 4, 0 ], { variable => 'S4Q0' } );
-$s->surveyJSON_update( [ 5, 0 ], { variable => 'S5Q0' } );
-$s->surveyJSON_update( [ 5, 1 ], { variable => 'S5Q1' } );
-$s->surveyJSON_update( [ 5, 2 ], { variable => 'S5Q2' } );
+$sJSON->update( [ 0, 0 ], { variable => 'S0Q0' } );
+$sJSON->update( [ 1, 0 ], { variable => 'S1Q0' } );
+$sJSON->update( [ 2, 0 ], { variable => 'S2Q0' } );
+$sJSON->update( [ 3, 0 ], { variable => 'S3Q0' } );
+$sJSON->update( [ 3, 1 ], { variable => 'S3Q1' } );
+$sJSON->update( [ 3, 2 ], { variable => 'S3Q2' } );
+$sJSON->update( [ 4, 0 ], { variable => 'S4Q0' } );
+$sJSON->update( [ 5, 0 ], { variable => 'S5Q0' } );
+$sJSON->update( [ 5, 1 ], { variable => 'S5Q1' } );
+$sJSON->update( [ 5, 2 ], { variable => 'S5Q2' } );
 
 # Set additional options..
-$s->surveyJSON_update( [ 0, 0 ], { questionType => 'Yes/No' } ); # S0Q0 is a Yes/No
-$s->surveyJSON_update( [ 0, 0 ], { gotoExpression => q{ tag('tagged at S0Q0'); } } ); # S0Q0 tagged data
+$sJSON->update( [ 0, 0 ], { questionType => 'Yes/No' } ); # S0Q0 is a Yes/No
+$sJSON->update( [ 0, 0 ], { gotoExpression => q{ tag('tagged at S0Q0'); } } ); # S0Q0 tagged data
 
-$s->surveyJSON_update( [ 1, 0 ], { questionType => 'Yes/No' } ); # S1Q0 is a Yes/No
-$s->surveyJSON_update( [ 1, 0, 0 ], { goto => 'S3', recordedAnswer => q{} } ); # S1Q0 answer 0 jumps to S3 (set recordedAnswer to '' to detect subtle bug)
-$s->surveyJSON_update( [ 1, 0, 1 ], { gotoExpression => q{ tag('tagged at S1Q0', 999); }, recordedAnswer => q{} } );# S1Q0 answer 1 tagged numeric data
+$sJSON->update( [ 1, 0 ], { questionType => 'Yes/No' } ); # S1Q0 is a Yes/No
+$sJSON->update( [ 1, 0, 0 ], { goto => 'S3', recordedAnswer => q{} } ); # S1Q0 answer 0 jumps to S3 (set recordedAnswer to '' to detect subtle bug)
+$sJSON->update( [ 1, 0, 1 ], { gotoExpression => q{ tag('tagged at S1Q0', 999); }, recordedAnswer => q{} } );# S1Q0 answer 1 tagged numeric data
 
-$s->surveyJSON_update( [ 3 ], { gotoExpression => q{ jump { score(S3) == 0 } S5; } } ); # jump to S5 if all 3 questions answered as No
+$sJSON->update( [ 3 ], { gotoExpression => q{ jump { score(S3) == 0 } S5; } } ); # jump to S5 if all 3 questions answered as No
 for my $qIndex (0..2) {
-    $s->surveyJSON_update( [ 3, $qIndex ], { questionType => 'Yes/No', required => 1 } );
-    $s->surveyJSON_update( [ 3, $qIndex, 1 ], { value => 0 } ); # Set 'No' score to 0
+    $sJSON->update( [ 3, $qIndex ], { questionType => 'Yes/No', required => 1 } );
+    $sJSON->update( [ 3, $qIndex, 1 ], { value => 0 } ); # Set 'No' score to 0
 }
 
-$s->surveyJSON_update( [ 4, 0 ], { questionType => 'Concern' } );
+$sJSON->update( [ 4, 0 ], { questionType => 'Concern' } );
 
-$s->surveyJSON_update( [ 5, 0 ], { questionType => 'Slider', required => 1 } );
-$s->surveyJSON_update( [ 5, 1 ], { questionType => 'Text', required => 1 } );
-$s->surveyJSON_update( [ 5, 2 ], { questionType => 'Number', required => 1 } );
+$sJSON->update( [ 5, 0 ], { questionType => 'Slider', required => 1 } );
+$sJSON->update( [ 5, 1 ], { questionType => 'Text', required => 1 } );
+$sJSON->update( [ 5, 2 ], { questionType => 'Number', required => 1 } );
 
-$s->surveyJSON_update( [ 6 ], { logical => 1, gotoExpression => q{tag('tagged at S6');} } );
+$sJSON->update( [ 6 ], { logical => 1, gotoExpression => q{tag('tagged at S6');} } );
 
 # And finally, persist the changes..
 $s->persistSurveyJSON;
 
+my $rJSON = $s->responseJSON;
+
 cmp_deeply(
-    $s->responseJSON->surveyOrder,
+    $rJSON->surveyOrder,
     [   [ 0, 0, [ 0, 1 ] ],    # S0Q0 (surveyOrderIndex: 0)
         [ 1, 0, [ 0, 1 ] ],    # S1Q0 (surveyOrderIndex: 1)
         [ 2, 0, [] ],          # S2Q0 (surveyOrderIndex: 2)
@@ -120,7 +122,7 @@ cmp_deeply(
     'surveyOrder is correct'
 );
 cmp_deeply(
-    $s->responseJSON->surveyOrderIndexByVariableName, 
+    $rJSON->surveyOrderIndexByVariableName, 
     {   
         'S0'   => 0,
         'S0Q0' => 0,