Survey now shows warnings if bad goto, bad gotoExpressions, no question text, survey looping,

or no question answers are found.

docs/changelog/7.x.x.txt

@@ -17,7 +17,8 @@
    a name different from your current method, you'll need to specify the parent/super
    module name explicity (e.g.  ->WebGUI::Asset::Wobject::canEdit()).  You'll also
    need to implement the getRssFeedItems method as explained in AssetAspect/RssFeed.pm
-
+ - Survey now shows warnings if bad goto, bad gotoExpressions, no question text, survey looping,
+   or no question answers are found.
 7.7.1
  - the AdSku project: create a Sku that allows buyers to purchase advertising in select AdSpaces at selected priorities
  - rfe #9353: Welcome message template (SDH Consulting Group)

lib/WebGUI/Asset/Wobject/Survey.pm

@@ -734,8 +734,8 @@ sub www_loadSurvey {
     }
 
     # Generate the list of valid goto targets
-    my @gotoTargets = $self->surveyJSON->getGotoTargets;
-
+    my $gotoTargets = $self->surveyJSON->getGotoTargets;
+    
     my %buttons;
     $buttons{question} = $address->[0];
     if ( @{$address} == 2 or @{$address} == 3 ) {
@@ -782,7 +782,9 @@ sub www_loadSurvey {
             $lastType = 'answer';
         }
     }
-
+    
+    my $warnings = $self->surveyJSON->validateSurvey();
+    
     my $return = {
         address  => $address,                    # the address of the focused object
         buttons  => \%buttons,                   # the data to create the Add buttons
@@ -790,7 +792,8 @@ sub www_loadSurvey {
         ddhtml   => $html,                       # the html to create the draggable html divs
         ids      => \@ids,                       # list of all ids passed in which are draggable (for adding events)
         type     => $var->{type},                # the object type
-        gotoTargets => \@gotoTargets,
+        gotoTargets => $gotoTargets,
+        warnings => $warnings                    #List of warnings to display to the user
     };
 
     $self->session->http->setMimeType('application/json');

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

@@ -48,6 +48,7 @@ likely operate on the question indexed by:
 
 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 ) } );
 
@@ -416,12 +417,14 @@ sub getGotoTargets {
 
     # Valid goto targets are all of the section variable names..
     my @section_vars = map {$_->{variable}} @{$self->sections};
-
+    
     # ..and all of the question variable names..
     my @question_vars = map {$_->{variable}} @{$self->questions};
-
+    
     # ..excluding the ones that are empty
-    return grep { $_ ne q{} } (@section_vars, @question_vars);
+    my @grep =  grep { $_ ne q{} } (@section_vars, @question_vars);
+    return \@grep;
+    #return grep { $_ ne q{} } (@section_vars, @question_vars);
 }
 
 =head2 getSectionEditVars ( $address )
@@ -1189,6 +1192,106 @@ sub totalAnswers {
     }
 }
 
+=head2 validateSurvey ()
+
+Returns an array of messages to inform a user what is logically wrong with the Survey
+
+=cut
+
+sub validateSurvey{
+    my $self = shift;
+    #check all goto's
+    #bad goto expressions
+    #check that all survey is able to be seen
+
+    my @messages;   
+   
+    #set up valid goto targets 
+    my $gotoTargets = $self->getGotoTargets();
+    my $goodTargets;
+    for my $g(@$gotoTargets){ $$goodTargets{$g} = 1; } 
+
+    #step through each section validating it. 
+    my $sections = $self->sections();
+    for(my $s = 0; $s <= $#$sections; $s++){
+        my $section = $self->section([$s]);
+        if(! $self->validateGoto($section,$goodTargets)){
+            push(@messages,"Section $s does not have a valid GOTO target.");
+        }
+        if(! $self->validateGotoExpression($section,$goodTargets)){
+            push(@messages,"Section $s does not have a valid GOTO Expression target.");
+        }
+        if(! $self->validateInfLoop($section)){
+            push(@messages,"Section $s jumps to itself.");
+        }
+
+        #step through each question validating it. 
+        my $questions = $self->questions([$s]);
+        for(my $q = 0; $q <= $#$questions; $q++){
+            my $question = $self->question([$s,$q]);
+            if(! $self->validateGoto($question,$goodTargets)){
+                push(@messages,"Section $s Question $q does not have a valid GOTO target.");
+            }
+            if(! $self->validateGotoExpression($question,$goodTargets)){
+                push(@messages,"Section $s Question $q does not have a valid GOTO Expression target.");
+            }
+            if($#{$question->{answers}} < 0){
+                push(@messages,"Section $s Question $q does not have any answers.");
+            }
+            if(! $question->{text} =~ /\w/){
+                push(@messages,"Section $s Question $q does not have any text.");
+            }
+            if(! $self->validateInfLoop($question)){
+                push(@messages,"Section $s Question $q jumps to itself.");
+            }
+            
+            #step through each answer validating it. 
+            my $answers = $self->answers([$s,$q]);
+            for(my $a = 0; $a <= $#$answers; $a++){
+                my $answer = $self->answer([$s,$q,$a]);
+                if(! $self->validateGoto($answer,$goodTargets)){
+                    push(@messages,"Section $s Question $q Answer $a does not have a valid GOTO target.");
+                }
+                if(! $self->validateGotoExpression($answer,$goodTargets)){
+                    push(@messages,"Section $s Question $q Answer $a does not have a valid GOTO Expression target.");
+                }
+                if(! $self->validateInfLoop($answer)){
+                    push(@messages,"Section $s Question $q Answer $a jumps to itself.");
+                }
+            }
+        }
+    }
+ 
+   return \@messages; 
+}
+
+sub validateInfLoop{
+    my $self = shift;
+    my $object = shift;
+    return 0 if($object->{goto} =~ /\w/ and $object->{goto} eq $object->{variable});
+    return 1;
+}
+
+sub validateGotoExpression{
+    my $self = shift;
+    my $object = shift;
+    my $goodTargets = shift;
+    if($object->{gotoExpression} =~ /\w/ and $object->{gotoExpression} =~ /\s*?(\w*)/){
+        my $tar = $1;
+        $self->session->log->error("expre targ was $tar");
+        return 0 if(! exists $goodTargets->{$1});
+    }
+    return 1;
+}
+
+sub validateGoto{
+    my $self = shift;
+    my $object = shift;
+    my $goodTargets = shift;
+    return 0 if($object->{goto} =~ /\w/ && ! exists($goodTargets->{$object->{goto}}));
+    return 1;
+}
+
 =head2 section ($address)
 
 Returns a reference to one section.

t/Asset/Wobject/Survey/ResponseJSON.t

@@ -468,6 +468,7 @@ $rJSON->recordResponses({
     '1-0-0'        => 'First answer',
     '1-0-0comment' => 'Section 1, question 0, answer 0 comment',
 });
+
 cmp_deeply(
     $rJSON->responses,
     {
@@ -485,6 +486,7 @@ cmp_deeply(
     },
     '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;