oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Used WG perltidyrc to clean up files

Browse source
This commit is contained in:
Kaleb Murphy 2008-11-14 14:49:48 +00:00
parent 9f9601690a
commit 1d5859631c
3 changed files with 276 additions and 472 deletions
Download patch file Download diff file Expand all files Collapse all files

379
lib/WebGUI/Asset/Wobject/Survey.pm
View file

@ -59,7 +59,7 @@ sub definition {
defaultValue => undef, defaultValue => undef,
label => "Set the URL that the survey will exit to", label => "Set the URL that the survey will exit to",
hoverHelp => 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 => { maxResponsesPerUser => {
fieldType => 'integer', fieldType => 'integer',
@ -132,8 +132,7 @@ sub definition {
); );
push( push(
@{$definition}, @{$definition}, {
{
assetName => $i18n->get('assetName'), assetName => $i18n->get('assetName'),
icon => 'survey.gif', icon => 'survey.gif',
autoGenerateForms => 1, autoGenerateForms => 1,
@ -143,7 +142,7 @@ sub definition {
} }
); );
return $class->SUPER::definition( $session, $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 { sub importAssetCollateralData {
my ( $self, $data ) = @_; my ( $self, $data ) = @_;
my $surveyJSON = $data->{properties}{surveyJSON}; my $surveyJSON = $data->{properties}{surveyJSON};
$self->session->db->write( $self->session->db->write( "update Survey set surveyJSON = ? where assetId = ?", [ $surveyJSON, $self->getId ] );
"update Survey set surveyJSON = ? where assetId = ?",
[ $surveyJSON, $self->getId ] );
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
@ -190,10 +187,8 @@ sub duplicate {
my $options = shift; my $options = shift;
my $newAsset = $self->SUPER::duplicate($options); my $newAsset = $self->SUPER::duplicate($options);
$self->loadSurveyJSON(); $self->loadSurveyJSON();
$self->session->db->write( $self->session->db->write( "update Survey set surveyJSON = ? where assetId = ?",
"update Survey set surveyJSON = ? where assetId = ?", [ $self->survey->freeze, $newAsset->getId ] );
[ $self->survey->freeze, $newAsset->getId ]
);
return $newAsset; return $newAsset;
} }
@ -210,14 +205,10 @@ sub loadSurveyJSON {
my $jsonHash = shift; my $jsonHash = shift;
if ( defined $self->survey ) { return; } #already loaded if ( defined $self->survey ) { return; } #already loaded
$jsonHash = $self->session->db->quickScalar( $jsonHash = $self->session->db->quickScalar( "select surveyJSON from Survey where assetId = ?", [ $self->getId ] )
"select surveyJSON from Survey where assetId = ?", if ( !defined $jsonHash );
[ $self->getId ] )
if ( !defined $jsonHash );
$self->{survey} = $self->{survey} = WebGUI::Asset::Wobject::Survey::SurveyJSON->new( $jsonHash, $self->session->errorHandler );
WebGUI::Asset::Wobject::Survey::SurveyJSON->new( $jsonHash,
$self->session->errorHandler );
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
@ -238,9 +229,7 @@ sub saveSurveyJSON {
my $data = $self->survey->freeze(); my $data = $self->survey->freeze();
$self->session->db->write( $self->session->db->write( "update Survey set surveyJSON = ? where assetId = ?", [ $data, $self->getId ] );
"update Survey set surveyJSON = ? where assetId = ?",
[ $data, $self->getId ] );
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
@ -255,8 +244,7 @@ sub www_editSurvey {
my $self = shift; my $self = shift;
my %var; my %var;
my $out = my $out = $self->processTemplate( \%var, $self->get("surveyEditTemplateId") );
$self->processTemplate( \%var, $self->get("surveyEditTemplateId") );
return $out; return $out;
} }
@ -284,7 +272,7 @@ sub www_submitObjectEdit {
$self->saveSurveyJSON(); $self->saveSurveyJSON();
return $self->www_loadSurvey( { address => \@address } ); return $self->www_loadSurvey( { address => \@address } );
} } ## end sub www_submitObjectEdit
#------------------------------------------------------------------- #-------------------------------------------------------------------
sub copyObject { sub copyObject {
@ -293,7 +281,7 @@ sub copyObject {
$self->loadSurveyJSON(); $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. #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(); $self->saveSurveyJSON();
@ -309,7 +297,7 @@ sub deleteObject {
$self->loadSurveyJSON(); $self->loadSurveyJSON();
my $message = $self->survey->remove($address) 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(); $self->saveSurveyJSON();
@ -321,9 +309,8 @@ sub deleteObject {
pop( @{$address} ); # unless @$address == 1 and $$address[0] == 0; pop( @{$address} ); # unless @$address == 1 and $$address[0] == 0;
} }
return $self->www_loadSurvey( return $self->www_loadSurvey( { address => $address, message => $message } );
{ address => $address, message => $message } ); } ## end sub deleteObject
}
#------------------------------------------------------------------- #-------------------------------------------------------------------
sub www_newObject { sub www_newObject {
@ -343,7 +330,7 @@ sub www_newObject {
return $self->www_loadSurvey( { address => $address, message => undef } ); return $self->www_loadSurvey( { address => $address, message => undef } );
} } ## end sub www_newObject
#------------------------------------------------------------------- #-------------------------------------------------------------------
sub www_dragDrop { sub www_dragDrop {
@ -358,18 +345,18 @@ sub www_dragDrop {
$self->survey->remove( \@tid, 1 ); $self->survey->remove( \@tid, 1 );
my $address = [0]; my $address = [0];
if ( @tid == 1 ) { if ( @tid == 1 ) {
#sections can only be inserted after another section so chop off the question and answer portion of #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] ); $bid[0] = -1 if ( !defined $bid[0] );
$self->survey->insertObject( $target, [ $bid[0] ] ); $self->survey->insertObject( $target, [ $bid[0] ] );
} }
elsif ( @tid == 2 ) elsif ( @tid == 2 ) { #questions can be moved to any section, but a pushed to the end of a new section.
{ #questions can be moved to any section, but a pushed to the end of a new section.
if ( $bid[0] !~ /\d/ ) { if ( $bid[0] !~ /\d/ ) {
$bid[0] = $tid[0]; $bid[0] = $tid[0];
$bid[1] = $tid[1]; $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/ ) { if ( $bid[0] !~ /\d/ ) {
$bid[0] = $tid[0]; $bid[0] = $tid[0];
$bid[1] = $tid[1]; $bid[1] = $tid[1];
@ -384,18 +371,16 @@ sub www_dragDrop {
#else move to the end of the selected section #else move to the end of the selected section
$bid[1] = $#{ $self->survey->questions( [ $bid[0] ] ) }; $bid[1] = $#{ $self->survey->questions( [ $bid[0] ] ) };
} }
} } ## end elsif ( @bid == 1 )
$self->survey->insertObject( $target, [ $bid[0], $bid[1] ] ); $self->survey->insertObject( $target, [ $bid[0], $bid[1] ] );
} } ## end elsif ( @tid == 2 )
elsif ( @tid == 3 ) { #answers can only be rearranged in the same question elsif ( @tid == 3 ) { #answers can only be rearranged in the same question
if ( @bid == 2 and $bid[1] == $tid[1] ) { if ( @bid == 2 and $bid[1] == $tid[1] ) {
$bid[2] = -1; $bid[2] = -1;
$self->survey->insertObject( $target, $self->survey->insertObject( $target, [ $bid[0], $bid[1], $bid[2] ] );
[ $bid[0], $bid[1], $bid[2] ] );
} }
elsif ( @bid == 3 ) { elsif ( @bid == 3 ) {
$self->survey->insertObject( $target, $self->survey->insertObject( $target, [ $bid[0], $bid[1], $bid[2] ] );
[ $bid[0], $bid[1], $bid[2] ] );
} }
else { else {
@ -407,7 +392,7 @@ sub www_dragDrop {
$self->saveSurveyJSON(); $self->saveSurveyJSON();
return $self->www_loadSurvey( { address => $address } ); return $self->www_loadSurvey( { address => $address } );
} } ## end sub www_dragDrop
#------------------------------------------------------------------- #-------------------------------------------------------------------
sub www_loadSurvey { sub www_loadSurvey {
@ -425,23 +410,20 @@ sub www_loadSurvey {
} }
} }
my $message = defined $options->{message} ? $options->{message} : ''; my $message = defined $options->{message} ? $options->{message} : '';
my $var = my $var
defined $options->{var} = defined $options->{var}
? $options->{var} ? $options->{var}
: $self->survey->getEditVars($address); : $self->survey->getEditVars($address);
my $editHtml; my $editHtml;
if ( $var->{type} eq 'section' ) { if ( $var->{type} eq 'section' ) {
$editHtml = $editHtml = $self->processTemplate( $var, $self->get("sectionEditTemplateId") );
$self->processTemplate( $var, $self->get("sectionEditTemplateId") );
} }
elsif ( $var->{type} eq 'question' ) { elsif ( $var->{type} eq 'question' ) {
$editHtml = $editHtml = $self->processTemplate( $var, $self->get("questionEditTemplateId") );
$self->processTemplate( $var, $self->get("questionEditTemplateId") );
} }
elsif ( $var->{type} eq 'answer' ) { elsif ( $var->{type} eq 'answer' ) {
$editHtml = $editHtml = $self->processTemplate( $var, $self->get("answerEditTemplateId") );
$self->processTemplate( $var, $self->get("answerEditTemplateId") );
} }
my %buttons; my %buttons;
@ -456,8 +438,7 @@ sub www_loadSurvey {
my $lastType; my $lastType;
my %lastId; my %lastId;
my @ids; my @ids;
my ( $s, $q, $a ) = my ( $s, $q, $a ) = ( 0, 0, 0 ); #bools on if a button has already been created
( 0, 0, 0 ); #bools on if a button has already been created
foreach (@$data) { foreach (@$data) {
if ( $_->{type} eq 'section' ) { if ( $_->{type} eq 'section' ) {
@ -468,10 +449,7 @@ sub www_loadSurvey {
elsif ( $lastType eq 'question' ) { elsif ( $lastType eq 'question' ) {
$q = 1; $q = 1;
} }
$html .= $html .= "<li id='$scount' class='section'>S" . ( $scount + 1 ) . ": $_->{text}<\/li><br>\n";
"<li id='$scount' class='section'>S"
. ( $scount + 1 )
. ": $_->{text}<\/li><br>\n";
push( @ids, $scount ); push( @ids, $scount );
} }
elsif ( $_->{type} eq 'question' ) { elsif ( $_->{type} eq 'question' ) {
@ -479,24 +457,18 @@ sub www_loadSurvey {
if ( $lastType eq 'answer' ) { if ( $lastType eq 'answer' ) {
$a = 1; $a = 1;
} }
$html .= $html .= "<li id='$scount-$qcount' class='question'>Q" . ( $qcount + 1 ) . ": $_->{text}<\/li><br>\n";
"<li id='$scount-$qcount' class='question'>Q"
. ( $qcount + 1 )
. ": $_->{text}<\/li><br>\n";
push( @ids, "$scount-$qcount" ); push( @ids, "$scount-$qcount" );
$lastType = 'question'; $lastType = 'question';
$acount = -1; $acount = -1;
} }
elsif ( $_->{type} eq 'answer' ) { elsif ( $_->{type} eq 'answer' ) {
$lastId{answer} = ++$acount; $lastId{answer} = ++$acount;
$html .= $html .= "<li id='$scount-$qcount-$acount' class='answer'>A" . ( $acount + 1 ) . ": $_->{text}<\/li><br>\n";
"<li id='$scount-$qcount-$acount' class='answer'>A"
. ( $acount + 1 )
. ": $_->{text}<\/li><br>\n";
push( @ids, "$scount-$qcount-$acount" ); push( @ids, "$scount-$qcount-$acount" );
$lastType = 'answer'; $lastType = 'answer';
} }
} } ## end foreach (@$data)
#address is the address of the focused object #address is the address of the focused object
#buttons are the data to create the Add buttons #buttons are the data to create the Add buttons
@ -505,13 +477,12 @@ sub www_loadSurvey {
#ids is a list of all ids passed in which are draggable (for adding events) #ids is a list of all ids passed in which are draggable (for adding events)
#type is the object type #type is the object type
my $return = { my $return = {
"address", $address, "buttons", \%buttons, "address", $address, "buttons", \%buttons, "edithtml", $editHtml,
"edithtml", $editHtml, "ddhtml", $html, "ddhtml", $html, "ids", \@ids, "type", $var->{type}
"ids", \@ids, "type", $var->{type}
}; };
$self->session->http->setMimeType('application/json'); $self->session->http->setMimeType('application/json');
return encode_json($return); return encode_json($return);
} } ## end sub www_loadSurvey
#------------------------------------------------------------------- #-------------------------------------------------------------------
@ -537,13 +508,9 @@ sub prepareView {
sub purge { sub purge {
my $self = shift; my $self = shift;
$self->session->db->write( "delete from Survey_response where assetId = ?", $self->session->db->write( "delete from Survey_response where assetId = ?", [ $self->getId() ] );
[ $self->getId() ] ); $self->session->db->write( "delete from Survey_tempReport where assetId = ?", [ $self->getId() ] );
$self->session->db->write( $self->session->db->write( "delete from Survey where assetId = ?", [ $self->getId() ] );
"delete from Survey_tempReport where assetId = ?",
[ $self->getId() ] );
$self->session->db->write( "delete from Survey where assetId = ?",
[ $self->getId() ] );
return $self->SUPER::purge; return $self->SUPER::purge;
} }
@ -581,15 +548,12 @@ sub view {
my $self = shift; my $self = shift;
my %var; my %var;
$var{'edit_survey_url'} = $self->getUrl('func=editSurvey'); $var{'edit_survey_url'} = $self->getUrl('func=editSurvey');
$var{'take_survey_url'} = $self->getUrl('func=takeSurvey'); $var{'take_survey_url'} = $self->getUrl('func=takeSurvey');
$var{'view_reports_url'} = $self->getUrl('func=viewReports'); $var{'view_reports_url'} = $self->getUrl('func=viewReports');
$var{'user_canTakeSurvey'} = $var{'user_canTakeSurvey'} = $self->session->user->isInGroup( $self->get("groupToTakeSurvey") );
$self->session->user->isInGroup( $self->get("groupToTakeSurvey") ); $var{'user_canViewReports'} = $self->session->user->isInGroup( $self->get("groupToViewReports") );
$var{'user_canViewReports'} = $var{'user_canEditSurvey'} = $self->session->user->isInGroup( $self->get("groupToEditSurvey") );
$self->session->user->isInGroup( $self->get("groupToViewReports") );
$var{'user_canEditSurvey'} =
$self->session->user->isInGroup( $self->get("groupToEditSurvey") );
my $out = $self->processTemplate( \%var, undef, $self->{_viewTemplate} ); my $out = $self->processTemplate( \%var, undef, $self->{_viewTemplate} );
return $out; return $out;
@ -613,8 +577,7 @@ sub www_takeSurvey {
my $self = shift; my $self = shift;
my %var; my %var;
my $out = my $out = $self->processTemplate( \%var, $self->get("surveyTakeTemplateId") );
$self->processTemplate( \%var, $self->get("surveyTakeTemplateId") );
eval { eval {
my $responseId = $self->getResponseId(); my $responseId = $self->getResponseId();
@ -660,25 +623,24 @@ sub www_submitQuestions {
my $files = 0; my $files = 0;
# for my $id(@$orderOf){ # for my $id(@$orderOf){
#if a file upload, write to disk #if a file upload, write to disk
# my $path; # my $path;
# if($id->{'questionType'} eq 'File Upload'){ # if($id->{'questionType'} eq 'File Upload'){
# $files = 1; # $files = 1;
# my $storage = WebGUI::Storage->create($self->session); # my $storage = WebGUI::Storage->create($self->session);
# my $filename = $storage->addFileFromFormPost( $id->{'Survey_answerId'} ); # my $filename = $storage->addFileFromFormPost( $id->{'Survey_answerId'} );
# $path = $storage->getPath($filename); # $path = $storage->getPath($filename);
# } # }
#$self->session->errorHandler->error("Inserting a response ".$id->{'Survey_answerId'}." $responseId, $path, ".$$responses{$id->{'Survey_answerId'}}); #$self->session->errorHandler->error("Inserting a response ".$id->{'Survey_answerId'}." $responseId, $path, ".$$responses{$id->{'Survey_answerId'}});
# $self->session->db->write("insert into Survey_questionResponse # $self->session->db->write("insert into Survey_questionResponse
# select ?, Survey_sectionId, Survey_questionId, Survey_answerId, ?, ?, ?, now(), ?, ? from Survey_answer where Survey_answerId = ?", # select ?, Survey_sectionId, Survey_questionId, Survey_answerId, ?, ?, ?, now(), ?, ? from Survey_answer where Survey_answerId = ?",
# [$self->getId(), $responseId, $$responses{ $id->{'Survey_answerId'} }, '', $path, ++$lastOrder, $id->{'Survey_answerId'}]); # [$self->getId(), $responseId, $$responses{ $id->{'Survey_answerId'} }, '', $path, ++$lastOrder, $id->{'Survey_answerId'}]);
# } # }
if ($files) { if ($files) {
##special case, need to check for more questions in section, if not, more current up one ##special case, need to check for more questions in section, if not, more current up one
my $lastA = $self->getLastAnswerInfo($responseId); my $lastA = $self->getLastAnswerInfo($responseId);
my $questionId = my $questionId = $self->getNextQuestionId( $lastA->{'Survey_questionId'} );
$self->getNextQuestionId( $lastA->{'Survey_questionId'} );
if ( !$questionId ) { if ( !$questionId ) {
my $currentSection = $self->getCurrentSection($responseId); my $currentSection = $self->getCurrentSection($responseId);
$currentSection = $self->getNextSection($currentSection); $currentSection = $self->getNextSection($currentSection);
@ -689,7 +651,7 @@ sub www_submitQuestions {
return; return;
} }
return $self->www_loadQuestions($responseId); return $self->www_loadQuestions($responseId);
} } ## end sub www_submitQuestions
#finds the questions to display next and builds the data structre to hold them #finds the questions to display next and builds the data structre to hold them
#------------------------------------------------------------------- #-------------------------------------------------------------------
@ -700,7 +662,7 @@ sub www_loadQuestions {
return $self->surveyEnd(); return $self->surveyEnd();
} }
my $responseId = $self->getResponseId(); #also loads the survey and response my $responseId = $self->getResponseId(); #also loads the survey and response
if ( !$responseId ) { if ( !$responseId ) {
return $self->surveyEnd(); return $self->surveyEnd();
} }
@ -716,20 +678,19 @@ sub www_loadQuestions {
$section->{id} = $self->response->nextSectionId(); $section->{id} = $self->response->nextSectionId();
my $text = $self->prepareShowSurveyTemplate( $section, $questions ); my $text = $self->prepareShowSurveyTemplate( $section, $questions );
return $text; return $text;
} } ## end sub www_loadQuestions
#------------------------------------------------------------------- #-------------------------------------------------------------------
#called when the survey is over. #called when the survey is over.
sub surveyEnd { sub surveyEnd {
my $self = shift; my $self = shift;
my $url = shift; my $url = shift;
my $responseId = $self->getResponseId(); #also loads the survey and response my $responseId = $self->getResponseId(); #also loads the survey and response
# $self->session->db->write("update Survey_response set endDate = ? and isComplete = 1 where Survey_responseId = ?",[WebGUI::DateTime->now->toDatabase,$responseId]); # $self->session->db->write("update Survey_response set endDate = ? and isComplete = 1 where Survey_responseId = ?",[WebGUI::DateTime->now->toDatabase,$responseId]);
$self->session->db->setRow( $self->session->db->setRow(
"Survey_response", "Survey_response",
"Survey_responseId", "Survey_responseId", {
{
Survey_responseId => $responseId, Survey_responseId => $responseId,
endDate => WebGUI::DateTime->now->toDatabase, endDate => WebGUI::DateTime->now->toDatabase,
isComplete => 1 isComplete => 1
@ -738,37 +699,31 @@ sub surveyEnd {
if ( $url !~ /\w/ ) { $url = 0; } if ( $url !~ /\w/ ) { $url = 0; }
if ( $url eq "undefined" ) { $url = 0; } if ( $url eq "undefined" ) { $url = 0; }
if ( !$url ) { if ( !$url ) {
$url = $self->session->db->quickScalar( $url
"select exitURL from Survey where assetId = ? order by revisionDate desc limit 1", = $self->session->db->quickScalar(
[ $self->getId() ] "select exitURL from Survey where assetId = ? order by revisionDate desc limit 1",
); [ $self->getId() ] );
if ( !$url ) { if ( !$url ) {
$url = "/"; $url = "/";
} }
} }
$self->session->http->setMimeType('application/json'); $self->session->http->setMimeType('application/json');
return encode_json( { "type", "forward", "url", $url } ); return encode_json( { "type", "forward", "url", $url } );
} } ## end sub surveyEnd
#------------------------------------------------------------------- #-------------------------------------------------------------------
#sends the processed template and questions structure to the client #sends the processed template and questions structure to the client
sub prepareShowSurveyTemplate { sub prepareShowSurveyTemplate {
my ( $self, $section, $questions ) = @_; my ( $self, $section, $questions ) = @_;
my %multipleChoice = ( my %multipleChoice = (
'Multiple Choice', 1, 'Gender', 1, 'Yes/No', 1, 'Multiple Choice', 1, 'Gender', 1, 'Yes/No', 1, 'True/False', 1, 'Ideology', 1,
'True/False', 1, 'Ideology', 1, 'Race', 1, 'Race', 1, 'Party', 1, 'Education', 1, 'Scale', 1, 'Agree/Disagree', 1,
'Party', 1, 'Education', 1, 'Scale', 1, 'Oppose/Support', 1, 'Importance', 1, 'Likelihood', 1, 'Certainty', 1, 'Satisfaction', 1,
'Agree/Disagree', 1, 'Oppose/Support', 1, 'Importance', 1, 'Confidence', 1, 'Effectiveness', 1, 'Concern', 1, 'Risk', 1, 'Threat', 1,
'Likelihood', 1, 'Certainty', 1, 'Satisfaction', 1, 'Security', 1
'Confidence', 1, 'Effectiveness', 1, 'Concern', 1,
'Risk', 1, 'Threat', 1, 'Security', 1
); );
my %text = ( my %text = ( 'Text', 1, 'Email', 1, 'Phone Number', 1, 'Text Date', 1, 'Currency', 1 );
'Text', 1, 'Email', 1, 'Phone Number', 1, my %slider = ( 'Slider', 1, 'Dual Slider - Range', 1, 'Multi Slider - Allocate', 1 );
'Text Date', 1, 'Currency', 1
);
my %slider =
( 'Slider', 1, 'Dual Slider - Range', 1, 'Multi Slider - Allocate', 1 );
my %dateType = ( 'Date', 1, 'Date Range', 1 ); my %dateType = ( 'Date', 1, 'Date Range', 1 );
my %fileUpload = ( 'File Upload', 1 ); my %fileUpload = ( 'File Upload', 1 );
my %hidden = ( 'Hidden', 1 ); my %hidden = ( 'Hidden', 1 );
@ -799,20 +754,14 @@ sub prepareShowSurveyTemplate {
$$q{'verts'} = "<p>"; $$q{'verts'} = "<p>";
$$q{'verte'} = "</p>"; $$q{'verte'} = "</p>";
} }
} } ## end foreach my $q (@$questions)
$section->{'questions'} = $questions; $section->{'questions'} = $questions;
my $out = my $out = $self->processTemplate( $section, $self->get("surveyQuestionsId") );
$self->processTemplate( $section, $self->get("surveyQuestionsId") );
$self->session->http->setMimeType('application/json'); $self->session->http->setMimeType('application/json');
return encode_json( return encode_json( { "type", "displayquestions", "section", $section, "questions", $questions, "html", $out } );
{ } ## end sub prepareShowSurveyTemplate
"type", "displayquestions", "section", $section,
"questions", $questions, "html", $out
}
);
}
#------------------------------------------------------------------- #-------------------------------------------------------------------
@ -837,16 +786,15 @@ sub loadResponseJSON {
$rId = defined $rId ? $rId : $self->{responseId}; $rId = defined $rId ? $rId : $self->{responseId};
if ( defined $self->response and !defined $rId ) { return; } if ( defined $self->response and !defined $rId ) { return; }
$jsonHash = $self->session->db->quickScalar( $jsonHash
"select responseJSON from Survey_response where assetId = ? and Survey_responseId = ?", = $self->session->db->quickScalar(
[ $self->getId, $rId ] "select responseJSON from Survey_response where assetId = ? and Survey_responseId = ?",
) if ( !defined $jsonHash ); [ $self->getId, $rId ] )
if ( !defined $jsonHash );
$self->{response} = $self->{response}
WebGUI::Asset::Wobject::Survey::ResponseJSON->new( $jsonHash, = WebGUI::Asset::Wobject::Survey::ResponseJSON->new( $jsonHash, $self->session->errorHandler, $self->survey );
$self->session->errorHandler, } ## end sub loadResponseJSON
$self->survey );
}
#------------------------------------------------------------------- #-------------------------------------------------------------------
sub saveResponseJSON { sub saveResponseJSON {
@ -854,10 +802,8 @@ sub saveResponseJSON {
my $data = $self->response->freeze(); my $data = $self->response->freeze();
$self->session->db->write( $self->session->db->write( "update Survey_response set responseJSON = ? where Survey_responseId = ?",
"update Survey_response set responseJSON = ? where Survey_responseId = ?", [ $data, $self->{responseId} ] );
[ $data, $self->{responseId} ]
);
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
@ -875,10 +821,10 @@ sub getResponseId {
my $ip = $self->session->env->getIp; my $ip = $self->session->env->getIp;
my $id = $self->session->user->userId(); my $id = $self->session->user->userId();
my $anonId = my $anonId
$self->session->form->process("userid") = $self->session->form->process("userid")
|| $self->session->http->getCookies->{"Survey2AnonId"} || $self->session->http->getCookies->{"Survey2AnonId"}
|| undef; || undef;
$self->session->http->setCookie( "Survey2AnonId", $anonId ) if ($anonId); $self->session->http->setCookie( "Survey2AnonId", $anonId ) if ($anonId);
my $responseId; my $responseId;
@ -892,44 +838,43 @@ sub getResponseId {
$string = 'anonId'; $string = 'anonId';
$id = $anonId; $id = $anonId;
} }
$responseId = $self->session->db->quickScalar( $responseId
"select Survey_responseId from Survey_response where $string = ? and assetId = ? and isComplete = 0", = $self->session->db->quickScalar(
[ $id, $self->getId() ] "select Survey_responseId from Survey_response where $string = ? and assetId = ? and isComplete = 0",
); [ $id, $self->getId() ] );
} }
elsif ( $id == 1 ) { elsif ( $id == 1 ) {
$responseId = $self->session->db->quickScalar( $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() ] [ $id, $ip, $self->getId() ]
); );
} }
if ( !$responseId ) { if ( !$responseId ) {
my $allowedTakes = $self->session->db->quickScalar( my $allowedTakes
"select maxResponsesPerUser from Survey where assetId = ? order by revisionDate desc limit 1", = $self->session->db->quickScalar(
[ $self->getId() ] "select maxResponsesPerUser from Survey where assetId = ? order by revisionDate desc limit 1",
); [ $self->getId() ] );
my $haveTaken; my $haveTaken;
if ( $id == 1 ) { if ( $id == 1 ) {
$haveTaken = $self->session->db->quickScalar( $haveTaken
"select count(*) from Survey_response where userId = ? and ipAddress = ? and assetId = ?", = $self->session->db->quickScalar(
[ $id, $ip, $self->getId() ] "select count(*) from Survey_response where userId = ? and ipAddress = ? and assetId = ?",
); [ $id, $ip, $self->getId() ] );
} }
else { else {
$haveTaken = $self->session->db->quickScalar( $haveTaken
"select count(*) from Survey_response where $string = ? and assetId = ?", = $self->session->db->quickScalar(
[ $id, $self->getId() ] "select count(*) from Survey_response where $string = ? and assetId = ?",
); [ $id, $self->getId() ] );
} }
if ( $haveTaken < $allowedTakes ) { if ( $haveTaken < $allowedTakes ) {
$responseId = $self->session->db->setRow( $responseId = $self->session->db->setRow(
"Survey_response", "Survey_response",
"Survey_responseId", "Survey_responseId", {
{
Survey_responseId => "new", Survey_responseId => "new",
userId => $id, userId => $id,
ipAddress => $ip, ipAddress => $ip,
@ -944,14 +889,14 @@ sub getResponseId {
$self->response->createSurveyOrder(); $self->response->createSurveyOrder();
$self->{responseId} = $responseId; $self->{responseId} = $responseId;
$self->saveResponseJSON(); $self->saveResponseJSON();
} } ## end if ( $haveTaken < $allowedTakes)
else { else {
} }
} } ## end if ( !$responseId )
$self->{responseId} = $responseId; $self->{responseId} = $responseId;
$self->loadBothJSON($responseId); $self->loadBothJSON($responseId);
return $responseId; return $responseId;
} } ## end sub getResponseId
#------------------------------------------------------------------- #-------------------------------------------------------------------
@ -972,15 +917,15 @@ sub canTakeSurvey {
if ( $id == 1 ) { if ( $id == 1 ) {
$takenCount = $self->session->db->quickScalar( $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 ] and isComplete = ?", [ $id, $ip, $self->getId(), 1 ]
); );
} }
else { else {
$takenCount = $self->session->db->quickScalar( $takenCount
"select count(*) from Survey_response where userId = ? and assetId = ? and isComplete = ?", = $self->session->db->quickScalar(
[ $id, $self->getId(), 1 ] "select count(*) from Survey_response where userId = ? and assetId = ? and isComplete = ?",
); [ $id, $self->getId(), 1 ] );
} }
if ( $takenCount >= $maxTakes ) { if ( $takenCount >= $maxTakes ) {
@ -991,21 +936,19 @@ sub canTakeSurvey {
} }
return $self->{canTake}; return $self->{canTake};
} } ## end sub canTakeSurvey
#------------------------------------------------------------------- #-------------------------------------------------------------------
sub www_viewReports { sub www_viewReports {
my $self = shift; my $self = shift;
$self->loadTempReportTable(); $self->loadTempReportTable();
return "" return ""
unless ( unless ( $self->session->user->isInGroup( $self->get("groupToViewReports") ) );
$self->session->user->isInGroup( $self->get("groupToViewReports") ) ); my $filename = $self->session->url->escape( $self->get("title") . "_results.tab" );
my $filename = my $content
$self->session->url->escape( $self->get("title") . "_results.tab" ); = $self->session->db->quickTab(
my $content = $self->session->db->quickTab( "select * from Survey_tempReport t where t.assetId=? order by t.Survey_responseId, t.order",
"select * from Survey_tempReport t where t.assetId=? order by t.Survey_responseId, t.order", [ $self->getId() ] );
[ $self->getId() ]
);
return $self->export( $filename, $content ); return $self->export( $filename, $content );
} }
@ -1021,8 +964,7 @@ sub export {
my $tmpDir = $store->getPath(); my $tmpDir = $store->getPath();
my $filepath = $store->getPath($filename); my $filepath = $store->getPath($filename);
unless ( open TEMP, ">$filepath" ) { unless ( open TEMP, ">$filepath" ) {
return return "Error - Could not open temporary file for writing. Please use the back button and try again";
"Error - Could not open temporary file for writing. Please use the back button and try again";
} }
print TEMP $content; print TEMP $content;
close TEMP; close TEMP;
@ -1031,57 +973,44 @@ sub export {
$self->session->http->setRedirect($fileurl); $self->session->http->setRedirect($fileurl);
return undef; return undef;
} } ## end sub export
sub loadTempReportTable { sub loadTempReportTable {
my $self = shift; my $self = shift;
$self->loadSurveyJSON(); $self->loadSurveyJSON();
my $refs = $self->session->db->buildArrayRefOfHashRefs( my $refs = $self->session->db->buildArrayRefOfHashRefs( "select * from Survey_response where assetId = ?",
"select * from Survey_response where assetId = ?",
[ $self->getId() ] );
$self->session->db->write(
"delete from Survey_tempReport where assetId = ?",
[ $self->getId() ] ); [ $self->getId() ] );
$self->session->db->write( "delete from Survey_tempReport where assetId = ?", [ $self->getId() ] );
for my $ref (@$refs) { for my $ref (@$refs) {
$self->loadResponseJSON( undef, $ref->{Survey_responseId} ); $self->loadResponseJSON( undef, $ref->{Survey_responseId} );
my $count = 1; my $count = 1;
for my $q ( @{ $self->response->returnResponseForReporting() } ) { for my $q ( @{ $self->response->returnResponseForReporting() } ) {
if ( @{ $q->{answers} } == 0 and $q->{comment} =~ /\w/ ) { if ( @{ $q->{answers} } == 0 and $q->{comment} =~ /\w/ ) {
$self->session->db->write( $self->session->db->write(
"insert into Survey_tempReport VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)", "insert into Survey_tempReport VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)", [
[ $self->getId(), $ref->{Survey_responseId}, $count++, $q->{section},
$self->getId(), $ref->{Survey_responseId}, $q->{sectionName}, $q->{question}, $q->{questionName}, $q->{questionComment},
$count++, $q->{section}, undef, undef, undef, undef,
$q->{sectionName}, $q->{question}, undef, undef, undef
$q->{questionName}, $q->{questionComment},
undef, undef,
undef, undef,
undef, undef,
undef
] ]
); );
next; next;
} }
for my $a ( @{ $q->{answers} } ) { for my $a ( @{ $q->{answers} } ) {
$self->session->db->write( $self->session->db->write(
"insert into Survey_tempReport VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)", "insert into Survey_tempReport VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)", [
[ $self->getId(), $ref->{Survey_responseId}, $count++, $q->{section},
$self->getId(), $ref->{Survey_responseId}, $q->{sectionName}, $q->{question}, $q->{questionName}, $q->{questionComment},
$count++, $q->{section}, $a->{id}, $a->{value}, $a->{comment}, $a->{time},
$q->{sectionName}, $q->{question}, $a->{isCorrect}, $a->{value}, undef
$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; return 1;
} } ## end sub loadTempReportTable
sub log { sub log {
my $self = shift; my $self = shift;

187
lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm
View file

@ -13,17 +13,15 @@ sub new {
$self->{survey} = $survey; $self->{survey} = $survey;
$self->{log} = $log; $self->{log} = $log;
my $temp = decode_json($json) if defined $json; my $temp = decode_json($json) if defined $json;
$self->{surveyOrder} = $self->{surveyOrder}
defined $temp->{surveyOrder} = defined $temp->{surveyOrder}
? $temp->{surveyOrder} ? $temp->{surveyOrder}
: [] : []; #an array of question addresses, with the third member being an array of answers
; #an array of question addresses, with the third member being an array of answers $self->{responses} = defined $temp->{responses} ? $temp->{responses} : {};
$self->{responses} = defined $temp->{responses} ? $temp->{responses} : {}; $self->{lastResponse} = defined $temp->{lastResponse} ? $temp->{lastResponse} : -1;
$self->{lastResponse} =
defined $temp->{lastResponse} ? $temp->{lastResponse} : -1;
bless( $self, $class ); bless( $self, $class );
return $self; return $self;
} } ## end sub new
#---------------------------------------------------------------------------- #----------------------------------------------------------------------------
@ -39,20 +37,18 @@ sub createSurveyOrder {
my $self = shift; my $self = shift;
my $order; my $order;
my $qstarting = 0; 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 #create question order for section
my @qorder; my @qorder;
if ( $self->survey->section( [$s] )->{randomizeQuestions} ) { if ( $self->survey->section( [$s] )->{randomizeQuestions} ) {
@qorder = shuffle( @qorder = shuffle( ( $qstarting .. $#{ $self->survey->questions( [$s] ) } ) );
( $qstarting .. $#{ $self->survey->questions( [$s] ) } ) );
} }
else { else {
@qorder = @qorder = ( ( $qstarting .. $#{ $self->survey->questions( [$s] ) } ) );
( ( $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 ) { if ( @qorder == 0 ) {
push( @$order, [$s] ); push( @$order, [$s] );
} }
@ -62,26 +58,16 @@ sub createSurveyOrder {
for (@qorder) { for (@qorder) {
my @aorder; my @aorder;
if ( $self->survey->question( [ $s, $_ ] )->{randomizeAnswers} ) { if ( $self->survey->question( [ $s, $_ ] )->{randomizeAnswers} ) {
@aorder = shuffle( @aorder = shuffle( ( $qstarting .. $#{ $self->survey->question( [ $s, $_ ] )->{answers} } ) );
(
$qstarting ..
$#{ $self->survey->question( [ $s, $_ ] )->{answers} }
)
);
} }
else { else {
@aorder = ( @aorder = ( ( $qstarting .. $#{ $self->survey->question( [ $s, $_ ] )->{answers} } ) );
(
$qstarting ..
$#{ $self->survey->question( [ $s, $_ ] )->{answers} }
)
);
} }
push( @$order, [ $s, $_, \@aorder ] ); push( @$order, [ $s, $_, \@aorder ] );
} }
} } ## end for ( my $s = 0; $s <= ...
$self->{surveyOrder} = $order; $self->{surveyOrder} = $order;
} } ## end sub createSurveyOrder
sub shuffle { sub shuffle {
my @a = splice @_; my @a = splice @_;
@ -125,14 +111,12 @@ sub nextSectionId {
sub nextSection { sub nextSection {
my $self = shift; my $self = shift;
return $self->survey->section( return $self->survey->section( [ $self->surveyOrder->[ $self->lastResponse + 1 ]->[0] ] );
[ $self->surveyOrder->[ $self->lastResponse + 1 ]->[0] ] );
} }
sub currentSection { sub currentSection {
my $self = shift; my $self = shift;
return $self->survey->section( return $self->survey->section( [ $self->surveyOrder->[ $self->lastResponse ]->[0] ] );
[ $self->surveyOrder->[ $self->lastResponse ]->[0] ] );
} }
sub recordResponses { sub recordResponses {
@ -141,23 +125,19 @@ sub recordResponses {
my $session = shift; my $session = shift;
my %mcTypes = ( my %mcTypes = (
'Agree/Disagree', 1, 'Certainty', 1, 'Concern', 1, 'Agree/Disagree', 1, 'Certainty', 1, 'Concern', 1, 'Confidence', 1, 'Education', 1,
'Confidence', 1, 'Education', 1, 'Effectiveness', 1, 'Effectiveness', 1, 'Gender', 1, 'Ideology', 1, 'Importance', 1, 'Likelihood', 1,
'Gender', 1, 'Ideology', 1, 'Importance', 1, 'Party', 1, 'Multiple Choice', 1, 'Oppose/Support', 1, 'Race', 1, 'Risk', 1,
'Likelihood', 1, 'Party', 1, 'Multiple Choice', 1, 'Satisfaction', 1, 'Scale', 1, 'Security', 1, 'Threat', 1, 'True/False', 1,
'Oppose/Support', 1, 'Race', 1, 'Risk', 1, 'Yes/No', 1
'Satisfaction', 1, 'Scale', 1, 'Security', 1,
'Threat', 1, 'True/False', 1, 'Yes/No', 1
); );
my %sliderTypes = my %sliderTypes = ( 'Dual Slider - Range', 1, 'Multi Slider - Allocate', 1, 'Slider', 1 );
( 'Dual Slider - Range', 1, 'Multi Slider - Allocate', 1, 'Slider', 1 ); my %textTypes = ( 'Currency', 'Email', 1, 'Phone Number', 1, 'Text', 1, 'Text Date', 1 );
my %textTypes =
( 'Currency', 'Email', 1, 'Phone Number', 1, 'Text', 1, 'Text Date', 1 );
my %fileTypes = ( 'File Upload', 1 ); my %fileTypes = ( 'File Upload', 1 );
my %dateTypes = ( 'Date', 'Date Range', 1 ); my %dateTypes = ( 'Date', 'Date Range', 1 );
my %hiddenTypes = ( 'Hidden', 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 $questions = $self->nextQuestions();
my $qAnswered = 1; my $qAnswered = 1;
my $terminal = 0; my $terminal = 0;
@ -171,7 +151,7 @@ sub recordResponses {
$terminalUrl = $section->{terminalUrl}; $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' ) { if ( ref $questions ne 'ARRAY' ) {
$self->lastResponse( $self->lastResponse + 1 ); $self->lastResponse( $self->lastResponse + 1 );
return [ $terminal, $terminalUrl ]; return [ $terminal, $terminalUrl ];
@ -183,8 +163,7 @@ sub recordResponses {
$terminal = 1; $terminal = 1;
$terminalUrl = $question->{terminalUrl}; $terminalUrl = $question->{terminalUrl};
} }
$self->responses->{ $question->{id} }->{comment} = $self->responses->{ $question->{id} }->{comment} = $responses->{ $question->{id} . "comment" };
$responses->{ $question->{id} . "comment" };
for my $answer ( @{ $question->{answers} } ) { for my $answer ( @{ $question->{answers} } ) {
if ( defined( $responses->{ $answer->{id} } ) if ( defined( $responses->{ $answer->{id} } )
@ -193,16 +172,13 @@ sub recordResponses {
$aAnswered = 1; $aAnswered = 1;
if ( $mcTypes{ $question->{questionType} } ) { if ( $mcTypes{ $question->{questionType} } ) {
$self->responses->{ $answer->{id} }->{value} = $self->responses->{ $answer->{id} }->{value} = $answer->{recordedAnswer};
$answer->{recordedAnswer};
} }
else { else {
$self->responses->{ $answer->{id} }->{value} = $self->responses->{ $answer->{id} }->{value} = $responses->{ $answer->{id} };
$responses->{ $answer->{id} };
} }
$self->responses->{ $answer->{id} }->{'time'} = time(); $self->responses->{ $answer->{id} }->{'time'} = time();
$self->responses->{ $answer->{id} }->{comment} = $self->responses->{ $answer->{id} }->{comment} = $responses->{ $answer->{id} . "comment" };
$responses->{ $answer->{id} . "comment" };
if ( $answer->{terminal} ) { if ( $answer->{terminal} ) {
$terminal = 1; $terminal = 1;
@ -211,12 +187,12 @@ sub recordResponses {
elsif ( $answer->{goto} =~ /\w/ ) { elsif ( $answer->{goto} =~ /\w/ ) {
$goto = $answer->{goto}; $goto = $answer->{goto};
} }
} } ## end if ( defined( $responses...
} } ## end for my $answer ( @{ $question...
$qAnswered = 0 if ( !$aAnswered and $question->{required} ); $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) { if ($qAnswered) {
$self->lastResponse( $self->lastResponse + @$questions ); $self->lastResponse( $self->lastResponse + @$questions );
$self->goto($goto) if ( defined $goto ); $self->goto($goto) if ( defined $goto );
@ -225,12 +201,12 @@ sub recordResponses {
$terminal = 0; $terminal = 0;
} }
return [ $terminal, $terminalUrl ]; return [ $terminal, $terminalUrl ];
} } ## end sub recordResponses
sub goto { sub goto {
my $self = shift; my $self = shift;
my $goto = 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 $section = $self->survey->section( $self->surveyOrder()->[$i] );
my $question = $self->survey->question( $self->surveyOrder()->[$i] ); my $question = $self->survey->question( $self->surveyOrder()->[$i] );
if ( ref $section eq 'HASH' and $section->{variable} eq $goto ) { if ( ref $section eq 'HASH' and $section->{variable} eq $goto ) {
@ -242,7 +218,7 @@ sub goto {
last; last;
} }
} }
} } ## end sub goto
sub getPreviousAnswer { sub getPreviousAnswer {
my $self = shift; my $self = shift;
@ -251,14 +227,8 @@ sub getPreviousAnswer {
my $question = $self->survey->question( [ $$q[0], $$q[1] ] ); my $question = $self->survey->question( [ $$q[0], $$q[1] ] );
if ( $question->{variable} eq $questionParam ) { if ( $question->{variable} eq $questionParam ) {
for ( 0 .. @{ $self->survey->answers( [ $$q[0], $$q[1] ] ) } ) { for ( 0 .. @{ $self->survey->answers( [ $$q[0], $$q[1] ] ) } ) {
if ( if ( exists $self->responses->{ $$q[0] . "-" . $$q[1] . "-" . $_ } ) {
exists $self->responses->{ $$q[0] . "-" return $self->responses->{ $$q[0] . "-" . $$q[1] . "-" . $_ }->{value};
. $$q[1] . "-"
. $_ } )
{
return $self->responses->{ $$q[0] . "-"
. $$q[1] . "-"
. $_ }->{value};
} }
} }
} }
@ -274,41 +244,36 @@ sub nextQuestions {
my $nextSectionId = $self->nextSectionId; my $nextSectionId = $self->nextSectionId;
my $qPerPage = my $qPerPage = $self->survey->section( [ $self->nextSectionId ] )->{questionsPerPage};
$self->survey->section( [ $self->nextSectionId ] )->{questionsPerPage};
#load Previous answer text #load Previous answer text
my $section = $self->nextSection(); my $section = $self->nextSection();
$section->{'text'} =~ s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg; $section->{'text'} =~ s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg;
my $questions; my $questions;
for ( my $i = 1 ; $i <= $qPerPage ; $i++ ) { for ( my $i = 1; $i <= $qPerPage; $i++ ) {
my $qAddy = $self->surveyOrder->[ $self->lastResponse + $i ]; my $qAddy = $self->surveyOrder->[ $self->lastResponse + $i ];
next next
if ( !exists $$qAddy[1] ) if ( !exists $$qAddy[1] ); #skip this if it doesn't have a question (for sections with no questions)
; #skip this if it doesn't have a question (for sections with no questions)
if ( $$qAddy[0] != $nextSectionId ) { if ( $$qAddy[0] != $nextSectionId ) {
last; last;
} }
my %question = my %question = %{ $self->survey->question( [ $$qAddy[0], $$qAddy[1] ] ) };
%{ $self->survey->question( [ $$qAddy[0], $$qAddy[1] ] ) }; $question{'text'} =~ s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg;
$question{'text'} =~
s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg;
delete $question{answers}; delete $question{answers};
$question{id} = "$$qAddy[0]-$$qAddy[1]"; $question{id} = "$$qAddy[0]-$$qAddy[1]";
$question{sid} = "$$qAddy[0]"; $question{sid} = "$$qAddy[0]";
for ( @{ $$qAddy[2] } ) { for ( @{ $$qAddy[2] } ) {
my $ans = $self->survey->answer( [ $$qAddy[0], $$qAddy[1], $_ ] ); my $ans = $self->survey->answer( [ $$qAddy[0], $$qAddy[1], $_ ] );
$ans->{'text'} =~ $ans->{'text'} =~ s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg;
s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg;
$ans->{id} = "$$qAddy[0]-$$qAddy[1]-$_"; $ans->{id} = "$$qAddy[0]-$$qAddy[1]-$_";
push( @{ $question{answers} }, $ans ); push( @{ $question{answers} }, $ans );
} }
push( @$questions, \%question ); push( @$questions, \%question );
} } ## end for ( my $i = 1; $i <= ...
return $questions; return $questions;
} } ## end sub nextQuestions
sub surveyEnd { sub surveyEnd {
my $self = shift; my $self = shift;
@ -327,57 +292,37 @@ sub returnResponseForReporting {
for ( @{ $$entry[2] } ) { for ( @{ $$entry[2] } ) {
if ( defined $self->responses->{"$$entry[0]-$$entry[1]-$_"} ) { if ( defined $self->responses->{"$$entry[0]-$$entry[1]-$_"} ) {
$self->responses->{"$$entry[0]-$$entry[1]-$_"}->{id} = $_; $self->responses->{"$$entry[0]-$$entry[1]-$_"}->{id} = $_;
if ( $self->survey->answer( [ $$entry[0], $$entry[1], $_ ] ) if ( $self->survey->answer( [ $$entry[0], $$entry[1], $_ ] )->{isCorrect} ) {
->{isCorrect} )
{
my $value; my $value;
if ( $self->survey->answer( [ $$entry[0], $$entry[1], $_ ] ) if ( $self->survey->answer( [ $$entry[0], $$entry[1], $_ ] )->{value} =~ /\w/ ) {
->{value} =~ /\w/ ) $value = $self->survey->answer( [ $$entry[0], $$entry[1], $_ ] )->{value};
{
$value = $self->survey->answer(
[ $$entry[0], $$entry[1], $_ ] )->{value};
} }
else { else {
$value = $value = $self->survey->question( [ $$entry[0], $$entry[1] ] )->{value};
$self->survey->question( [ $$entry[0], $$entry[1] ] )
->{value};
} }
$self->responses->{"$$entry[0]-$$entry[1]-$_"}->{value} = $self->responses->{"$$entry[0]-$$entry[1]-$_"}->{value} = $value;
$value; $self->responses->{"$$entry[0]-$$entry[1]-$_"}->{isCorrect} = 1;
$self->responses->{"$$entry[0]-$$entry[1]-$_"}
->{isCorrect} = 1;
} }
else { else {
$self->responses->{"$$entry[0]-$$entry[1]-$_"} $self->responses->{"$$entry[0]-$$entry[1]-$_"}->{isCorrect} = 0;
->{isCorrect} = 0;
} }
push( @answers, push( @answers, ( $self->responses->{"$$entry[0]-$$entry[1]-$_"} ) );
( $self->responses->{"$$entry[0]-$$entry[1]-$_"} ) ); } ## end if ( defined $self->responses...
} } ## end for ( @{ $$entry[2] } )
}
push( push(
@responses, @responses, ( {
( 'section', $$entry[0],
{ 'question', $$entry[1],
'section', 'sectionName', $self->survey->section( [ $$entry[0] ] )->{variable},
$$entry[0], 'questionName', $self->survey->question( [ $$entry[0], $$entry[1] ] )->{variable},
'question', 'questionComment', $self->responses->{"$$entry[0]-$$entry[1]"}->{comment},
$$entry[1], 'answers', \@answers
'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; 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. #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. #Questions only contain the comment and an array of answer Responses.

182
lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm
View file

@ -18,7 +18,7 @@ sub new {
$self->newObject( [] ); $self->newObject( [] );
} }
return $self; return $self;
} } ## end sub new
sub freeze { sub freeze {
my $self = shift; my $self = shift;
@ -45,7 +45,7 @@ sub newObject {
$$address[2] = $#{ $self->answers($address) }; $$address[2] = $#{ $self->answers($address) };
return $address; return $address;
} }
} } ## end sub newObject
#address is the array of objects currently selected in the edit screen #address is the array of objects currently selected in the edit screen
#data is the array of hash items for displaying #data is the array of hash items for displaying
@ -53,40 +53,32 @@ sub getDragDropList {
my $self = shift; my $self = shift;
my $address = shift; my $address = shift;
my @data; my @data;
for ( my $i = 0 ; $i <= $#{ $self->sections } ; $i++ ) { for ( my $i = 0; $i <= $#{ $self->sections }; $i++ ) {
push( @data, push( @data, { text => $self->section( [$i] )->{title}, type => 'section' } );
{ text => $self->section( [$i] )->{title}, type => 'section' } );
if ( $address->[0] == $i ) { if ( $address->[0] == $i ) {
for ( my $x = 0 ; $x <= $#{ $self->questions($address) } ; $x++ ) { for ( my $x = 0; $x <= $#{ $self->questions($address) }; $x++ ) {
push( push(
@data, @data, {
{
text => $self->question( [ $i, $x ] )->{text}, text => $self->question( [ $i, $x ] )->{text},
type => 'question' type => 'question'
} }
); );
if ( $address->[1] == $x ) { if ( $address->[1] == $x ) {
for ( for ( my $y = 0; $y <= $#{ $self->answers($address) }; $y++ ) {
my $y = 0 ;
$y <= $#{ $self->answers($address) } ;
$y++
)
{
push( push(
@data, @data, {
{
text => $self->answer( [ $i, $x, $y ] )->{text}, text => $self->answer( [ $i, $x, $y ] )->{text},
type => 'answer' type => 'answer'
} }
); );
} }
} }
} } ## end for ( my $x = 0; $x <= ...
} } ## end if ( $address->[0] == ...
} } ## end for ( my $i = 0; $i <= ...
return \@data; return \@data;
} } ## end sub getDragDropList
sub getObject { sub getObject {
my ( $self, $address ) = @_; my ( $self, $address ) = @_;
@ -94,12 +86,10 @@ sub getObject {
return $self->{sections}->[ $address->[0] ]; return $self->{sections}->[ $address->[0] ];
} }
elsif ( @$address == 2 ) { elsif ( @$address == 2 ) {
return $self->{sections}->[ $address->[0] ]->{questions} return $self->{sections}->[ $address->[0] ]->{questions}->[ $address->[1] ];
->[ $address->[1] ];
} }
else { else {
return $self->{sections}->[ $address->[0] ]->{questions} return $self->{sections}->[ $address->[0] ]->{questions}->[ $address->[1] ]->{answers}->[ $address->[2] ];
->[ $address->[1] ]->{answers}->[ $address->[2] ];
} }
} }
@ -138,7 +128,7 @@ sub getSectionEditVars {
} }
} }
return \%var; return \%var;
} } ## end sub getSectionEditVars
sub getQuestionEditVars { sub getQuestionEditVars {
my $self = shift; my $self = shift;
@ -150,22 +140,14 @@ sub getQuestionEditVars {
delete $var{answers}; delete $var{answers};
delete $var{questionType}; delete $var{questionType};
my @types = ( my @types = (
'Agree/Disagree', 'Certainty', 'Agree/Disagree', 'Certainty', 'Concern', 'Confidence',
'Concern', 'Confidence', 'Currency', 'Date', 'Date Range', 'Dual Slider - Range',
'Currency', 'Date', 'Education', 'Effectiveness', 'Email', 'File Upload',
'Date Range', 'Dual Slider - Range', 'Gender', 'Hidden', 'Ideology', 'Importance',
'Education', 'Effectiveness', 'Likelihood', 'Multi Slider - Allocate', 'Multiple Choice', 'Oppose/Support',
'Email', 'File Upload', 'Party', 'Phone Number', 'Race', 'Risk',
'Gender', 'Hidden', 'Satisfaction', 'Scale', 'Security', 'Slider',
'Ideology', 'Importance', 'Text', 'Text Date', 'Threat', 'True/False',
'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' 'Yes/No'
); );
@ -178,14 +160,14 @@ sub getQuestionEditVars {
} }
} }
return \%var; return \%var;
} } ## end sub getQuestionEditVars
sub getAnswerEditVars { sub getAnswerEditVars {
my $self = shift; my $self = shift;
my $address = shift; my $address = shift;
my $object = $self->answer($address); my $object = $self->answer($address);
my %var = %{$object}; 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; $var{displayed_id} = $address->[2] + 1;
return \%var; return \%var;
} }
@ -217,15 +199,14 @@ sub update {
} }
} }
if ( @$address == 2 and !$newQuestion ) { 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} ); $self->updateQuestionAnswers( $address, $ref->{questionType} );
} }
} }
for my $key ( keys %$object ) { for my $key ( keys %$object ) {
$object->{$key} = $ref->{$key} if ( defined $$ref{$key} ); $object->{$key} = $ref->{$key} if ( defined $$ref{$key} );
} }
} } ## end sub update
#determine what to add and add it. #determine what to add and add it.
# ref should contain all the information for the new # ref should contain all the information for the new
@ -262,8 +243,7 @@ sub remove {
my ( $self, $address, $movingOverride ) = @_; my ( $self, $address, $movingOverride ) = @_;
if ( @$address == 1 ) { if ( @$address == 1 ) {
splice( @{ $self->{sections} }, $$address[0], 1 ) splice( @{ $self->{sections} }, $$address[0], 1 )
if ( $$address[0] != 0 or defined $movingOverride ) if ( $$address[0] != 0 or defined $movingOverride ); #can't delete the first section
; #can't delete the first section
} }
elsif ( @$address == 2 ) { elsif ( @$address == 2 ) {
splice( @{ $self->questions($address) }, $$address[1], 1 ); splice( @{ $self->questions($address) }, $$address[1], 1 );
@ -275,18 +255,12 @@ sub remove {
sub newSection { sub newSection {
my %members = ( my %members = (
'text', '', 'text', '', 'title', 'NEW SECTION',
'title', 'NEW SECTION', 'variable', '', 'questionsPerPage', 5,
'variable', '', 'questionsOnSectionPage', 1, 'randomizeQuestions', 0,
'questionsPerPage', 5, 'everyPageTitle', 1, 'everyPageText', 1,
'questionsOnSectionPage', 1, 'terminal', 0, 'terminalUrl', '',
'randomizeQuestions', 0, 'goto', '', 'timeLimit', 0,
'everyPageTitle', 1,
'everyPageText', 1,
'terminal', 0,
'terminalUrl', '',
'goto', '',
'timeLimit', 0,
'type', 'section' 'type', 'section'
); );
$members{questions} = []; $members{questions} = [];
@ -315,17 +289,12 @@ sub newQuestion {
); );
$members{answers} = []; $members{answers} = [];
return \%members; return \%members;
} } ## end sub newQuestion
sub newAnswer { sub newAnswer {
my %members = ( my %members = (
'text', '', 'verbatim', 0, 'text', '', 'verbatim', 0, 'textCols', 10, 'textRows', 5, 'goto', '', 'recordedAnswer', '', 'isCorrect', 1,
'textCols', 10, 'textRows', 5, 'min', 1, 'max', 10, 'step', 1, 'value', 1, 'terminal', 0, 'terminalUrl', '', 'type', 'answer'
'goto', '', 'recordedAnswer', '',
'isCorrect', 1, 'min', 1,
'max', 10, 'step', 1,
'value', 1, 'terminal', 0,
'terminalUrl', '', 'type', 'answer'
); );
return \%members; return \%members;
} }
@ -380,20 +349,12 @@ sub updateQuestionAnswers {
$self->addAnswersToQuestion( \@addy, \@ans, { 7, 1 } ); $self->addAnswersToQuestion( \@addy, \@ans, { 7, 1 } );
} }
elsif ( $type eq 'Party' ) { elsif ( $type eq 'Party' ) {
my @ans = ( my @ans = ( 'Democratic party', 'Republican party (or GOP)', 'Independant party', 'Other party (verbatim)' );
'Democratic party',
'Republican party (or GOP)',
'Independant party',
'Other party (verbatim)'
);
$self->addAnswersToQuestion( \@addy, \@ans, { 3, 1 } ); $self->addAnswersToQuestion( \@addy, \@ans, { 3, 1 } );
} }
elsif ( $type eq 'Race' ) { elsif ( $type eq 'Race' ) {
my @ans = ( my @ans
'American Indian', 'Asian', = ( 'American Indian', 'Asian', 'Black', 'Hispanic', 'White non-Hispanic', 'Something else (verbatim)' );
'Black', 'Hispanic',
'White non-Hispanic', 'Something else (verbatim)'
);
$self->addAnswersToQuestion( \@addy, \@ans, { 5, 1 } ); $self->addAnswersToQuestion( \@addy, \@ans, { 5, 1 } );
} }
elsif ( $type eq 'Ideology' ) { elsif ( $type eq 'Ideology' ) {
@ -409,69 +370,43 @@ sub updateQuestionAnswers {
$self->addAnswersToQuestion( \@addy, \@ans, {} ); $self->addAnswersToQuestion( \@addy, \@ans, {} );
} }
elsif ( $type eq 'Security' ) { elsif ( $type eq 'Security' ) {
my @ans = ( my @ans = ( 'Not at all secure', '', '', '', '', '', '', '', '', '', 'Extremely secure' );
'Not at all secure',
'', '', '', '', '', '', '', '', '', 'Extremely secure'
);
$self->addAnswersToQuestion( \@addy, \@ans, {} ); $self->addAnswersToQuestion( \@addy, \@ans, {} );
} }
elsif ( $type eq 'Threat' ) { elsif ( $type eq 'Threat' ) {
my @ans = my @ans = ( 'No threat', '', '', '', '', '', '', '', '', '', 'Extreme threat' );
( 'No threat', '', '', '', '', '', '', '', '', '', 'Extreme threat' );
$self->addAnswersToQuestion( \@addy, \@ans, {} ); $self->addAnswersToQuestion( \@addy, \@ans, {} );
} }
elsif ( $type eq 'Risk' ) { elsif ( $type eq 'Risk' ) {
my @ans = my @ans = ( 'No risk', '', '', '', '', '', '', '', '', '', 'Extreme risk' );
( 'No risk', '', '', '', '', '', '', '', '', '', 'Extreme risk' );
$self->addAnswersToQuestion( \@addy, \@ans, {} ); $self->addAnswersToQuestion( \@addy, \@ans, {} );
} }
elsif ( $type eq 'Concern' ) { elsif ( $type eq 'Concern' ) {
my @ans = ( my @ans = ( 'Not at all concerned', '', '', '', '', '', '', '', '', '', 'Extremely concerned' );
'Not at all concerned',
'', '', '', '', '', '', '', '', '', 'Extremely concerned'
);
$self->addAnswersToQuestion( \@addy, \@ans, {} ); $self->addAnswersToQuestion( \@addy, \@ans, {} );
} }
elsif ( $type eq 'Effectiveness' ) { elsif ( $type eq 'Effectiveness' ) {
my @ans = ( my @ans = ( 'Not at all effective', '', '', '', '', '', '', '', '', '', 'Extremely effective' );
'Not at all effective',
'', '', '', '', '', '', '', '', '', 'Extremely effective'
);
$self->addAnswersToQuestion( \@addy, \@ans, {} ); $self->addAnswersToQuestion( \@addy, \@ans, {} );
} }
elsif ( $type eq 'Confidence' ) { elsif ( $type eq 'Confidence' ) {
my @ans = ( my @ans = ( 'Not at all confident', '', '', '', '', '', '', '', '', '', 'Extremely confident' );
'Not at all confident',
'', '', '', '', '', '', '', '', '', 'Extremely confident'
);
$self->addAnswersToQuestion( \@addy, \@ans, {} ); $self->addAnswersToQuestion( \@addy, \@ans, {} );
} }
elsif ( $type eq 'Satisfaction' ) { elsif ( $type eq 'Satisfaction' ) {
my @ans = ( my @ans = ( 'Not at all satisfied', '', '', '', '', '', '', '', '', '', 'Extremely satisfied' );
'Not at all satisfied',
'', '', '', '', '', '', '', '', '', 'Extremely satisfied'
);
$self->addAnswersToQuestion( \@addy, \@ans, {} ); $self->addAnswersToQuestion( \@addy, \@ans, {} );
} }
elsif ( $type eq 'Certainty' ) { elsif ( $type eq 'Certainty' ) {
my @ans = ( my @ans = ( 'Not at all certain', '', '', '', '', '', '', '', '', '', 'Extremely certain' );
'Not at all certain',
'', '', '', '', '', '', '', '', '', 'Extremely certain'
);
$self->addAnswersToQuestion( \@addy, \@ans, {} ); $self->addAnswersToQuestion( \@addy, \@ans, {} );
} }
elsif ( $type eq 'Likelihood' ) { elsif ( $type eq 'Likelihood' ) {
my @ans = ( my @ans = ( 'Not at all likely', '', '', '', '', '', '', '', '', '', 'Extremely likely' );
'Not at all likely',
'', '', '', '', '', '', '', '', '', 'Extremely likely'
);
$self->addAnswersToQuestion( \@addy, \@ans, {} ); $self->addAnswersToQuestion( \@addy, \@ans, {} );
} }
elsif ( $type eq 'Importance' ) { elsif ( $type eq 'Importance' ) {
my @ans = ( my @ans = ( 'Not at all important', '', '', '', '', '', '', '', '', '', 'Extremely important' );
'Not at all important',
'', '', '', '', '', '', '', '', '', 'Extremely important'
);
$self->addAnswersToQuestion( \@addy, \@ans, {} ); $self->addAnswersToQuestion( \@addy, \@ans, {} );
} }
elsif ( $type eq 'Oppose/Support' ) { elsif ( $type eq 'Oppose/Support' ) {
@ -497,7 +432,7 @@ sub updateQuestionAnswers {
else { else {
push( @{ $question->{answers} }, $self->newAnswer() ); push( @{ $question->{answers} }, $self->newAnswer() );
} }
} } ## end sub updateQuestionAnswers
sub addAnswersToQuestion { sub addAnswersToQuestion {
my $self = shift; my $self = shift;
@ -508,16 +443,13 @@ sub addAnswersToQuestion {
push( @{ $self->question($addy)->{answers} }, $self->newAnswer() ); push( @{ $self->question($addy)->{answers} }, $self->newAnswer() );
$$addy[2] = $_; $$addy[2] = $_;
if ( defined $$verbs{$_} and $_ == $$verbs{$_} ) { if ( defined $$verbs{$_} and $_ == $$verbs{$_} ) {
$self->update( $addy, $self->update( $addy, { 'text', $$ans[$_], 'recordedAnswer', $_ + 1, 'verbatim', 1 } );
{ 'text', $$ans[$_], 'recordedAnswer', $_ + 1, 'verbatim', 1 }
);
} }
else { else {
$self->update( $addy, $self->update( $addy, { 'text', $$ans[$_], 'recordedAnswer', $_ + 1 } );
{ 'text', $$ans[$_], 'recordedAnswer', $_ + 1 } );
} }
} }
} } ## end sub addAnswersToQuestion
#------------------------------ #------------------------------
#accessors and helpers #accessors and helpers
@ -548,15 +480,13 @@ sub question {
sub answers { sub answers {
my $self = shift; my $self = shift;
my $address = shift; my $address = shift;
return $self->{sections}->[ $$address[0] ]->{questions}->[ $$address[1] ] return $self->{sections}->[ $$address[0] ]->{questions}->[ $$address[1] ]->{answers};
->{answers};
} }
sub answer { sub answer {
my $self = shift; my $self = shift;
my $address = shift; my $address = shift;
return $self->{sections}->[ $$address[0] ]->{questions}->[ $$address[1] ] return $self->{sections}->[ $$address[0] ]->{questions}->[ $$address[1] ]->{answers}->[ $$address[2] ];
->{answers}->[ $$address[2] ];
} }
sub log { sub log {