diff --git a/docs/changelog/7.x.x.txt b/docs/changelog/7.x.x.txt index 02e82cc98..309af8523 100644 --- a/docs/changelog/7.x.x.txt +++ b/docs/changelog/7.x.x.txt @@ -6,6 +6,8 @@ - fixed #12271: Calendar List View does not always show labels - fixed Passive Analytics, UI, Progress Bar, server load. - fixed #12303: Survey custom multiple choice question types + - fixed #12304: Surven packages do not include custom question types + 7.10.23 - fixed #12225: Stock asset, multiple instances on a page diff --git a/lib/WebGUI/Asset/Wobject/Survey.pm b/lib/WebGUI/Asset/Wobject/Survey.pm index 4ed7a96b2..aa32d3371 100644 --- a/lib/WebGUI/Asset/Wobject/Survey.pm +++ b/lib/WebGUI/Asset/Wobject/Survey.pm @@ -2456,6 +2456,51 @@ sub export { #------------------------------------------------------------------- +=head2 exportAssetData () + +Extend the base method to include custom question types added to this Survey. + +=cut + +sub exportAssetData { + my $self = shift; + my $asset_data = $self->SUPER::exportAssetData(); + my $questions = $self->surveyJSON->questions(); + my %question_types = (); + my $get_question = $self->session->db->prepare('select answers from Survey_questionTypes where questionType=?'); + foreach my $question (@{ $questions }) { + my $type = $question->{questionType}; + next if $question_types{$type}; + $get_question->execute([$type]); + my ($answers) = $get_question->array(); + $question_types{$type} = $answers; + } + #my $question_types = $self->db->buildArrayRefOfHashRefs('select * from Survey_questionTypes'); + $get_question->finish; + $asset_data->{question_types} = \%question_types; + return $asset_data; +} + +#------------------------------------------------------------------- + +=head2 importAssetCollateralData ($data) + +Extend the base method to include custom question types added to this Survey. + +=cut + +sub importAssetCollateralData { + my $self = shift; + my $data = shift; + $self->SUPER::importAssetCollateralData($data); + my $custom_types = $data->{question_types}; + while (my ($question, $answer) = each %{ $custom_types }) { + $self->session->db->write("INSERT INTO Survey_questionTypes VALUES(?,?) ON DUPLICATE KEY UPDATE answers = ?",[$question,$answer,$answer]); + } +} + +#------------------------------------------------------------------- + =head2 www_exportSimpleResults () Exports transposed results as CSV (or tabbed depending on the C form param) diff --git a/t/Asset/Wobject/Survey/package.t b/t/Asset/Wobject/Survey/package.t new file mode 100644 index 000000000..40b79232a --- /dev/null +++ b/t/Asset/Wobject/Survey/package.t @@ -0,0 +1,63 @@ +# Tests WebGUI::Asset::Wobject::Survey Reporting +# +# + +use strict; +use warnings; +use FindBin; +use lib "$FindBin::Bin/../../../lib"; +use Test::More; +use Test::Deep; +use Data::Dumper; +use Clone qw/clone/; +use WebGUI::Test; # Must use this before any other WebGUI modules +use WebGUI::Session; +WebGUI::Error->Trace(1); # Turn on tracing of uncaught Exception::Class exceptions + +#---------------------------------------------------------------------------- +# Init +my $session = WebGUI::Test->session; + +#---------------------------------------------------------------------------- +# put your tests here + +my $import_node = WebGUI::Asset->getImportNode($session); + +# Create a Survey +my $survey = $import_node->addChild( { className => 'WebGUI::Asset::Wobject::Survey', } ); +WebGUI::Test->addToCleanup($survey); + +my $sJSON = $survey->surveyJSON; + +# Load bare-bones survey, containing a single section (S0) +$sJSON->update([0], { variable => 'S0' }); + +# Add 1 question to S0 +$sJSON->newObject([0]); # S0Q0 +$sJSON->update([0,0], { variable => 'toes', questionType => 'Multiple Choice' }); +$sJSON->update([0,0,0], { text => 'one',}); +$sJSON->update([0,0,1], { text => 'two',}); +$sJSON->update([0,0,2], { text => 'more than two',}); + +$survey->persistSurveyJSON; + +$survey->addType('toes', [0,0]); + +my $asset_data = $survey->exportAssetData(); + +ok exists $asset_data->{question_types}, 'question_types entry exists in asset data to package'; +ok exists $asset_data->{question_types}->{toes}, 'the toes type in a question type'; + +$asset_data->{question_types}->{fingers} = clone $asset_data->{question_types}->{toes}; + +$survey->importAssetCollateralData($asset_data); + +$survey = $survey->cloneFromDb; +my $multipleChoiceTypes = $survey->surveyJSON->multipleChoiceTypes; + +ok exists $multipleChoiceTypes->{fingers}, 'fingers type imported as package collateral data'; +ok exists $multipleChoiceTypes->{toes}, 'still have toes, too'; + +done_testing(); + +#vim:ft=perl