Used WG perltidyrc to clean up files
This commit is contained in:
Kaleb Murphy
parent
9f9601690a
commit
1d5859631c
3 changed files with 276 additions and 472 deletions
|
|
@ -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 .=
|
||||
"<li id='$scount' class='section'>S"
|
||||
. ( $scount + 1 )
|
||||
. ": $_->{text}<\/li><br>\n";
|
||||
$html .= "<li id='$scount' class='section'>S" . ( $scount + 1 ) . ": $_->{text}<\/li><br>\n";
|
||||
push( @ids, $scount );
|
||||
}
|
||||
elsif ( $_->{type} eq 'question' ) {
|
||||
|
|
@ -479,24 +457,18 @@ sub www_loadSurvey {
|
|||
if ( $lastType eq 'answer' ) {
|
||||
$a = 1;
|
||||
}
|
||||
$html .=
|
||||
"<li id='$scount-$qcount' class='question'>Q"
|
||||
. ( $qcount + 1 )
|
||||
. ": $_->{text}<\/li><br>\n";
|
||||
$html .= "<li id='$scount-$qcount' class='question'>Q" . ( $qcount + 1 ) . ": $_->{text}<\/li><br>\n";
|
||||
push( @ids, "$scount-$qcount" );
|
||||
$lastType = 'question';
|
||||
$acount = -1;
|
||||
}
|
||||
elsif ( $_->{type} eq 'answer' ) {
|
||||
$lastId{answer} = ++$acount;
|
||||
$html .=
|
||||
"<li id='$scount-$qcount-$acount' class='answer'>A"
|
||||
. ( $acount + 1 )
|
||||
. ": $_->{text}<\/li><br>\n";
|
||||
$html .= "<li id='$scount-$qcount-$acount' class='answer'>A" . ( $acount + 1 ) . ": $_->{text}<\/li><br>\n";
|
||||
push( @ids, "$scount-$qcount-$acount" );
|
||||
$lastType = 'answer';
|
||||
}
|
||||
}
|
||||
} ## end foreach (@$data)
|
||||
|
||||
#address is the address of the focused object
|
||||
#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)
|
||||
#type is the object type
|
||||
my $return = {
|
||||
"address", $address, "buttons", \%buttons,
|
||||
"edithtml", $editHtml, "ddhtml", $html,
|
||||
"ids", \@ids, "type", $var->{type}
|
||||
"address", $address, "buttons", \%buttons, "edithtml", $editHtml,
|
||||
"ddhtml", $html, "ids", \@ids, "type", $var->{type}
|
||||
};
|
||||
$self->session->http->setMimeType('application/json');
|
||||
return encode_json($return);
|
||||
}
|
||||
} ## end sub www_loadSurvey
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
|
|
@ -537,13 +508,9 @@ sub prepareView {
|
|||
|
||||
sub purge {
|
||||
my $self = shift;
|
||||
$self->session->db->write( "delete from Survey_response where assetId = ?",
|
||||
[ $self->getId() ] );
|
||||
$self->session->db->write(
|
||||
"delete from Survey_tempReport where assetId = ?",
|
||||
[ $self->getId() ] );
|
||||
$self->session->db->write( "delete from Survey where assetId = ?",
|
||||
[ $self->getId() ] );
|
||||
$self->session->db->write( "delete from Survey_response where assetId = ?", [ $self->getId() ] );
|
||||
$self->session->db->write( "delete from Survey_tempReport where assetId = ?", [ $self->getId() ] );
|
||||
$self->session->db->write( "delete from Survey where assetId = ?", [ $self->getId() ] );
|
||||
return $self->SUPER::purge;
|
||||
}
|
||||
|
||||
|
|
@ -581,15 +548,12 @@ sub view {
|
|||
my $self = shift;
|
||||
my %var;
|
||||
|
||||
$var{'edit_survey_url'} = $self->getUrl('func=editSurvey');
|
||||
$var{'take_survey_url'} = $self->getUrl('func=takeSurvey');
|
||||
$var{'view_reports_url'} = $self->getUrl('func=viewReports');
|
||||
$var{'user_canTakeSurvey'} =
|
||||
$self->session->user->isInGroup( $self->get("groupToTakeSurvey") );
|
||||
$var{'user_canViewReports'} =
|
||||
$self->session->user->isInGroup( $self->get("groupToViewReports") );
|
||||
$var{'user_canEditSurvey'} =
|
||||
$self->session->user->isInGroup( $self->get("groupToEditSurvey") );
|
||||
$var{'edit_survey_url'} = $self->getUrl('func=editSurvey');
|
||||
$var{'take_survey_url'} = $self->getUrl('func=takeSurvey');
|
||||
$var{'view_reports_url'} = $self->getUrl('func=viewReports');
|
||||
$var{'user_canTakeSurvey'} = $self->session->user->isInGroup( $self->get("groupToTakeSurvey") );
|
||||
$var{'user_canViewReports'} = $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} );
|
||||
|
||||
return $out;
|
||||
|
|
@ -613,8 +577,7 @@ sub www_takeSurvey {
|
|||
my $self = shift;
|
||||
my %var;
|
||||
|
||||
my $out =
|
||||
$self->processTemplate( \%var, $self->get("surveyTakeTemplateId") );
|
||||
my $out = $self->processTemplate( \%var, $self->get("surveyTakeTemplateId") );
|
||||
|
||||
eval {
|
||||
my $responseId = $self->getResponseId();
|
||||
|
|
@ -660,25 +623,24 @@ sub www_submitQuestions {
|
|||
|
||||
my $files = 0;
|
||||
|
||||
# for my $id(@$orderOf){
|
||||
#if a file upload, write to disk
|
||||
# my $path;
|
||||
# if($id->{'questionType'} eq 'File Upload'){
|
||||
# $files = 1;
|
||||
# my $storage = WebGUI::Storage->create($self->session);
|
||||
# my $filename = $storage->addFileFromFormPost( $id->{'Survey_answerId'} );
|
||||
# $path = $storage->getPath($filename);
|
||||
# }
|
||||
#$self->session->errorHandler->error("Inserting a response ".$id->{'Survey_answerId'}." $responseId, $path, ".$$responses{$id->{'Survey_answerId'}});
|
||||
# $self->session->db->write("insert into Survey_questionResponse
|
||||
# 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'}]);
|
||||
# }
|
||||
# for my $id(@$orderOf){
|
||||
#if a file upload, write to disk
|
||||
# my $path;
|
||||
# if($id->{'questionType'} eq 'File Upload'){
|
||||
# $files = 1;
|
||||
# my $storage = WebGUI::Storage->create($self->session);
|
||||
# my $filename = $storage->addFileFromFormPost( $id->{'Survey_answerId'} );
|
||||
# $path = $storage->getPath($filename);
|
||||
# }
|
||||
#$self->session->errorHandler->error("Inserting a response ".$id->{'Survey_answerId'}." $responseId, $path, ".$$responses{$id->{'Survey_answerId'}});
|
||||
# $self->session->db->write("insert into Survey_questionResponse
|
||||
# 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'}]);
|
||||
# }
|
||||
if ($files) {
|
||||
##special case, need to check for more questions in section, if not, more current up one
|
||||
my $lastA = $self->getLastAnswerInfo($responseId);
|
||||
my $questionId =
|
||||
$self->getNextQuestionId( $lastA->{'Survey_questionId'} );
|
||||
my $lastA = $self->getLastAnswerInfo($responseId);
|
||||
my $questionId = $self->getNextQuestionId( $lastA->{'Survey_questionId'} );
|
||||
if ( !$questionId ) {
|
||||
my $currentSection = $self->getCurrentSection($responseId);
|
||||
$currentSection = $self->getNextSection($currentSection);
|
||||
|
|
@ -689,7 +651,7 @@ sub www_submitQuestions {
|
|||
return;
|
||||
}
|
||||
return $self->www_loadQuestions($responseId);
|
||||
}
|
||||
} ## end sub www_submitQuestions
|
||||
|
||||
#finds the questions to display next and builds the data structre to hold them
|
||||
#-------------------------------------------------------------------
|
||||
|
|
@ -700,7 +662,7 @@ sub www_loadQuestions {
|
|||
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 ) {
|
||||
return $self->surveyEnd();
|
||||
}
|
||||
|
|
@ -716,20 +678,19 @@ sub www_loadQuestions {
|
|||
$section->{id} = $self->response->nextSectionId();
|
||||
my $text = $self->prepareShowSurveyTemplate( $section, $questions );
|
||||
return $text;
|
||||
}
|
||||
} ## end sub www_loadQuestions
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
#called when the survey is over.
|
||||
sub surveyEnd {
|
||||
my $self = 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(
|
||||
"Survey_response",
|
||||
"Survey_responseId",
|
||||
{
|
||||
"Survey_responseId", {
|
||||
Survey_responseId => $responseId,
|
||||
endDate => WebGUI::DateTime->now->toDatabase,
|
||||
isComplete => 1
|
||||
|
|
@ -738,37 +699,31 @@ sub surveyEnd {
|
|||
if ( $url !~ /\w/ ) { $url = 0; }
|
||||
if ( $url eq "undefined" ) { $url = 0; }
|
||||
if ( !$url ) {
|
||||
$url = $self->session->db->quickScalar(
|
||||
"select exitURL from Survey where assetId = ? order by revisionDate desc limit 1",
|
||||
[ $self->getId() ]
|
||||
);
|
||||
$url
|
||||
= $self->session->db->quickScalar(
|
||||
"select exitURL from Survey where assetId = ? order by revisionDate desc limit 1",
|
||||
[ $self->getId() ] );
|
||||
if ( !$url ) {
|
||||
$url = "/";
|
||||
}
|
||||
}
|
||||
$self->session->http->setMimeType('application/json');
|
||||
return encode_json( { "type", "forward", "url", $url } );
|
||||
}
|
||||
} ## end sub surveyEnd
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
#sends the processed template and questions structure to the client
|
||||
sub prepareShowSurveyTemplate {
|
||||
my ( $self, $section, $questions ) = @_;
|
||||
my %multipleChoice = (
|
||||
'Multiple Choice', 1, 'Gender', 1, 'Yes/No', 1,
|
||||
'True/False', 1, 'Ideology', 1, 'Race', 1,
|
||||
'Party', 1, 'Education', 1, 'Scale', 1,
|
||||
'Agree/Disagree', 1, 'Oppose/Support', 1, 'Importance', 1,
|
||||
'Likelihood', 1, 'Certainty', 1, 'Satisfaction', 1,
|
||||
'Confidence', 1, 'Effectiveness', 1, 'Concern', 1,
|
||||
'Risk', 1, 'Threat', 1, 'Security', 1
|
||||
'Multiple Choice', 1, 'Gender', 1, 'Yes/No', 1, 'True/False', 1, 'Ideology', 1,
|
||||
'Race', 1, 'Party', 1, 'Education', 1, 'Scale', 1, 'Agree/Disagree', 1,
|
||||
'Oppose/Support', 1, 'Importance', 1, 'Likelihood', 1, 'Certainty', 1, 'Satisfaction', 1,
|
||||
'Confidence', 1, 'Effectiveness', 1, 'Concern', 1, 'Risk', 1, 'Threat', 1,
|
||||
'Security', 1
|
||||
);
|
||||
my %text = (
|
||||
'Text', 1, 'Email', 1, 'Phone Number', 1,
|
||||
'Text Date', 1, 'Currency', 1
|
||||
);
|
||||
my %slider =
|
||||
( 'Slider', 1, 'Dual Slider - Range', 1, 'Multi Slider - Allocate', 1 );
|
||||
my %text = ( 'Text', 1, 'Email', 1, 'Phone Number', 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 %fileUpload = ( 'File Upload', 1 );
|
||||
my %hidden = ( 'Hidden', 1 );
|
||||
|
|
@ -799,20 +754,14 @@ sub prepareShowSurveyTemplate {
|
|||
$$q{'verts'} = "<p>";
|
||||
$$q{'verte'} = "</p>";
|
||||
}
|
||||
}
|
||||
} ## 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;
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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 {
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue