diff --git a/lib/WebGUI/Asset/Wobject/Survey.pm b/lib/WebGUI/Asset/Wobject/Survey.pm index a74ab80a0..195dd78f4 100644 --- a/lib/WebGUI/Asset/Wobject/Survey.pm +++ b/lib/WebGUI/Asset/Wobject/Survey.pm @@ -59,7 +59,7 @@ sub definition { defaultValue => undef, label => "Set the URL that the survey will exit to", hoverHelp => -"When the user finishes the survey, they will be sent to this URL. Leave blank if no forwarding required.", + "When the user finishes the survey, they will be sent to this URL. Leave blank if no forwarding required.", }, maxResponsesPerUser => { fieldType => 'integer', @@ -132,8 +132,7 @@ sub definition { ); push( - @{$definition}, - { + @{$definition}, { assetName => $i18n->get('assetName'), icon => 'survey.gif', autoGenerateForms => 1, @@ -143,7 +142,7 @@ sub definition { } ); return $class->SUPER::definition( $session, $definition ); -} +} ## end sub definition #------------------------------------------------------------------- @@ -172,9 +171,7 @@ Override importAssetCollateralData so that surveyJSON gets imported from package sub importAssetCollateralData { my ( $self, $data ) = @_; my $surveyJSON = $data->{properties}{surveyJSON}; - $self->session->db->write( - "update Survey set surveyJSON = ? where assetId = ?", - [ $surveyJSON, $self->getId ] ); + $self->session->db->write( "update Survey set surveyJSON = ? where assetId = ?", [ $surveyJSON, $self->getId ] ); } #------------------------------------------------------------------- @@ -190,10 +187,8 @@ sub duplicate { my $options = shift; my $newAsset = $self->SUPER::duplicate($options); $self->loadSurveyJSON(); - $self->session->db->write( - "update Survey set surveyJSON = ? where assetId = ?", - [ $self->survey->freeze, $newAsset->getId ] - ); + $self->session->db->write( "update Survey set surveyJSON = ? where assetId = ?", + [ $self->survey->freeze, $newAsset->getId ] ); return $newAsset; } @@ -210,14 +205,10 @@ sub loadSurveyJSON { my $jsonHash = shift; if ( defined $self->survey ) { return; } #already loaded - $jsonHash = $self->session->db->quickScalar( - "select surveyJSON from Survey where assetId = ?", - [ $self->getId ] ) - if ( !defined $jsonHash ); + $jsonHash = $self->session->db->quickScalar( "select surveyJSON from Survey where assetId = ?", [ $self->getId ] ) + if ( !defined $jsonHash ); - $self->{survey} = - WebGUI::Asset::Wobject::Survey::SurveyJSON->new( $jsonHash, - $self->session->errorHandler ); + $self->{survey} = WebGUI::Asset::Wobject::Survey::SurveyJSON->new( $jsonHash, $self->session->errorHandler ); } #------------------------------------------------------------------- @@ -238,9 +229,7 @@ sub saveSurveyJSON { my $data = $self->survey->freeze(); - $self->session->db->write( - "update Survey set surveyJSON = ? where assetId = ?", - [ $data, $self->getId ] ); + $self->session->db->write( "update Survey set surveyJSON = ? where assetId = ?", [ $data, $self->getId ] ); } #------------------------------------------------------------------- @@ -255,8 +244,7 @@ sub www_editSurvey { my $self = shift; my %var; - my $out = - $self->processTemplate( \%var, $self->get("surveyEditTemplateId") ); + my $out = $self->processTemplate( \%var, $self->get("surveyEditTemplateId") ); return $out; } @@ -284,7 +272,7 @@ sub www_submitObjectEdit { $self->saveSurveyJSON(); return $self->www_loadSurvey( { address => \@address } ); -} +} ## end sub www_submitObjectEdit #------------------------------------------------------------------- sub copyObject { @@ -293,7 +281,7 @@ sub copyObject { $self->loadSurveyJSON(); #each object checks the ref and then either updates or passes it to the correct child. New objects will have an index of -1. - $address = $self->survey->copy($address); + $address = $self->survey->copy($address); $self->saveSurveyJSON(); @@ -309,7 +297,7 @@ sub deleteObject { $self->loadSurveyJSON(); my $message = $self->survey->remove($address) - ; #each object checks the ref and then either updates or passes it to the correct child. New objects will have an index of -1. + ; #each object checks the ref and then either updates or passes it to the correct child. New objects will have an index of -1. $self->saveSurveyJSON(); @@ -321,9 +309,8 @@ sub deleteObject { pop( @{$address} ); # unless @$address == 1 and $$address[0] == 0; } - return $self->www_loadSurvey( - { address => $address, message => $message } ); -} + return $self->www_loadSurvey( { address => $address, message => $message } ); +} ## end sub deleteObject #------------------------------------------------------------------- sub www_newObject { @@ -343,7 +330,7 @@ sub www_newObject { return $self->www_loadSurvey( { address => $address, message => undef } ); -} +} ## end sub www_newObject #------------------------------------------------------------------- sub www_dragDrop { @@ -358,18 +345,18 @@ sub www_dragDrop { $self->survey->remove( \@tid, 1 ); my $address = [0]; if ( @tid == 1 ) { + #sections can only be inserted after another section so chop off the question and answer portion of - $#bid = 0; + $#bid = 0; $bid[0] = -1 if ( !defined $bid[0] ); $self->survey->insertObject( $target, [ $bid[0] ] ); } - elsif ( @tid == 2 ) - { #questions can be moved to any section, but a pushed to the end of a new section. + elsif ( @tid == 2 ) { #questions can be moved to any section, but a pushed to the end of a new section. if ( $bid[0] !~ /\d/ ) { $bid[0] = $tid[0]; $bid[1] = $tid[1]; } - elsif ( @bid == 1 ) { #moved to a new section or head of current section + elsif ( @bid == 1 ) { #moved to a new section or head of current section if ( $bid[0] !~ /\d/ ) { $bid[0] = $tid[0]; $bid[1] = $tid[1]; @@ -384,18 +371,16 @@ sub www_dragDrop { #else move to the end of the selected section $bid[1] = $#{ $self->survey->questions( [ $bid[0] ] ) }; } - } + } ## end elsif ( @bid == 1 ) $self->survey->insertObject( $target, [ $bid[0], $bid[1] ] ); - } - elsif ( @tid == 3 ) { #answers can only be rearranged in the same question + } ## end elsif ( @tid == 2 ) + elsif ( @tid == 3 ) { #answers can only be rearranged in the same question if ( @bid == 2 and $bid[1] == $tid[1] ) { $bid[2] = -1; - $self->survey->insertObject( $target, - [ $bid[0], $bid[1], $bid[2] ] ); + $self->survey->insertObject( $target, [ $bid[0], $bid[1], $bid[2] ] ); } elsif ( @bid == 3 ) { - $self->survey->insertObject( $target, - [ $bid[0], $bid[1], $bid[2] ] ); + $self->survey->insertObject( $target, [ $bid[0], $bid[1], $bid[2] ] ); } else { @@ -407,7 +392,7 @@ sub www_dragDrop { $self->saveSurveyJSON(); return $self->www_loadSurvey( { address => $address } ); -} +} ## end sub www_dragDrop #------------------------------------------------------------------- sub www_loadSurvey { @@ -425,23 +410,20 @@ sub www_loadSurvey { } } my $message = defined $options->{message} ? $options->{message} : ''; - my $var = - defined $options->{var} - ? $options->{var} - : $self->survey->getEditVars($address); + my $var + = defined $options->{var} + ? $options->{var} + : $self->survey->getEditVars($address); my $editHtml; if ( $var->{type} eq 'section' ) { - $editHtml = - $self->processTemplate( $var, $self->get("sectionEditTemplateId") ); + $editHtml = $self->processTemplate( $var, $self->get("sectionEditTemplateId") ); } elsif ( $var->{type} eq 'question' ) { - $editHtml = - $self->processTemplate( $var, $self->get("questionEditTemplateId") ); + $editHtml = $self->processTemplate( $var, $self->get("questionEditTemplateId") ); } elsif ( $var->{type} eq 'answer' ) { - $editHtml = - $self->processTemplate( $var, $self->get("answerEditTemplateId") ); + $editHtml = $self->processTemplate( $var, $self->get("answerEditTemplateId") ); } my %buttons; @@ -456,8 +438,7 @@ sub www_loadSurvey { my $lastType; my %lastId; my @ids; - my ( $s, $q, $a ) = - ( 0, 0, 0 ); #bools on if a button has already been created + my ( $s, $q, $a ) = ( 0, 0, 0 ); #bools on if a button has already been created foreach (@$data) { if ( $_->{type} eq 'section' ) { @@ -468,10 +449,7 @@ sub www_loadSurvey { elsif ( $lastType eq 'question' ) { $q = 1; } - $html .= - "
"; $$q{'verte'} = "
"; } - } + } ## end foreach my $q (@$questions) $section->{'questions'} = $questions; - my $out = - $self->processTemplate( $section, $self->get("surveyQuestionsId") ); + my $out = $self->processTemplate( $section, $self->get("surveyQuestionsId") ); $self->session->http->setMimeType('application/json'); - return encode_json( - { - "type", "displayquestions", "section", $section, - "questions", $questions, "html", $out - } - ); -} + return encode_json( { "type", "displayquestions", "section", $section, "questions", $questions, "html", $out } ); +} ## end sub prepareShowSurveyTemplate #------------------------------------------------------------------- @@ -837,16 +786,15 @@ sub loadResponseJSON { $rId = defined $rId ? $rId : $self->{responseId}; if ( defined $self->response and !defined $rId ) { return; } - $jsonHash = $self->session->db->quickScalar( -"select responseJSON from Survey_response where assetId = ? and Survey_responseId = ?", - [ $self->getId, $rId ] - ) if ( !defined $jsonHash ); + $jsonHash + = $self->session->db->quickScalar( + "select responseJSON from Survey_response where assetId = ? and Survey_responseId = ?", + [ $self->getId, $rId ] ) + if ( !defined $jsonHash ); - $self->{response} = - WebGUI::Asset::Wobject::Survey::ResponseJSON->new( $jsonHash, - $self->session->errorHandler, - $self->survey ); -} + $self->{response} + = WebGUI::Asset::Wobject::Survey::ResponseJSON->new( $jsonHash, $self->session->errorHandler, $self->survey ); +} ## end sub loadResponseJSON #------------------------------------------------------------------- sub saveResponseJSON { @@ -854,10 +802,8 @@ sub saveResponseJSON { my $data = $self->response->freeze(); - $self->session->db->write( -"update Survey_response set responseJSON = ? where Survey_responseId = ?", - [ $data, $self->{responseId} ] - ); + $self->session->db->write( "update Survey_response set responseJSON = ? where Survey_responseId = ?", + [ $data, $self->{responseId} ] ); } #------------------------------------------------------------------- @@ -875,10 +821,10 @@ sub getResponseId { my $ip = $self->session->env->getIp; my $id = $self->session->user->userId(); - my $anonId = - $self->session->form->process("userid") - || $self->session->http->getCookies->{"Survey2AnonId"} - || undef; + my $anonId + = $self->session->form->process("userid") + || $self->session->http->getCookies->{"Survey2AnonId"} + || undef; $self->session->http->setCookie( "Survey2AnonId", $anonId ) if ($anonId); my $responseId; @@ -892,44 +838,43 @@ sub getResponseId { $string = 'anonId'; $id = $anonId; } - $responseId = $self->session->db->quickScalar( -"select Survey_responseId from Survey_response where $string = ? and assetId = ? and isComplete = 0", - [ $id, $self->getId() ] - ); + $responseId + = $self->session->db->quickScalar( + "select Survey_responseId from Survey_response where $string = ? and assetId = ? and isComplete = 0", + [ $id, $self->getId() ] ); } elsif ( $id == 1 ) { $responseId = $self->session->db->quickScalar( -"select Survey_responseId from Survey_response where userId = ? and ipAddress = ? and assetId = ? and isComplete = 0", + "select Survey_responseId from Survey_response where userId = ? and ipAddress = ? and assetId = ? and isComplete = 0", [ $id, $ip, $self->getId() ] ); } if ( !$responseId ) { - my $allowedTakes = $self->session->db->quickScalar( -"select maxResponsesPerUser from Survey where assetId = ? order by revisionDate desc limit 1", - [ $self->getId() ] - ); + my $allowedTakes + = $self->session->db->quickScalar( + "select maxResponsesPerUser from Survey where assetId = ? order by revisionDate desc limit 1", + [ $self->getId() ] ); my $haveTaken; if ( $id == 1 ) { - $haveTaken = $self->session->db->quickScalar( -"select count(*) from Survey_response where userId = ? and ipAddress = ? and assetId = ?", - [ $id, $ip, $self->getId() ] - ); + $haveTaken + = $self->session->db->quickScalar( + "select count(*) from Survey_response where userId = ? and ipAddress = ? and assetId = ?", + [ $id, $ip, $self->getId() ] ); } else { - $haveTaken = $self->session->db->quickScalar( -"select count(*) from Survey_response where $string = ? and assetId = ?", - [ $id, $self->getId() ] - ); + $haveTaken + = $self->session->db->quickScalar( + "select count(*) from Survey_response where $string = ? and assetId = ?", + [ $id, $self->getId() ] ); } if ( $haveTaken < $allowedTakes ) { $responseId = $self->session->db->setRow( "Survey_response", - "Survey_responseId", - { + "Survey_responseId", { Survey_responseId => "new", userId => $id, ipAddress => $ip, @@ -944,14 +889,14 @@ sub getResponseId { $self->response->createSurveyOrder(); $self->{responseId} = $responseId; $self->saveResponseJSON(); - } + } ## end if ( $haveTaken < $allowedTakes) else { } - } + } ## end if ( !$responseId ) $self->{responseId} = $responseId; $self->loadBothJSON($responseId); return $responseId; -} +} ## end sub getResponseId #------------------------------------------------------------------- @@ -972,15 +917,15 @@ sub canTakeSurvey { if ( $id == 1 ) { $takenCount = $self->session->db->quickScalar( -"select count(*) from Survey_response where userId = ? and ipAddress = ? and assetId = ? + "select count(*) from Survey_response where userId = ? and ipAddress = ? and assetId = ? and isComplete = ?", [ $id, $ip, $self->getId(), 1 ] ); } else { - $takenCount = $self->session->db->quickScalar( -"select count(*) from Survey_response where userId = ? and assetId = ? and isComplete = ?", - [ $id, $self->getId(), 1 ] - ); + $takenCount + = $self->session->db->quickScalar( + "select count(*) from Survey_response where userId = ? and assetId = ? and isComplete = ?", + [ $id, $self->getId(), 1 ] ); } if ( $takenCount >= $maxTakes ) { @@ -991,21 +936,19 @@ sub canTakeSurvey { } return $self->{canTake}; -} +} ## end sub canTakeSurvey #------------------------------------------------------------------- sub www_viewReports { my $self = shift; $self->loadTempReportTable(); return "" - unless ( - $self->session->user->isInGroup( $self->get("groupToViewReports") ) ); - my $filename = - $self->session->url->escape( $self->get("title") . "_results.tab" ); - my $content = $self->session->db->quickTab( -"select * from Survey_tempReport t where t.assetId=? order by t.Survey_responseId, t.order", - [ $self->getId() ] - ); + unless ( $self->session->user->isInGroup( $self->get("groupToViewReports") ) ); + my $filename = $self->session->url->escape( $self->get("title") . "_results.tab" ); + my $content + = $self->session->db->quickTab( + "select * from Survey_tempReport t where t.assetId=? order by t.Survey_responseId, t.order", + [ $self->getId() ] ); return $self->export( $filename, $content ); } @@ -1021,8 +964,7 @@ sub export { my $tmpDir = $store->getPath(); my $filepath = $store->getPath($filename); unless ( open TEMP, ">$filepath" ) { - return -"Error - Could not open temporary file for writing. Please use the back button and try again"; + return "Error - Could not open temporary file for writing. Please use the back button and try again"; } print TEMP $content; close TEMP; @@ -1031,57 +973,44 @@ sub export { $self->session->http->setRedirect($fileurl); return undef; -} +} ## end sub export sub loadTempReportTable { my $self = shift; $self->loadSurveyJSON(); - my $refs = $self->session->db->buildArrayRefOfHashRefs( - "select * from Survey_response where assetId = ?", - [ $self->getId() ] ); - $self->session->db->write( - "delete from Survey_tempReport where assetId = ?", + my $refs = $self->session->db->buildArrayRefOfHashRefs( "select * from Survey_response where assetId = ?", [ $self->getId() ] ); + $self->session->db->write( "delete from Survey_tempReport where assetId = ?", [ $self->getId() ] ); for my $ref (@$refs) { $self->loadResponseJSON( undef, $ref->{Survey_responseId} ); my $count = 1; for my $q ( @{ $self->response->returnResponseForReporting() } ) { if ( @{ $q->{answers} } == 0 and $q->{comment} =~ /\w/ ) { $self->session->db->write( -"insert into Survey_tempReport VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)", - [ - $self->getId(), $ref->{Survey_responseId}, - $count++, $q->{section}, - $q->{sectionName}, $q->{question}, - $q->{questionName}, $q->{questionComment}, - undef, undef, - undef, undef, - undef, undef, - undef + "insert into Survey_tempReport VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)", [ + $self->getId(), $ref->{Survey_responseId}, $count++, $q->{section}, + $q->{sectionName}, $q->{question}, $q->{questionName}, $q->{questionComment}, + undef, undef, undef, undef, + undef, undef, undef ] ); next; } for my $a ( @{ $q->{answers} } ) { $self->session->db->write( -"insert into Survey_tempReport VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)", - [ - $self->getId(), $ref->{Survey_responseId}, - $count++, $q->{section}, - $q->{sectionName}, $q->{question}, - $q->{questionName}, $q->{questionComment}, - $a->{id}, $a->{value}, - $a->{comment}, $a->{time}, - $a->{isCorrect}, $a->{value}, - undef + "insert into Survey_tempReport VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)", [ + $self->getId(), $ref->{Survey_responseId}, $count++, $q->{section}, + $q->{sectionName}, $q->{question}, $q->{questionName}, $q->{questionComment}, + $a->{id}, $a->{value}, $a->{comment}, $a->{time}, + $a->{isCorrect}, $a->{value}, undef ] ); } - } - } + } ## end for my $q ( @{ $self->response... + } ## end for my $ref (@$refs) return 1; -} +} ## end sub loadTempReportTable sub log { my $self = shift; diff --git a/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm b/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm index 1c2f61473..8d3e28f41 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm @@ -13,17 +13,15 @@ sub new { $self->{survey} = $survey; $self->{log} = $log; my $temp = decode_json($json) if defined $json; - $self->{surveyOrder} = - defined $temp->{surveyOrder} - ? $temp->{surveyOrder} - : [] - ; #an array of question addresses, with the third member being an array of answers - $self->{responses} = defined $temp->{responses} ? $temp->{responses} : {}; - $self->{lastResponse} = - defined $temp->{lastResponse} ? $temp->{lastResponse} : -1; + $self->{surveyOrder} + = defined $temp->{surveyOrder} + ? $temp->{surveyOrder} + : []; #an array of question addresses, with the third member being an array of answers + $self->{responses} = defined $temp->{responses} ? $temp->{responses} : {}; + $self->{lastResponse} = defined $temp->{lastResponse} ? $temp->{lastResponse} : -1; bless( $self, $class ); return $self; -} +} ## end sub new #---------------------------------------------------------------------------- @@ -39,20 +37,18 @@ sub createSurveyOrder { my $self = shift; my $order; my $qstarting = 0; - for ( my $s = 0 ; $s <= $#{ $self->survey->sections() } ; $s++ ) { + for ( my $s = 0; $s <= $#{ $self->survey->sections() }; $s++ ) { #create question order for section my @qorder; if ( $self->survey->section( [$s] )->{randomizeQuestions} ) { - @qorder = shuffle( - ( $qstarting .. $#{ $self->survey->questions( [$s] ) } ) ); + @qorder = shuffle( ( $qstarting .. $#{ $self->survey->questions( [$s] ) } ) ); } else { - @qorder = - ( ( $qstarting .. $#{ $self->survey->questions( [$s] ) } ) ); + @qorder = ( ( $qstarting .. $#{ $self->survey->questions( [$s] ) } ) ); } - #if this is an empty section, make sure it is still on the list to be seen + #if this is an empty section, make sure it is still on the list to be seen if ( @qorder == 0 ) { push( @$order, [$s] ); } @@ -62,26 +58,16 @@ sub createSurveyOrder { for (@qorder) { my @aorder; if ( $self->survey->question( [ $s, $_ ] )->{randomizeAnswers} ) { - @aorder = shuffle( - ( - $qstarting .. - $#{ $self->survey->question( [ $s, $_ ] )->{answers} } - ) - ); + @aorder = shuffle( ( $qstarting .. $#{ $self->survey->question( [ $s, $_ ] )->{answers} } ) ); } else { - @aorder = ( - ( - $qstarting .. - $#{ $self->survey->question( [ $s, $_ ] )->{answers} } - ) - ); + @aorder = ( ( $qstarting .. $#{ $self->survey->question( [ $s, $_ ] )->{answers} } ) ); } push( @$order, [ $s, $_, \@aorder ] ); } - } + } ## end for ( my $s = 0; $s <= ... $self->{surveyOrder} = $order; -} +} ## end sub createSurveyOrder sub shuffle { my @a = splice @_; @@ -125,14 +111,12 @@ sub nextSectionId { sub nextSection { my $self = shift; - return $self->survey->section( - [ $self->surveyOrder->[ $self->lastResponse + 1 ]->[0] ] ); + return $self->survey->section( [ $self->surveyOrder->[ $self->lastResponse + 1 ]->[0] ] ); } sub currentSection { my $self = shift; - return $self->survey->section( - [ $self->surveyOrder->[ $self->lastResponse ]->[0] ] ); + return $self->survey->section( [ $self->surveyOrder->[ $self->lastResponse ]->[0] ] ); } sub recordResponses { @@ -141,23 +125,19 @@ sub recordResponses { my $session = shift; my %mcTypes = ( - 'Agree/Disagree', 1, 'Certainty', 1, 'Concern', 1, - 'Confidence', 1, 'Education', 1, 'Effectiveness', 1, - 'Gender', 1, 'Ideology', 1, 'Importance', 1, - 'Likelihood', 1, 'Party', 1, 'Multiple Choice', 1, - 'Oppose/Support', 1, 'Race', 1, 'Risk', 1, - 'Satisfaction', 1, 'Scale', 1, 'Security', 1, - 'Threat', 1, 'True/False', 1, 'Yes/No', 1 + 'Agree/Disagree', 1, 'Certainty', 1, 'Concern', 1, 'Confidence', 1, 'Education', 1, + 'Effectiveness', 1, 'Gender', 1, 'Ideology', 1, 'Importance', 1, 'Likelihood', 1, + 'Party', 1, 'Multiple Choice', 1, 'Oppose/Support', 1, 'Race', 1, 'Risk', 1, + 'Satisfaction', 1, 'Scale', 1, 'Security', 1, 'Threat', 1, 'True/False', 1, + 'Yes/No', 1 ); - my %sliderTypes = - ( 'Dual Slider - Range', 1, 'Multi Slider - Allocate', 1, 'Slider', 1 ); - my %textTypes = - ( 'Currency', 'Email', 1, 'Phone Number', 1, 'Text', 1, 'Text Date', 1 ); + my %sliderTypes = ( 'Dual Slider - Range', 1, 'Multi Slider - Allocate', 1, 'Slider', 1 ); + my %textTypes = ( 'Currency', 'Email', 1, 'Phone Number', 1, 'Text', 1, 'Text Date', 1 ); my %fileTypes = ( 'File Upload', 1 ); my %dateTypes = ( 'Date', 'Date Range', 1 ); my %hiddenTypes = ( 'Hidden', 1 ); -#These were just submitted from the user, so we need to see what and how they were (un)answered. + #These were just submitted from the user, so we need to see what and how they were (un)answered. my $questions = $self->nextQuestions(); my $qAnswered = 1; my $terminal = 0; @@ -171,7 +151,7 @@ sub recordResponses { $terminalUrl = $section->{terminalUrl}; } -#There were no questions in the section just displayed, so increment the lastResponse by one + #There were no questions in the section just displayed, so increment the lastResponse by one if ( ref $questions ne 'ARRAY' ) { $self->lastResponse( $self->lastResponse + 1 ); return [ $terminal, $terminalUrl ]; @@ -183,8 +163,7 @@ sub recordResponses { $terminal = 1; $terminalUrl = $question->{terminalUrl}; } - $self->responses->{ $question->{id} }->{comment} = - $responses->{ $question->{id} . "comment" }; + $self->responses->{ $question->{id} }->{comment} = $responses->{ $question->{id} . "comment" }; for my $answer ( @{ $question->{answers} } ) { if ( defined( $responses->{ $answer->{id} } ) @@ -193,16 +172,13 @@ sub recordResponses { $aAnswered = 1; if ( $mcTypes{ $question->{questionType} } ) { - $self->responses->{ $answer->{id} }->{value} = - $answer->{recordedAnswer}; + $self->responses->{ $answer->{id} }->{value} = $answer->{recordedAnswer}; } else { - $self->responses->{ $answer->{id} }->{value} = - $responses->{ $answer->{id} }; + $self->responses->{ $answer->{id} }->{value} = $responses->{ $answer->{id} }; } $self->responses->{ $answer->{id} }->{'time'} = time(); - $self->responses->{ $answer->{id} }->{comment} = - $responses->{ $answer->{id} . "comment" }; + $self->responses->{ $answer->{id} }->{comment} = $responses->{ $answer->{id} . "comment" }; if ( $answer->{terminal} ) { $terminal = 1; @@ -211,12 +187,12 @@ sub recordResponses { elsif ( $answer->{goto} =~ /\w/ ) { $goto = $answer->{goto}; } - } - } + } ## end if ( defined( $responses... + } ## end for my $answer ( @{ $question... $qAnswered = 0 if ( !$aAnswered and $question->{required} ); - } + } ## end for my $question (@$questions) -#if all responses completed, move the lastResponse index to the last question shown + #if all responses completed, move the lastResponse index to the last question shown if ($qAnswered) { $self->lastResponse( $self->lastResponse + @$questions ); $self->goto($goto) if ( defined $goto ); @@ -225,12 +201,12 @@ sub recordResponses { $terminal = 0; } return [ $terminal, $terminalUrl ]; -} +} ## end sub recordResponses sub goto { my $self = shift; my $goto = shift; - for ( my $i = 0 ; $i <= $#{ $self->surveyOrder() } ; $i++ ) { + for ( my $i = 0; $i <= $#{ $self->surveyOrder() }; $i++ ) { my $section = $self->survey->section( $self->surveyOrder()->[$i] ); my $question = $self->survey->question( $self->surveyOrder()->[$i] ); if ( ref $section eq 'HASH' and $section->{variable} eq $goto ) { @@ -242,7 +218,7 @@ sub goto { last; } } -} +} ## end sub goto sub getPreviousAnswer { my $self = shift; @@ -251,14 +227,8 @@ sub getPreviousAnswer { my $question = $self->survey->question( [ $$q[0], $$q[1] ] ); if ( $question->{variable} eq $questionParam ) { for ( 0 .. @{ $self->survey->answers( [ $$q[0], $$q[1] ] ) } ) { - if ( - exists $self->responses->{ $$q[0] . "-" - . $$q[1] . "-" - . $_ } ) - { - return $self->responses->{ $$q[0] . "-" - . $$q[1] . "-" - . $_ }->{value}; + if ( exists $self->responses->{ $$q[0] . "-" . $$q[1] . "-" . $_ } ) { + return $self->responses->{ $$q[0] . "-" . $$q[1] . "-" . $_ }->{value}; } } } @@ -274,41 +244,36 @@ sub nextQuestions { my $nextSectionId = $self->nextSectionId; - my $qPerPage = - $self->survey->section( [ $self->nextSectionId ] )->{questionsPerPage}; + my $qPerPage = $self->survey->section( [ $self->nextSectionId ] )->{questionsPerPage}; #load Previous answer text my $section = $self->nextSection(); $section->{'text'} =~ s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg; my $questions; - for ( my $i = 1 ; $i <= $qPerPage ; $i++ ) { + for ( my $i = 1; $i <= $qPerPage; $i++ ) { my $qAddy = $self->surveyOrder->[ $self->lastResponse + $i ]; next - if ( !exists $$qAddy[1] ) - ; #skip this if it doesn't have a question (for sections with no questions) + if ( !exists $$qAddy[1] ); #skip this if it doesn't have a question (for sections with no questions) if ( $$qAddy[0] != $nextSectionId ) { last; } - my %question = - %{ $self->survey->question( [ $$qAddy[0], $$qAddy[1] ] ) }; - $question{'text'} =~ - s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg; + my %question = %{ $self->survey->question( [ $$qAddy[0], $$qAddy[1] ] ) }; + $question{'text'} =~ s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg; delete $question{answers}; $question{id} = "$$qAddy[0]-$$qAddy[1]"; $question{sid} = "$$qAddy[0]"; for ( @{ $$qAddy[2] } ) { my $ans = $self->survey->answer( [ $$qAddy[0], $$qAddy[1], $_ ] ); - $ans->{'text'} =~ - s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg; + $ans->{'text'} =~ s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg; $ans->{id} = "$$qAddy[0]-$$qAddy[1]-$_"; push( @{ $question{answers} }, $ans ); } push( @$questions, \%question ); - } + } ## end for ( my $i = 1; $i <= ... return $questions; -} +} ## end sub nextQuestions sub surveyEnd { my $self = shift; @@ -327,57 +292,37 @@ sub returnResponseForReporting { for ( @{ $$entry[2] } ) { if ( defined $self->responses->{"$$entry[0]-$$entry[1]-$_"} ) { $self->responses->{"$$entry[0]-$$entry[1]-$_"}->{id} = $_; - if ( $self->survey->answer( [ $$entry[0], $$entry[1], $_ ] ) - ->{isCorrect} ) - { + if ( $self->survey->answer( [ $$entry[0], $$entry[1], $_ ] )->{isCorrect} ) { my $value; - if ( $self->survey->answer( [ $$entry[0], $$entry[1], $_ ] ) - ->{value} =~ /\w/ ) - { - $value = $self->survey->answer( - [ $$entry[0], $$entry[1], $_ ] )->{value}; + if ( $self->survey->answer( [ $$entry[0], $$entry[1], $_ ] )->{value} =~ /\w/ ) { + $value = $self->survey->answer( [ $$entry[0], $$entry[1], $_ ] )->{value}; } else { - $value = - $self->survey->question( [ $$entry[0], $$entry[1] ] ) - ->{value}; + $value = $self->survey->question( [ $$entry[0], $$entry[1] ] )->{value}; } - $self->responses->{"$$entry[0]-$$entry[1]-$_"}->{value} = - $value; - $self->responses->{"$$entry[0]-$$entry[1]-$_"} - ->{isCorrect} = 1; + $self->responses->{"$$entry[0]-$$entry[1]-$_"}->{value} = $value; + $self->responses->{"$$entry[0]-$$entry[1]-$_"}->{isCorrect} = 1; } else { - $self->responses->{"$$entry[0]-$$entry[1]-$_"} - ->{isCorrect} = 0; + $self->responses->{"$$entry[0]-$$entry[1]-$_"}->{isCorrect} = 0; } - push( @answers, - ( $self->responses->{"$$entry[0]-$$entry[1]-$_"} ) ); - } - } + push( @answers, ( $self->responses->{"$$entry[0]-$$entry[1]-$_"} ) ); + } ## end if ( defined $self->responses... + } ## end for ( @{ $$entry[2] } ) push( - @responses, - ( - { - 'section', - $$entry[0], - 'question', - $$entry[1], - 'sectionName', - $self->survey->section( [ $$entry[0] ] )->{variable}, - 'questionName', - $self->survey->question( [ $$entry[0], $$entry[1] ] ) - ->{variable}, - 'questionComment', - $self->responses->{"$$entry[0]-$$entry[1]"}->{comment}, - 'answers', - \@answers + @responses, ( { + 'section', $$entry[0], + 'question', $$entry[1], + 'sectionName', $self->survey->section( [ $$entry[0] ] )->{variable}, + 'questionName', $self->survey->question( [ $$entry[0], $$entry[1] ] )->{variable}, + 'questionComment', $self->responses->{"$$entry[0]-$$entry[1]"}->{comment}, + 'answers', \@answers } ) ); - } + } ## end for my $entry ( @{ $self... return \@responses; -} +} ## end sub returnResponseForReporting #the actual responses to the survey. A response is for a question and is accessed by the exact same address as a survey member. #Questions only contain the comment and an array of answer Responses. diff --git a/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm b/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm index 1b5c2c0b1..b6182cba7 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm @@ -18,7 +18,7 @@ sub new { $self->newObject( [] ); } return $self; -} +} ## end sub new sub freeze { my $self = shift; @@ -45,7 +45,7 @@ sub newObject { $$address[2] = $#{ $self->answers($address) }; return $address; } -} +} ## end sub newObject #address is the array of objects currently selected in the edit screen #data is the array of hash items for displaying @@ -53,40 +53,32 @@ sub getDragDropList { my $self = shift; my $address = shift; my @data; - for ( my $i = 0 ; $i <= $#{ $self->sections } ; $i++ ) { - push( @data, - { text => $self->section( [$i] )->{title}, type => 'section' } ); + for ( my $i = 0; $i <= $#{ $self->sections }; $i++ ) { + push( @data, { text => $self->section( [$i] )->{title}, type => 'section' } ); if ( $address->[0] == $i ) { - for ( my $x = 0 ; $x <= $#{ $self->questions($address) } ; $x++ ) { + for ( my $x = 0; $x <= $#{ $self->questions($address) }; $x++ ) { push( - @data, - { + @data, { text => $self->question( [ $i, $x ] )->{text}, type => 'question' } ); if ( $address->[1] == $x ) { - for ( - my $y = 0 ; - $y <= $#{ $self->answers($address) } ; - $y++ - ) - { + for ( my $y = 0; $y <= $#{ $self->answers($address) }; $y++ ) { push( - @data, - { + @data, { text => $self->answer( [ $i, $x, $y ] )->{text}, type => 'answer' } ); } } - } - } - } + } ## end for ( my $x = 0; $x <= ... + } ## end if ( $address->[0] == ... + } ## end for ( my $i = 0; $i <= ... return \@data; -} +} ## end sub getDragDropList sub getObject { my ( $self, $address ) = @_; @@ -94,12 +86,10 @@ sub getObject { return $self->{sections}->[ $address->[0] ]; } elsif ( @$address == 2 ) { - return $self->{sections}->[ $address->[0] ]->{questions} - ->[ $address->[1] ]; + return $self->{sections}->[ $address->[0] ]->{questions}->[ $address->[1] ]; } else { - return $self->{sections}->[ $address->[0] ]->{questions} - ->[ $address->[1] ]->{answers}->[ $address->[2] ]; + return $self->{sections}->[ $address->[0] ]->{questions}->[ $address->[1] ]->{answers}->[ $address->[2] ]; } } @@ -138,7 +128,7 @@ sub getSectionEditVars { } } return \%var; -} +} ## end sub getSectionEditVars sub getQuestionEditVars { my $self = shift; @@ -150,22 +140,14 @@ sub getQuestionEditVars { delete $var{answers}; delete $var{questionType}; my @types = ( - 'Agree/Disagree', 'Certainty', - 'Concern', 'Confidence', - 'Currency', 'Date', - 'Date Range', 'Dual Slider - Range', - 'Education', 'Effectiveness', - 'Email', 'File Upload', - 'Gender', 'Hidden', - 'Ideology', 'Importance', - 'Likelihood', 'Multi Slider - Allocate', - 'Multiple Choice', 'Oppose/Support', - 'Party', 'Phone Number', - 'Race', 'Risk', - 'Satisfaction', 'Scale', - 'Security', 'Slider', - 'Text', 'Text Date', - 'Threat', 'True/False', + 'Agree/Disagree', 'Certainty', 'Concern', 'Confidence', + 'Currency', 'Date', 'Date Range', 'Dual Slider - Range', + 'Education', 'Effectiveness', 'Email', 'File Upload', + 'Gender', 'Hidden', 'Ideology', 'Importance', + 'Likelihood', 'Multi Slider - Allocate', 'Multiple Choice', 'Oppose/Support', + 'Party', 'Phone Number', 'Race', 'Risk', + 'Satisfaction', 'Scale', 'Security', 'Slider', + 'Text', 'Text Date', 'Threat', 'True/False', 'Yes/No' ); @@ -178,14 +160,14 @@ sub getQuestionEditVars { } } return \%var; -} +} ## end sub getQuestionEditVars sub getAnswerEditVars { my $self = shift; my $address = shift; my $object = $self->answer($address); my %var = %{$object}; - $var{id} = $address->[0] . "-" . $address->[1] . "-" . $address->[2]; + $var{id} = $address->[0] . "-" . $address->[1] . "-" . $address->[2]; $var{displayed_id} = $address->[2] + 1; return \%var; } @@ -217,15 +199,14 @@ sub update { } } if ( @$address == 2 and !$newQuestion ) { - if ( $ref->{questionType} ne $self->question($address)->{questionType} ) - { + if ( $ref->{questionType} ne $self->question($address)->{questionType} ) { $self->updateQuestionAnswers( $address, $ref->{questionType} ); } } for my $key ( keys %$object ) { $object->{$key} = $ref->{$key} if ( defined $$ref{$key} ); } -} +} ## end sub update #determine what to add and add it. # ref should contain all the information for the new @@ -262,8 +243,7 @@ sub remove { my ( $self, $address, $movingOverride ) = @_; if ( @$address == 1 ) { splice( @{ $self->{sections} }, $$address[0], 1 ) - if ( $$address[0] != 0 or defined $movingOverride ) - ; #can't delete the first section + if ( $$address[0] != 0 or defined $movingOverride ); #can't delete the first section } elsif ( @$address == 2 ) { splice( @{ $self->questions($address) }, $$address[1], 1 ); @@ -275,18 +255,12 @@ sub remove { sub newSection { my %members = ( - 'text', '', - 'title', 'NEW SECTION', - 'variable', '', - 'questionsPerPage', 5, - 'questionsOnSectionPage', 1, - 'randomizeQuestions', 0, - 'everyPageTitle', 1, - 'everyPageText', 1, - 'terminal', 0, - 'terminalUrl', '', - 'goto', '', - 'timeLimit', 0, + 'text', '', 'title', 'NEW SECTION', + 'variable', '', 'questionsPerPage', 5, + 'questionsOnSectionPage', 1, 'randomizeQuestions', 0, + 'everyPageTitle', 1, 'everyPageText', 1, + 'terminal', 0, 'terminalUrl', '', + 'goto', '', 'timeLimit', 0, 'type', 'section' ); $members{questions} = []; @@ -315,17 +289,12 @@ sub newQuestion { ); $members{answers} = []; return \%members; -} +} ## end sub newQuestion sub newAnswer { my %members = ( - 'text', '', 'verbatim', 0, - 'textCols', 10, 'textRows', 5, - 'goto', '', 'recordedAnswer', '', - 'isCorrect', 1, 'min', 1, - 'max', 10, 'step', 1, - 'value', 1, 'terminal', 0, - 'terminalUrl', '', 'type', 'answer' + 'text', '', 'verbatim', 0, 'textCols', 10, 'textRows', 5, 'goto', '', 'recordedAnswer', '', 'isCorrect', 1, + 'min', 1, 'max', 10, 'step', 1, 'value', 1, 'terminal', 0, 'terminalUrl', '', 'type', 'answer' ); return \%members; } @@ -380,20 +349,12 @@ sub updateQuestionAnswers { $self->addAnswersToQuestion( \@addy, \@ans, { 7, 1 } ); } elsif ( $type eq 'Party' ) { - my @ans = ( - 'Democratic party', - 'Republican party (or GOP)', - 'Independant party', - 'Other party (verbatim)' - ); + my @ans = ( 'Democratic party', 'Republican party (or GOP)', 'Independant party', 'Other party (verbatim)' ); $self->addAnswersToQuestion( \@addy, \@ans, { 3, 1 } ); } elsif ( $type eq 'Race' ) { - my @ans = ( - 'American Indian', 'Asian', - 'Black', 'Hispanic', - 'White non-Hispanic', 'Something else (verbatim)' - ); + my @ans + = ( 'American Indian', 'Asian', 'Black', 'Hispanic', 'White non-Hispanic', 'Something else (verbatim)' ); $self->addAnswersToQuestion( \@addy, \@ans, { 5, 1 } ); } elsif ( $type eq 'Ideology' ) { @@ -409,69 +370,43 @@ sub updateQuestionAnswers { $self->addAnswersToQuestion( \@addy, \@ans, {} ); } elsif ( $type eq 'Security' ) { - my @ans = ( - 'Not at all secure', - '', '', '', '', '', '', '', '', '', 'Extremely secure' - ); + my @ans = ( 'Not at all secure', '', '', '', '', '', '', '', '', '', 'Extremely secure' ); $self->addAnswersToQuestion( \@addy, \@ans, {} ); } elsif ( $type eq 'Threat' ) { - my @ans = - ( 'No threat', '', '', '', '', '', '', '', '', '', 'Extreme threat' ); + my @ans = ( 'No threat', '', '', '', '', '', '', '', '', '', 'Extreme threat' ); $self->addAnswersToQuestion( \@addy, \@ans, {} ); } elsif ( $type eq 'Risk' ) { - my @ans = - ( 'No risk', '', '', '', '', '', '', '', '', '', 'Extreme risk' ); + my @ans = ( 'No risk', '', '', '', '', '', '', '', '', '', 'Extreme risk' ); $self->addAnswersToQuestion( \@addy, \@ans, {} ); } elsif ( $type eq 'Concern' ) { - my @ans = ( - 'Not at all concerned', - '', '', '', '', '', '', '', '', '', 'Extremely concerned' - ); + my @ans = ( 'Not at all concerned', '', '', '', '', '', '', '', '', '', 'Extremely concerned' ); $self->addAnswersToQuestion( \@addy, \@ans, {} ); } elsif ( $type eq 'Effectiveness' ) { - my @ans = ( - 'Not at all effective', - '', '', '', '', '', '', '', '', '', 'Extremely effective' - ); + my @ans = ( 'Not at all effective', '', '', '', '', '', '', '', '', '', 'Extremely effective' ); $self->addAnswersToQuestion( \@addy, \@ans, {} ); } elsif ( $type eq 'Confidence' ) { - my @ans = ( - 'Not at all confident', - '', '', '', '', '', '', '', '', '', 'Extremely confident' - ); + my @ans = ( 'Not at all confident', '', '', '', '', '', '', '', '', '', 'Extremely confident' ); $self->addAnswersToQuestion( \@addy, \@ans, {} ); } elsif ( $type eq 'Satisfaction' ) { - my @ans = ( - 'Not at all satisfied', - '', '', '', '', '', '', '', '', '', 'Extremely satisfied' - ); + my @ans = ( 'Not at all satisfied', '', '', '', '', '', '', '', '', '', 'Extremely satisfied' ); $self->addAnswersToQuestion( \@addy, \@ans, {} ); } elsif ( $type eq 'Certainty' ) { - my @ans = ( - 'Not at all certain', - '', '', '', '', '', '', '', '', '', 'Extremely certain' - ); + my @ans = ( 'Not at all certain', '', '', '', '', '', '', '', '', '', 'Extremely certain' ); $self->addAnswersToQuestion( \@addy, \@ans, {} ); } elsif ( $type eq 'Likelihood' ) { - my @ans = ( - 'Not at all likely', - '', '', '', '', '', '', '', '', '', 'Extremely likely' - ); + my @ans = ( 'Not at all likely', '', '', '', '', '', '', '', '', '', 'Extremely likely' ); $self->addAnswersToQuestion( \@addy, \@ans, {} ); } elsif ( $type eq 'Importance' ) { - my @ans = ( - 'Not at all important', - '', '', '', '', '', '', '', '', '', 'Extremely important' - ); + my @ans = ( 'Not at all important', '', '', '', '', '', '', '', '', '', 'Extremely important' ); $self->addAnswersToQuestion( \@addy, \@ans, {} ); } elsif ( $type eq 'Oppose/Support' ) { @@ -497,7 +432,7 @@ sub updateQuestionAnswers { else { push( @{ $question->{answers} }, $self->newAnswer() ); } -} +} ## end sub updateQuestionAnswers sub addAnswersToQuestion { my $self = shift; @@ -508,16 +443,13 @@ sub addAnswersToQuestion { push( @{ $self->question($addy)->{answers} }, $self->newAnswer() ); $$addy[2] = $_; if ( defined $$verbs{$_} and $_ == $$verbs{$_} ) { - $self->update( $addy, - { 'text', $$ans[$_], 'recordedAnswer', $_ + 1, 'verbatim', 1 } - ); + $self->update( $addy, { 'text', $$ans[$_], 'recordedAnswer', $_ + 1, 'verbatim', 1 } ); } else { - $self->update( $addy, - { 'text', $$ans[$_], 'recordedAnswer', $_ + 1 } ); + $self->update( $addy, { 'text', $$ans[$_], 'recordedAnswer', $_ + 1 } ); } } -} +} ## end sub addAnswersToQuestion #------------------------------ #accessors and helpers @@ -548,15 +480,13 @@ sub question { sub answers { my $self = shift; my $address = shift; - return $self->{sections}->[ $$address[0] ]->{questions}->[ $$address[1] ] - ->{answers}; + return $self->{sections}->[ $$address[0] ]->{questions}->[ $$address[1] ]->{answers}; } sub answer { my $self = shift; my $address = shift; - return $self->{sections}->[ $$address[0] ]->{questions}->[ $$address[1] ] - ->{answers}->[ $$address[2] ]; + return $self->{sections}->[ $$address[0] ]->{questions}->[ $$address[1] ]->{answers}->[ $$address[2] ]; } sub log {