Added Survey back button, with option to turn it on/off, tests, and i18n

Noticed that some Survey tests are broken, will fix tomorrow

docs/changelog/7.x.x.txt

@@ -34,6 +34,7 @@
  - added: ThingyRecord allows you to sell records in a Thingy (like a classified ad)
  - fixed: #10109: Matrix 2.0 - Updates to product listing by maintainer account require admin approval
  - fixed #10146: Thingy duplicate errors
+ - Added Survey back button
 
 7.7.3
  - fixed #10094: double explanation in thread help

docs/upgrades/upgrade_7.7.3-7.7.4.pl

@@ -37,7 +37,7 @@ allMaintenanceSingleton($session);
 unsetPackageFlags($session);
 installThingyRecord( $session );
 installPluggableTax( $session );
-
+addSurveyBackButtonColumn( $session );
 
 finish($session); # this line required
 
@@ -247,6 +247,12 @@ ENDSQL
     print "DONE!\n" unless $quiet;
 }
 
+sub addSurveyBackButtonColumn{
+    my $session = shift;
+    print "\tAdding allowBackBtn column to Survey table... " unless $quiet;
+    $session->db->write("alter table Survey add column `allowBackBtn` TINYINT(3)");
+    print "Done.\n" unless $quiet;
+}
 
 # -------------- DO NOT EDIT BELOW THIS LINE --------------------------------
 

lib/WebGUI/Asset/Wobject/Survey.pm

@@ -197,8 +197,6 @@ sub definition {
             fieldType    => 'workflow',
             label        => 'Survey End Workflow',
             hoverHelp    => 'Workflow to run when user completes the Survey',
-            #            label           => $i18n->get('editForm workflowIdAddEntry label'),
-            #            hoverHelp       => $i18n->get('editForm workflowIdAddEntry description'),
             none => 1,
         },
         quizModeSummary => {
@@ -207,13 +205,16 @@ sub definition {
             tab          => 'properties',
             label        => $i18n->get('Quiz mode summaries'),
             hoverHelp    => $i18n->get('Quiz mode summaries help'),
-        }
+        },
+        allowBackBtn => {
+            fieldType    => 'yesNo',
+            defaultValue => 0,
+            tab          => 'properties',
+            label        => $i18n->get('Allow back button'),
+            hoverHelp    => $i18n->get('Allow back button help'),
+        },
     );
 
-    #my $defaultMC = $session->  
-
-    #%properties = ();
-
     push @{$definition}, {
             assetName         => $i18n->get('assetName'),
             icon              => 'survey.gif',
@@ -1154,6 +1155,41 @@ sub www_submitQuestions {
 
 }
 
+
+#-------------------------------------------------------------------
+
+=head2 www_goBack
+
+Handles the Survey back button
+
+=cut
+
+sub www_goBack {
+    my $self = shift;
+
+    if ( !$self->canTakeSurvey() ) {
+        $self->session->log->debug('canTakeSurvey false, surveyEnd');
+        return $self->surveyEnd();
+    }
+    
+    my $responseId = $self->responseId();
+    if ( !$responseId ) {
+        $self->session->log->debug('No response id, surveyEnd');
+        return $self->surveyEnd();
+    }
+    
+    if ( !$self->get('allowBackBtn') ) {
+        $self->session->log->debug('allowBackBtn false, delegating to www_loadQuestions');
+        return $self->www_loadQuestions();
+    }
+
+    $self->responseJSON->pop;
+    $self->persistResponseJSON;
+
+    return $self->www_loadQuestions();
+
+}
+
 #-------------------------------------------------------------------
 
 =head2 getSummary
@@ -1305,13 +1341,6 @@ Sends the processed template and questions structure to the client
 
 sub prepareShowSurveyTemplate {
     my ( $self, $section, $questions ) = @_;
-#    my %multipleChoice = (
-#        'Multiple Choice', 1, 'Gender',        1, 'Yes/No',     1, 'True/False', 1, 'Ideology',       1,
-#        'Race',            1, 'Party',         1, 'Education',  1, 'Scale',      1, 'Agree/Disagree', 1,
-#        'Oppose/Support',  1, 'Importance',    1, 'Likelihood', 1, 'Certainty',  1, 'Satisfaction',   1,
-#        'Confidence',      1, 'Effectiveness', 1, 'Concern',    1, 'Risk',       1, 'Threat',         1,
-#        'Security',        1
-#    );
     my %textArea    = ( 'TextArea', 1 );
     my %text        = ( 'Text', 1, 'Email', 1, 'Phone Number', 1, 'Text Date', 1, 'Currency', 1, 'Number', 1 );
     my %slider      = ( 'Slider', 1, 'Dual Slider - Range', 1, 'Multi Slider - Allocate', 1 );
@@ -1379,6 +1408,7 @@ sub prepareShowSurveyTemplate {
     if(scalar @{$questions} == ($section->{totalQuestions} - $section->{questionsAnswered})){
         $section->{isLastPage} = 1
     }
+    $section->{allowBackBtn} = $self->get('allowBackBtn');
 
     my $out = $self->processTemplate( $section, $self->get('surveyQuestionsId') );
 

lib/WebGUI/Asset/Wobject/Survey/ExpressionEngine.pm

@@ -54,7 +54,7 @@ sub value {
         if (my $other_instance = $other_instances->{$asset_spec}) {
             my $values = $other_instance->{values};
             my $value  = $values->{$key};
-            $session->log->debug("[$asset_spec, $key] resolves to [$value]");
+            $session->log->debug("value($asset_spec, $key) resolves to [$value]");
             return $value;
         } else {
             # Throw an exception, triggering run() to resolve the external reference and re-run
@@ -63,7 +63,7 @@ sub value {
     }
     my $key   = shift;
     my $value = $values->{$key};
-    $session->log->debug("[$key] resolves to [$value]");
+    $session->log->debug("value($key) resolves to [$value]");
     return $value;    # scalar variable, so no need to clone
 }
 
@@ -85,7 +85,7 @@ sub score {
         if (my $other_instance = $other_instances->{$asset_spec}) {
             my $scores = $other_instance->{scores};
             my $score  = $scores->{$key};
-            $session->log->debug("[$asset_spec, $key] resolves to [$score]");
+            $session->log->debug("score($asset_spec, $key) resolves to [$score]");
             return $score;
         } else {
             # Throw an exception, triggering run() to resolve the external reference and re-run
@@ -94,7 +94,7 @@ sub score {
     }
     my $key   = shift;
     my $score = $scores->{$key};
-    $session->log->debug("[$key] resolves to [$score]");
+    $session->log->debug("score($key) resolves to [$score]");
     return $score;    # scalar variable, so no need to clone
 }
 

lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm

@@ -39,59 +39,6 @@ number of questions answered (L<"questionsAnswered">) and the Survey start time
 
 This package is not intended to be used by any other Asset in WebGUI.
 
-=head2 surveyOrder
-
-This data strucutre is an array (reference) of Survey addresses (see  
-L<WebGUI::Asset::Wobject::Survey::SurveyJSON/Address Parameter>), stored in the order
-in which items are presented to the user.
-
-By making use of L<WebGUI::Asset::Wobject::Survey::SurveyJSON> methods which expect address params as
-arguments, you can access Section/Question/Answer items in order by iterating over surveyOrder.
-
-For example:
-
- # Access sections in order..
- for my $address (@{ $self->surveyOrder }) {
-        my $section  = $self->survey->section( $address );
-        # etc..
- }
-
-In general, the surveyOrder data structure looks like:
-
-    [ $sectionIndex, $questionIndex, [ $answerIndex1, $answerIndex2, ....]
-
-There is one array element for every section and address in the survey. If there are 
-no questions, or no addresses, those array elements will not be present.
-
-=head2 responses
-
-This data structure stores a snapshot of all question responses. Both question data and answer data
-is stored in this hash reference.
-
-Questions keys are constructed by hypenating the relevant L<"sIndex"> and L<"qIndex">.
-Answer keys are constructed by hypenating the relevant L<"sIndex">, L<"qIndex"> and L<aIndex|"aIndexes">.
-
-Question entries only contain a comment field:
- {
-     ...
-     questionId => {
-         comment => "question comment",
-     }
-     ...
- }
-
-Answers entries contain: value (the recorded value), time and comment fields.
-
- {
-     ...
-     answerId => {
-         value   => "recorded answer value",
-         time    => time(),
-         comment => "answer comment",
-    },
-     ...
- }
-
 =cut
 
 use strict;
@@ -252,7 +199,7 @@ sub hasTimedOut{
 
 =head2 lastResponse ([ $responseIndex ])
 
-Mutator. The lastResponse property represents the index of the most recent surveyOrder entry shown. 
+Mutator. The lastResponse property represents the surveyOrder index of the most recent item shown. 
 
 This method returns (and optionally sets) the value of lastResponse.
 
@@ -325,8 +272,29 @@ sub startTime {
 
 =head2 surveyOrder
 
-Accessor for surveyOrder (see L<"surveyOrder">). 
+Accessor. Initialized on first access via L<"initSurveyOrder">.
-Initialized on first access via L<"initSurveyOrder">.
+
+This data strucutre is an array (reference) of Survey addresses (see  
+L<WebGUI::Asset::Wobject::Survey::SurveyJSON/Address Parameter>), stored in the order
+in which items are presented to the user.
+
+In general, the surveyOrder data structure looks like:
+
+    [ $sectionIndex, $questionIndex, [ $answerIndex1, $answerIndex2, ....]
+
+There is one array element for every section and address in the survey. If there are 
+no questions, or no addresses, those array elements will not be present.
+
+By making use of L<WebGUI::Asset::Wobject::Survey::SurveyJSON> methods which expect address params as
+arguments, you can access Section/Question/Answer items in order by iterating over surveyOrder.
+
+For example:
+
+ # Access sections in order..
+ for my $address (@{ $self->surveyOrder }) {
+        my $section  = $self->survey->section( $address );
+        # etc..
+ }
 
 =cut
 
@@ -1242,11 +1210,32 @@ sub response {
     return $self->{_response};
 }
 
+#-------------------------------------------------------------------
+
 =head2 responses
 
-Mutator for the L<"responses"> property. 
+Mutator. Note, this is an unsafe reference.
 
-Note, this is an unsafe reference.
+This data structure stores a snapshot of all question responses. Both question data and answer data
+is stored in this hash reference.
+
+Questions keys are constructed by hypenating the relevant L<"sIndex"> and L<"qIndex">.
+Answer keys are constructed by hypenating the relevant L<"sIndex">, L<"qIndex"> and L<aIndex|"aIndexes">.
+
+ {
+     # Question entries only contain a comment field, e.g.
+     '0-0' => {
+         comment => "question comment",
+     },
+     # ...
+     # Answers entries contain: value (the recorded value), time and comment fields.
+     '0-0-0' => {
+         value   => "recorded answer value",
+         time    => time(),
+         comment => "answer comment",
+    },
+    # ...
+ }
 
 =cut
 
@@ -1259,6 +1248,62 @@ sub responses {
     return $self->response->{responses};
 }
 
+=head2 pop
+
+=cut
+
+sub pop {
+    my $self      = shift;
+    my %responses = %{ $self->responses };
+    
+    # Iterate over responses first time to determine time of most recent response(s)
+    my $lastResponseTime;
+    for my $r ( values %responses ) {
+        if ( $r->{time} ) {
+            $lastResponseTime 
+                = !$lastResponseTime || $r->{time} > $lastResponseTime  
+                ? $r->{time} 
+                : $lastResponseTime
+                ;
+        }
+    }
+    
+    return unless $lastResponseTime;
+    
+    my $popped;
+    my $poppedQuestions;
+    # Iterate again, removing most recent responses
+    while (my ($address, $r) = each %responses ) {
+        if ( $r->{time} == $lastResponseTime) {
+            $popped->{$address} = $r;
+            delete $self->responses->{$address};
+            
+            # Remove associated question/comment entry
+            my ($sIndex, $qIndex, $aIndex) = split /-/, $address;
+            my $qAddress = "$sIndex-$qIndex";
+            $popped->{$qAddress} = $responses{$qAddress};
+            delete $self->responses->{$qAddress};
+            
+            # while we're here, build lookup table of popped question ids
+            $poppedQuestions->{$qAddress} = 1;
+        }
+    }
+    
+    # Now, nextResponse should be set to index of the first popped question we can find in surveyOrder
+    my $nextResponse = 0;
+    for my $address (@{ $self->surveyOrder }) {
+        my $questionId = "$address->[0]-$address->[1]";
+        if ($poppedQuestions->{$questionId} ) {
+            $self->session->log->debug("setting nextResponse to $nextResponse");
+            $self->nextResponse($nextResponse);
+            last;
+        }
+        $nextResponse++;
+    }
+    
+    return $popped;
+}
+
 #-------------------------------------------------------------------
 
 =head2 survey

lib/WebGUI/Help/Asset_Survey.pm

@@ -119,6 +119,8 @@ our $HELP = {
             {   'name'  => 'showProgress' },
             {   'name'  => 'showTimeLimit' },
             {   'name'  => 'minutesLeft' },
+            {   'name'  => 'isLastPage' },
+            {   'name'  => 'allowBackBtn' },
             {   'name'  => 'questions',
                 'variables' => [
                     {   'name' => 'id' },

lib/WebGUI/i18n/English/Asset_Survey.pm

@@ -576,6 +576,16 @@ the time limit for completing the survey. This message is in the 'take survey' t
         message     => q|The template used to display the Survey Edit screen.|,
         lastUpdated => 0,
     },
+    
+    'Allow back button' => {
+        message     => q|Allow back button|,
+        lastUpdated => 0,
+    },
+
+    'Allow back button help' => {
+        message     => q|Allow the user to navigate backwards in a Survey.|,
+        lastUpdated => 0,
+    },
 
     'Max user responses' => {
         message => q|Max user responses|,
@@ -1380,6 +1390,24 @@ section/answer.|,
         context => q|Sub-label for "Year Month" question type|,
         lastUpdated => 0,
     },
+    
+    'back' => {
+        message => q|Back|,
+        context => q|Back button label on Take Survey page|,
+        lastUpdated => 0,
+    },
+    
+    'continue' => {
+        message => q|Continue|,
+        context => q|Continue button label on Take Survey page|,
+        lastUpdated => 0,
+    },
+    
+    'finish' => {
+        message => q|Finish|,
+        context => q|Finish button label on Take Survey page|,
+        lastUpdated => 0,
+    },
 
 };
 

t/Asset/Wobject/Survey/ResponseJSON.t

@@ -22,7 +22,7 @@ my $session = WebGUI::Test->session;
 
 #----------------------------------------------------------------------------
 # Tests
-my $tests = 64;
+my $tests = 74;
 plan tests => $tests + 1;
 
 #----------------------------------------------------------------------------
@@ -561,9 +561,103 @@ 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));
+#
+# pop
+#
+####################################################
+$rJSON->responses({});
+$rJSON->lastResponse(2);
+is($rJSON->pop, undef, 'pop with no responses returns undef');
+cmp_deeply($rJSON->responses, {}, 'initially no responses');
+$rJSON->recordResponses({
+    '1-0comment'   => 'Section 1, question 0 comment',
+    '1-0-0'        => 'First answer',
+    '1-0-0comment' => 'Section 1, question 0, answer 0 comment',
+    '1-1comment'   => 'Section 1, question 1 comment',
+    '1-1-0'        => 'Second answer',
+    '1-1-0comment' => 'Section 1, question 1, answer 0 comment',
+    
+});
+my $popped = $rJSON->pop;
+cmp_deeply($popped, {
+    # the first q answer
+    '1-0-0'        => { 
+        value => 1,
+        comment => 'Section 1, question 0, answer 0 comment',
+        time => num(time(), 3),
+    },
+    # the second q answer
+    '1-1-0'        => { 
+        value => 0,
+        comment => 'Section 1, question 1, answer 0 comment',
+        time => num(time(), 3),
+    },
+    # the first question comment
+    '1-0' => {
+        comment   => 'Section 1, question 0 comment',
+    },
+    # the second question comment
+    '1-1' => {
+        comment   => 'Section 1, question 1 comment',
+    }
+}, 'pop removes only existing response');
+cmp_deeply($rJSON->responses, {}, 'and now back to no responses');
+is($rJSON->pop, undef, 'additional pop has no effect');
+
+$rJSON->responses({});
+$rJSON->lastResponse(2);
+$rJSON->recordResponses({
+    '1-0comment'   => 'Section 1, question 0 comment',
+    '1-0-0'        => 'First answer',
+    '1-0-0comment' => 'Section 1, question 0, answer 0 comment',
+    '1-1comment'   => 'Section 1, question 1 comment',
+    '1-1-0'        => 'Second answer',
+    '1-1-0comment' => 'Section 1, question 1, answer 0 comment',
+});
+
+# fake time so that pop thinks first response happened earlier
+$rJSON->responses->{'1-0-0'}->{time} -= 1;
+cmp_deeply($rJSON->pop, {
+    # the second q answer
+    '1-1-0'        => { 
+        value => 0,
+        comment => 'Section 1, question 1, answer 0 comment',
+        time => num(time(), 3),
+    },
+    # the second question comment
+    '1-1' => {
+        comment   => 'Section 1, question 1 comment',
+    }
+}, 'pop now only removes the most recent response');
+cmp_deeply($rJSON->responses, {
+    # the first q answer
+    '1-0-0'        => { 
+        value => 1,
+        comment => 'Section 1, question 0, answer 0 comment',
+        time => num(time(), 3),
+    },
+    # the first question comment
+    '1-0' => {
+        comment   => 'Section 1, question 0 comment',
+    },
+   }, 'and first response left in tact');
+cmp_deeply($rJSON->pop, {
+    # the first q answer
+    '1-0-0'        => { 
+        value => 1,
+        comment => 'Section 1, question 0, answer 0 comment',
+        time => num(time(), 3),
+    },
+    # the first question comment
+    '1-0' => {
+        comment   => 'Section 1, question 0 comment',
+    },
+}, 'second pop removes first response');
+cmp_deeply($rJSON->responses, {}, '..and now responses hash empty again');
+   
+is($rJSON->pop, undef, 'additional pop has no effect');
 
 }
 

www/extras/wobject/Survey/administersurvey.js

@@ -129,6 +129,11 @@ if (typeof Survey === "undefined") {
         }
     }
     
+    function goBack(event){
+        YAHOO.log("Going back");
+        Survey.Comm.callServer('', 'goBack');
+    }
+    
     //an object which creates sliders for allocation type questions and then manages their events and keeps them from overallocating
     function sliderManager(q, t){
         var total = sliderWidth;
@@ -527,6 +532,7 @@ if (typeof Survey === "undefined") {
                     span.style.display = 'block';
                     
                     document.getElementById('survey-header').appendChild(span);
+                    
                     YAHOO.util.Event.addListener("showQuestionsButton", "click", function(){
                         document.getElementById('showQuestionsButton').style.display = 'none';
                         if (s.everyPageTitle !== '1') {
@@ -696,6 +702,7 @@ if (typeof Survey === "undefined") {
                     butts.push(b);
                 }
             }
+            YAHOO.util.Event.addListener("backbutton", "click", goBack);
             YAHOO.util.Event.addListener("submitbutton", "click", formsubmit);
         }
     };