Default Survey Question settings now save 100% of the answer configuration data. This will not affect previous Surveys, but allow new defaults to be more complex if desired.

docs/changelog/7.x.x.txt

@@ -1,4 +1,5 @@
 7.7.4
+ - Default Survey Question bundles now store full answer information in json. Everything configured in an answer will be saved in a default configuration.
 
 7.7.3
  - fixed #10094: double explanation in thread help

docs/upgrades/upgrade_7.7.3-7.7.4.pl

@@ -22,7 +22,7 @@ use Getopt::Long;
 use WebGUI::Session;
 use WebGUI::Storage;
 use WebGUI::Asset;
-
+use JSON;
 
 my $toVersion = '7.7.4';
 my $quiet; # this line required
@@ -31,7 +31,7 @@ my $quiet; # this line required
 my $session = start(); # this line required
 
 # upgrade functions go here
-
+updateSurveyQuestionTypes($session);
 finish($session); # this line required
 
 
@@ -43,6 +43,65 @@ finish($session); # this line required
 #    # and here's our code
 #    print "DONE!\n" unless $quiet;
 #}
+sub updateSurveyQuestionTypes{
+    my $session = shift;
+    my $refs = $session->db->buildArrayRefOfHashRefs("SELECT * FROM Survey_questionTypes");
+    for my $ref(@$refs){
+        my $name = $ref->{questionType};
+        my $params;
+        my @texts = split/,/,$ref->{answers};
+        #next if(@texts == 0);
+        my $count = 0;
+        for my $text(@texts){
+            my $verbatim = 0;
+            $verbatim = 1 if($text =~ /verbatim/);
+            push(@$params,[$text,$count++,$verbatim]);
+        }
+        _loadValues($name,$params,$session);
+    }
+}
+
+sub _loadValues{
+    my $name = shift;
+    my $values = shift;
+    my $session = shift;
+    my $answers = [];
+    for my $value(@$values){
+        my $answer = _getAnswer();
+        $answer->{text} = $value->[0];
+        $answer->{recordedAnswer} = $value->[1];
+        $answer->{verbatim} = $value->[2];
+        push @$answers,$answer;
+    }
+    my $json = to_json($answers);
+    $session->db->write("UPDATE Survey_questionTypes SET answers = ? WHERE questionType = ?",[$json,$name]);
+}
+
+sub _getAnswer{
+    my $answer = {
+            text           => q{},
+            verbatim       => 0,
+            textCols       => 10,
+            textRows       => 5,
+            goto           => q{},
+            gotoExpression => q{},
+            recordedAnswer => q{},
+            isCorrect      => 1,
+            min            => 1,
+            max            => 10,
+            step           => 1,
+            value          => 1,
+            terminal       => 0,
+            terminalUrl    => q{},
+            type           => 'answer'
+    };
+    return $answer;
+}
+
+
+
+
+
 
 
 # -------------- DO NOT EDIT BELOW THIS LINE --------------------------------

lib/WebGUI/Asset/Wobject/Survey.pm

@@ -396,6 +396,7 @@ Loads the initial edit survey page. All other edit actions are ajax calls from t
 
 sub www_editSurvey {
     my $self = shift;
+    
     return $self->session->privilege->insufficient()
         if !$self->session->user->isInGroup( $self->get('groupToEditSurvey') );
 
@@ -742,6 +743,7 @@ sub www_loadSurvey {
     my ( $self, $options ) = @_;
     my $editflag = 1;
     my $address = defined $options->{address} ? $options->{address} : undef;
+    
     if ( !defined $address ) {
         if ( my $inAddress = $self->session->form->process('data') ) {
             if ( $inAddress eq q{-} ) {
@@ -1181,7 +1183,6 @@ Determines which questions to display to the survey taker next, loads and return
 sub www_loadQuestions {
     my $self            = shift;
     my $wasRestarted    = shift;
-    
     if ( !$self->canTakeSurvey() ) {
         $self->session->log->debug('canTakeSurvey false, surveyEnd');
         return $self->surveyEnd();

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

@@ -110,6 +110,7 @@ Loads the Multiple Choice and Special Question types
 
 sub loadTypes {
     my $self = shift;
+
     @{$self->{specialQuestionTypes}} = ( 
         'Dual Slider - Range',
         'Multi Slider - Allocate',
@@ -125,9 +126,11 @@ sub loadTypes {
         'Date Range',
         'Year Month',
         'Hidden',
-    );
+    ) if(! defined $self->{specialQuestionTypes});
-    my $refs = $self->session->db->buildArrayRefOfHashRefs("SELECT questionType, answers FROM Survey_questionTypes");
+    if(! defined $self->{multipleChoiceTypes}){
-    map($self->{multipleChoiceTypes}->{$_->{questionType}} = [split/,/,$_->{answers}], @$refs);
+        my $refs = $self->session->db->buildArrayRefOfHashRefs("SELECT questionType, answers FROM Survey_questionTypes"); 
+        map($self->{multipleChoiceTypes}->{$_->{questionType}} = $_->{answers} ? from_json($_->{answers}) : {}, @$refs);
+    }
 }
 
 sub addType { 
@@ -135,11 +138,7 @@ sub addType {
     my $name = shift;
     my $address = shift;
     my $obj = $self->getObject($address);
-    my @answers;
+    my $ansString = $obj->{answers} ? to_json $obj->{answers} : {};
-    for my $ans(@{$obj->{answers}}){
-        push(@answers,$ans->{text});
-    }
-    my $ansString = join(',',@answers);
     $self->session->db->write("INSERT INTO Survey_questionTypes VALUES(?,?) ON DUPLICATE KEY UPDATE answers = ?",[$name,$ansString,$ansString]);
     $self->question($address)->{questionType} = $name;
 }
@@ -391,7 +390,6 @@ sections, questions, or answers.
 sub getEditVars {
     my $self    = shift;
     my ($address) = validate_pos(@_, { type => ARRAYREF });
-
     # Figure out what to do by counting the number of elements in the $address array ref
     my $count = @{$address};
     
@@ -988,16 +986,8 @@ sub updateQuestionAnswers {
     }
     elsif ( my $answerBundle = $self->getMultiChoiceBundle($type) ) {
         # We found a known multi-choice bundle. 
-
+        # Add the bundle of multi-choice answers
-        # Mark any answer containing the string "verbatim" as verbatim
+        $self->addAnswersToQuestion( \@address_copy, $answerBundle );
-        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();
@@ -1021,7 +1011,7 @@ sub getMultiChoiceBundle {
     return $self->{multipleChoiceTypes}->{$type};
 }
 
-=head2 addAnswersToQuestion ($address, $answers, $verbatims)
+=head2 addAnswersToQuestion ($address, $answers)
 
 Helper routine for updateQuestionAnswers.  Adds an array of answers to a question.
 
@@ -1034,18 +1024,12 @@ See L<"Address Parameter">. The address of the question to add answers to.
 An array reference of answers to add.  Each element will be assigned to the text field of
 the answer that is created.
 
-=head3 $verbatims
-
-An hash reference.  Each key is an index into the answers array.  The value is a placeholder
-for doing existance lookups.  For each requested index, the verbatim flag in the answer is
-set to true.
-
 =cut
 
 sub addAnswersToQuestion {
     my $self = shift;
-    my ( $address, $answers, $verbatims )
+    my ( $address, $answers )
-        = validate_pos( @_, { type => ARRAYREF }, { type => ARRAYREF }, { type => HASHREF } );
+        = validate_pos( @_, { type => ARRAYREF }, { type => ARRAYREF } );
 
     # Make a private copy of the $address arrayref that we can use locally
     # when updating answer text without causing side-effects for the caller's $address
@@ -1054,19 +1038,7 @@ sub addAnswersToQuestion {
     for my $answer_index ( 0 .. $#{$answers} ) {
         
         # Add a new answer to question
-        push @{ $self->question( \@address_copy )->{answers} }, $self->newAnswer();
+        push @{ $self->question( \@address_copy )->{answers} }, $answers->[$answer_index];
-
-        # Update address to point at newly created answer (so that we can update it)
-        $address_copy[2] = $answer_index;
-
-        # Update the answer appropriately
-        $self->update(
-            \@address_copy,
-            {   text           => $answers->[$answer_index],
-                recordedAnswer => $answer_index + 1, # 1-indexed
-                verbatim       => $verbatims->{$answer_index},
-            }
-        );
     }
     
     return;