From 02d76504a6fd13ff877f7fed8dc8f876608e6717 Mon Sep 17 00:00:00 2001 From: Kaleb Murphy Date: Thu, 13 Nov 2008 18:59:01 +0000 Subject: [PATCH] Removed some debug statements and perltidied the code --- lib/WebGUI/Asset/Wobject/Survey.pm | 1151 +++++++++-------- .../Asset/Wobject/Survey/ResponseJSON.pm | 409 +++--- lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm | 750 ++++++----- 3 files changed, 1286 insertions(+), 1024 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Survey.pm b/lib/WebGUI/Asset/Wobject/Survey.pm index 036c88a05..bc7514187 100644 --- a/lib/WebGUI/Asset/Wobject/Survey.pm +++ b/lib/WebGUI/Asset/Wobject/Survey.pm @@ -24,121 +24,125 @@ use Data::Dumper; # #------------------------------------------------------------------- sub definition { - my $class = shift; - my $session = shift; + my $class = shift; + my $session = shift; my $definition = shift; - my $i18n = WebGUI::International->new($session,'Asset_Survey'); + my $i18n = WebGUI::International->new( $session, 'Asset_Survey' ); my %properties; tie %properties, 'Tie::IxHash'; %properties = ( - templateId =>{ - fieldType=>"template", - defaultValue=>'PBtmpl0000000000000061', - tab=>"display", - namespace=>"Survey", - hoverHelp=>"A Survey System", - label=>"Template ID" - }, - groupToEditSurvey => { - fieldType => 'group', - defaultValue => 4, - label => "Group to edit survey", - }, - groupToTakeSurvey => { - fieldType => 'group', - defaultValue => 2, - label => "Group to take survey", - }, - groupToViewReports => { - fieldType => 'group', - defaultValue => 4, - label => "Group to view reports", - }, - exitURL => { - fieldType => 'text', - 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.", - }, - maxResponsesPerUser=>{ - fieldType => 'integer', - defaultValue => 1, - label => "Max user reponses", - }, - overviewTemplateId=>{ - tab => 'display', - fieldType => 'template', - defaultValue => 'PBtmpl0000000000000063', - label => "Overview template id", - namespace => 'Survey/Overview', - }, - gradebookTemplateId => { - tab => 'display', - fieldType => 'template', - label => "Grabebook template id", - defaultValue => 'PBtmpl0000000000000062', - namespace => 'Survey/Gradebook', - }, - responseTemplateId => { - tab => 'display', - fieldType => 'template', - label => "Response template id", - defaultValue => 'PBtmpl0000000000000064', - namespace => 'Survey/Response', - }, - surveyEditTemplateId => { - tab => 'display', - fieldType => 'template', - label => "Survey edit template id", - defaultValue => 'GRUNFctldUgop-qRLuo_DA', - namespace => 'Survey/Edit', - }, - surveyTakeTemplateId => { - tab => 'display', - fieldType => 'template', - label => "Take survey template id", - defaultValue => 'd8jMMMRddSQ7twP4l1ZSIw', - namespace => 'Survey/Take', - }, - surveyQuestionsId => { - tab => 'display', - fieldType => 'template', - label => "Questions template id", - defaultValue => 'CxMpE_UPauZA3p8jdrOABw', - namespace => 'Survey/Take', - }, - sectionEditTemplateId => { - tab => 'display', - fieldType => 'template', - label => "Section Edit Tempalte", - defaultValue => '1oBRscNIcFOI-pETrCOspA', - namespace => 'Survey/Edit', - }, - questionEditTemplateId => { - tab => 'display', - fieldType => 'template', - label => "Question Edit Tempalte", - defaultValue => 'wAc4azJViVTpo-2NYOXWvg', - namespace => 'Survey/Edit', - }, - answerEditTemplateId => { - tab => 'display', - fieldType => 'template', - label => "Answer Edit Tempalte", - defaultValue => 'AjhlNO3wZvN5k4i4qioWcg', - namespace => 'Survey/Edit', - }, - ); + templateId => { + fieldType => "template", + defaultValue => 'PBtmpl0000000000000061', + tab => "display", + namespace => "Survey", + hoverHelp => "A Survey System", + label => "Template ID" + }, + groupToEditSurvey => { + fieldType => 'group', + defaultValue => 4, + label => "Group to edit survey", + }, + groupToTakeSurvey => { + fieldType => 'group', + defaultValue => 2, + label => "Group to take survey", + }, + groupToViewReports => { + fieldType => 'group', + defaultValue => 4, + label => "Group to view reports", + }, + exitURL => { + fieldType => 'text', + 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.", + }, + maxResponsesPerUser => { + fieldType => 'integer', + defaultValue => 1, + label => "Max user reponses", + }, + overviewTemplateId => { + tab => 'display', + fieldType => 'template', + defaultValue => 'PBtmpl0000000000000063', + label => "Overview template id", + namespace => 'Survey/Overview', + }, + gradebookTemplateId => { + tab => 'display', + fieldType => 'template', + label => "Grabebook template id", + defaultValue => 'PBtmpl0000000000000062', + namespace => 'Survey/Gradebook', + }, + responseTemplateId => { + tab => 'display', + fieldType => 'template', + label => "Response template id", + defaultValue => 'PBtmpl0000000000000064', + namespace => 'Survey/Response', + }, + surveyEditTemplateId => { + tab => 'display', + fieldType => 'template', + label => "Survey edit template id", + defaultValue => 'GRUNFctldUgop-qRLuo_DA', + namespace => 'Survey/Edit', + }, + surveyTakeTemplateId => { + tab => 'display', + fieldType => 'template', + label => "Take survey template id", + defaultValue => 'd8jMMMRddSQ7twP4l1ZSIw', + namespace => 'Survey/Take', + }, + surveyQuestionsId => { + tab => 'display', + fieldType => 'template', + label => "Questions template id", + defaultValue => 'CxMpE_UPauZA3p8jdrOABw', + namespace => 'Survey/Take', + }, + sectionEditTemplateId => { + tab => 'display', + fieldType => 'template', + label => "Section Edit Tempalte", + defaultValue => '1oBRscNIcFOI-pETrCOspA', + namespace => 'Survey/Edit', + }, + questionEditTemplateId => { + tab => 'display', + fieldType => 'template', + label => "Question Edit Tempalte", + defaultValue => 'wAc4azJViVTpo-2NYOXWvg', + namespace => 'Survey/Edit', + }, + answerEditTemplateId => { + tab => 'display', + fieldType => 'template', + label => "Answer Edit Tempalte", + defaultValue => 'AjhlNO3wZvN5k4i4qioWcg', + namespace => 'Survey/Edit', + }, + ); - push(@{$definition}, { - assetName=>$i18n->get('assetName'), - icon=>'survey.gif', - autoGenerateForms=>1, - tableName=>'Survey', - className=>'WebGUI::Asset::Wobject::Survey', - properties=>\%properties - }); - return $class->SUPER::definition($session, $definition); + push( + @{$definition}, + { + assetName => $i18n->get('assetName'), + icon => 'survey.gif', + autoGenerateForms => 1, + tableName => 'Survey', + className => 'WebGUI::Asset::Wobject::Survey', + properties => \%properties + } + ); + return $class->SUPER::definition( $session, $definition ); } #------------------------------------------------------------------- @@ -150,11 +154,11 @@ Override exportAssetData so that surveyJSON is included in package exports etc.. =cut sub exportAssetData { - my $self = shift; - my $hash = $self->SUPER::exportAssetData(); - $self->loadSurveyJSON(); - $hash->{properties}{surveyJSON} = $self->survey->freeze; - return $hash; + my $self = shift; + my $hash = $self->SUPER::exportAssetData(); + $self->loadSurveyJSON(); + $hash->{properties}{surveyJSON} = $self->survey->freeze; + return $hash; } #------------------------------------------------------------------- @@ -166,9 +170,11 @@ Override importAssetCollateralData so that surveyJSON gets imported from package =cut sub importAssetCollateralData { - my ($self, $data) = @_; + 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 ] ); } #------------------------------------------------------------------- @@ -180,73 +186,38 @@ Override duplicate so that surveyJSON gets duplicated too =cut sub duplicate { - my $self = shift; - 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]); + my $self = shift; + 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 ] + ); return $newAsset; } #------------------------------------------------------------------- -=head2 getEditForm - -getEditForm is called when creating/editing the asset. -This overloads the normal call to the super, to call the super call like normal and then add to the tab form. - -=cut - -#sub getEditForm { -# my $self = shift; - -# my $tabform = $self->SUPER::getEditForm(@_); - -# $tabform->getTab("properties")->hidden( -# -value => "editSurvey", -# -name => 'proceed' -# ); - -# return $tabform; -# return $self->www_editSurvey(@_); -#} - - - -#------------------------------------------------------------------- -#sub processPropertiesFromFormPost { -# my $self = shift; -# $self->SUPER::processPropertiesFromFormPost; - -# $self->loadSurveyJSON(); -# if($#{$self->{_data}->{sections}} < 0){ -#$self->session->errorHandler->error("In Processing from Post\n"); -# my $section = $self->{_data}->newSection(); -# $self->{_data}->addSection($section); - -#$self->session->errorHandler->error("Processing from creation\n".Dumper $self->{_data}); -# } -# $self->saveSurveyJSON(); -#} - -#------------------------------------------------------------------- - =head2 loadSurveyJSON ( ) Loads the survey collateral into memory so that the survey objects can be created =cut -sub loadSurveyJSON{ - my $self = shift; +sub loadSurveyJSON { + my $self = shift; my $jsonHash = shift; - if(defined $self->survey){return;}#already loaded + if ( defined $self->survey ) { return; } #already loaded - $jsonHash = $self->session->db->quickScalar("select surveyJSON from Survey where assetId = ?",[$self->getId]) if(! defined $jsonHash); - -eval{ - $self->{survey} = WebGUI::Asset::Wobject::Survey::SurveyJSON->new($jsonHash,$self->session->errorHandler); -}; + $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 ); } #------------------------------------------------------------------- @@ -257,19 +228,20 @@ Saves the survey collateral to the DB =cut -sub survey{ return shift->{survey}; } -sub littleBuddy{ return shift->{survey}; } -sub allyourbases{ return shift->{survey}; } -sub helpmehelpme{ return shift->{survey}; } +sub survey { return shift->{survey}; } +sub littleBuddy { return shift->{survey}; } +sub allyourbases { return shift->{survey}; } +sub helpmehelpme { return shift->{survey}; } -sub saveSurveyJSON{ +sub saveSurveyJSON { my $self = shift; - - my $data = $self->survey->freeze(); - - $self->session->db->write("update Survey set surveyJSON = ? where assetId = ?",[$data,$self->getId]); -} + my $data = $self->survey->freeze(); + + $self->session->db->write( + "update Survey set surveyJSON = ? where assetId = ?", + [ $data, $self->getId ] ); +} #------------------------------------------------------------------- @@ -283,212 +255,245 @@ 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; } - #------------------------------------------------------------------- -sub www_submitObjectEdit{ +sub www_submitObjectEdit { my $self = shift; - -# my $ref = @{decode_json($self->session->form->process("data"))}; + + # my $ref = @{decode_json($self->session->form->process("data"))}; my $responses = $self->session->form->paramsHashRef(); - my @address = split/-/,$responses->{id}; - + my @address = split /-/, $responses->{id}; + $self->loadSurveyJSON(); - if($responses->{delete}){ - return $self->deleteObject(\@address); + if ( $responses->{delete} ) { + return $self->deleteObject( \@address ); } - elsif($responses->{copy}){ - return $self->copyObject(\@address); + elsif ( $responses->{copy} ) { + return $self->copyObject( \@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. + my $message = $self->survey->update( \@address, $responses ); + + $self->saveSurveyJSON(); + + return $self->www_loadSurvey( { address => \@address } ); +} + +#------------------------------------------------------------------- +sub copyObject { + my ( $self, $address ) = @_; + + $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. - my $message = $self->survey->update(\@address,$responses); + $address = $self->survey->copy($address); $self->saveSurveyJSON(); - return $self->www_loadSurvey({address => \@address}); + #The parent address of the deleted object is returned. + + return $self->www_loadSurvey( { address => $address } ); } #------------------------------------------------------------------- -sub copyObject{ - my ($self,$address) = @_; +sub deleteObject { + my ( $self, $address ) = @_; $self->loadSurveyJSON(); - $address = $self->survey->copy($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. + 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. $self->saveSurveyJSON(); + #The parent address of the deleted object is returned. - - return $self->www_loadSurvey({address => $address}); -} - -#------------------------------------------------------------------- -sub deleteObject{ - my ($self,$address) = @_; - - $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. - - $self->saveSurveyJSON(); - #The parent address of the deleted object is returned. - if(@$address == 1){ + if ( @$address == 1 ) { $$address[0] = 0; - }else{ - pop(@{$address});# unless @$address == 1 and $$address[0] == 0; + } + else { + 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 } ); } - #------------------------------------------------------------------- -sub www_newObject{ +sub www_newObject { my $self = shift; my $ref; - + my $ids = $self->session->form->process("data"); - my @inAddress = split/-/,$ids; - + my @inAddress = split /-/, $ids; + $self->loadSurveyJSON(); #Don't save after this as the new object should not stay in the survey - my $address = $self->survey->newObject(\@inAddress); + my $address = $self->survey->newObject( \@inAddress ); - - #The new temp object has an address of NEW, which means it is not a real final address. + #The new temp object has an address of NEW, which means it is not a real final address. - return $self->www_loadSurvey({address => $address, message => undef}); + return $self->www_loadSurvey( { address => $address, message => undef } ); } - #------------------------------------------------------------------- -sub www_dragDrop{ +sub www_dragDrop { my $self = shift; - my $p = decode_json($self->session->form->process("data")); + my $p = decode_json( $self->session->form->process("data") ); - - my @tid = split/-/,$p->{target}->{id}; - my @bid = split/-/,$p->{before}->{id}; + my @tid = split /-/, $p->{target}->{id}; + my @bid = split /-/, $p->{before}->{id}; $self->loadSurveyJSON(); - my $target = $self->survey->getObject(\@tid); - $self->survey->remove(\@tid,1); + my $target = $self->survey->getObject( \@tid ); + $self->survey->remove( \@tid, 1 ); my $address = [0]; - if(@tid == 1){ - $#bid = 0;#sections can only be inserted after another section so chop off the question and answer portion of - $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. - if($bid[0] !~ /\d/){ - $bid[0] = $tid[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] = -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. + 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 - if($bid[0] !~ /\d/){ - $bid[0] = $tid[0]; + } + 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]; } - if($bid[0] == $tid[0]){ + if ( $bid[0] == $tid[0] ) { + #moved to top of current section $bid[1] = -1; - }else{ + } + else { + #else move to the end of the selected section - $bid[1] = $#{$self->survey->questions([$bid[0]])}; + $bid[1] = $#{ $self->survey->questions( [ $bid[0] ] ) }; } } - $self->survey->insertObject($target, [$bid[0],$bid[1]]); - }elsif(@tid == 3){#answers can only be rearranged in the same question - if(@bid == 2 and $bid[1] == $tid[1]){ + $self->survey->insertObject( $target, [ $bid[0], $bid[1] ] ); + } + 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]]); - }elsif(@bid == 3){ - $self->survey->insertObject($target, [$bid[0],$bid[1],$bid[2]]); - }else{ + $self->survey->insertObject( $target, + [ $bid[0], $bid[1], $bid[2] ] ); + } + elsif ( @bid == 3 ) { + $self->survey->insertObject( $target, + [ $bid[0], $bid[1], $bid[2] ] ); + } + else { + #else put it back where it was - $self->survey->insertObject($target, \@tid); + $self->survey->insertObject( $target, \@tid ); } } - + $self->saveSurveyJSON(); - - return $self->www_loadSurvey({address => $address}); + + return $self->www_loadSurvey( { address => $address } ); } - - + #------------------------------------------------------------------- -sub www_loadSurvey{ - my ($self,$options) = @_; - +sub www_loadSurvey { + my ( $self, $options ) = @_; + $self->loadSurveyJSON(); my $address = defined $options->{address} ? $options->{address} : undef; - if(! defined $address){ - if(my $inAddress = $self->session->form->process("data")){ - $address = [split/-/,$inAddress]; - }else{ + if ( !defined $address ) { + if ( my $inAddress = $self->session->form->process("data") ) { + $address = [ split /-/, $inAddress ]; + } + else { $address = [0]; } } 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")); - }elsif($var->{type} eq 'question'){ - $editHtml = $self->processTemplate($var,$self->get("questionEditTemplateId")); - }elsif($var->{type} eq 'answer'){ - $editHtml = $self->processTemplate($var,$self->get("answerEditTemplateId")); + if ( $var->{type} eq 'section' ) { + $editHtml = + $self->processTemplate( $var, $self->get("sectionEditTemplateId") ); + } + elsif ( $var->{type} eq 'question' ) { + $editHtml = + $self->processTemplate( $var, $self->get("questionEditTemplateId") ); + } + elsif ( $var->{type} eq 'answer' ) { + $editHtml = + $self->processTemplate( $var, $self->get("answerEditTemplateId") ); } my %buttons; - $buttons{question} = $$address[0]; - if(@$address == 2 or @$address == 3){ + $buttons{question} = $$address[0]; + if ( @$address == 2 or @$address == 3 ) { $buttons{answer} = "$$address[0]-$$address[1]"; } - + my $data = $self->survey->getDragDropList($address); my $html; - my ($scount,$qcount,$acount) = (-1,-1,-1); + my ( $scount, $qcount, $acount ) = ( -1, -1, -1 ); 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'){ + foreach (@$data) { + if ( $_->{type} eq 'section' ) { $lastId{section} = ++$scount; - if($lastType eq 'answer'){ + if ( $lastType eq 'answer' ) { $a = 1; } - elsif($lastType eq 'question'){ + elsif ( $lastType eq 'question' ) { $q = 1; } - $html .= "
  • S". ($scount + 1). ": $_->{text}<\/li>
    \n"; - push(@ids,$scount); + $html .= + "
  • S" + . ( $scount + 1 ) + . ": $_->{text}<\/li>
    \n"; + push( @ids, $scount ); } - elsif($_->{type} eq 'question'){ + elsif ( $_->{type} eq 'question' ) { $lastId{question} = ++$qcount; - if($lastType eq 'answer'){ + if ( $lastType eq 'answer' ) { $a = 1; } - $html .= "
  • Q". ($qcount + 1). ": $_->{text}<\/li>
    \n"; - push(@ids,"$scount-$qcount"); + $html .= + "
  • Q" + . ( $qcount + 1 ) + . ": $_->{text}<\/li>
    \n"; + push( @ids, "$scount-$qcount" ); $lastType = 'question'; - $acount = -1; + $acount = -1; } - elsif($_->{type} eq 'answer'){ + elsif ( $_->{type} eq 'answer' ) { $lastId{answer} = ++$acount; - $html .= "
  • A". ($acount + 1). ": $_->{text}<\/li>
    \n"; - push(@ids,"$scount-$qcount-$acount"); + $html .= + "
  • A" + . ( $acount + 1 ) + . ": $_->{text}<\/li>
    \n"; + push( @ids, "$scount-$qcount-$acount" ); $lastType = 'answer'; } } @@ -499,7 +504,11 @@ sub www_loadSurvey{ #ddhtml is the html to create the draggable html divs #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}}; + my $return = { + "address", $address, "buttons", \%buttons, + "edithtml", $editHtml, "ddhtml", $html, + "ids", \@ids, "type", $var->{type} + }; $self->session->http->setMimeType('application/json'); return encode_json($return); } @@ -516,10 +525,10 @@ sub prepareView { my $self = shift; $self->SUPER::prepareView(); my $templateId = $self->get("templateId"); - if ($self->session->form->process("overrideTemplateId") ne "") { - $templateId = $self->session->form->process("overrideTemplateId"); - } - my $template = WebGUI::Asset::Template->new($self->session, $templateId); + if ( $self->session->form->process("overrideTemplateId") ne "" ) { + $templateId = $self->session->form->process("overrideTemplateId"); + } + my $template = WebGUI::Asset::Template->new( $self->session, $templateId ); $template->prepare; $self->{_viewTemplate} = $template; } @@ -527,11 +536,15 @@ 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()]); - return $self->SUPER::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() ] ); + return $self->SUPER::purge; } #------------------------------------------------------------------- @@ -544,15 +557,15 @@ See WebGUI::Asset::purgeCache() for details. sub purgeCache { my $self = shift; - WebGUI::Cache->new($self->session,"view_".$self->getId)->delete; + WebGUI::Cache->new( $self->session, "view_" . $self->getId )->delete; $self->SUPER::purgeCache; } #------------------------------------------------------------------- sub purgeRevision { - my $self = shift; - return $self->SUPER::purgeRevision; + my $self = shift; + return $self->SUPER::purgeRevision; } #------------------------------------------------------------------- @@ -568,18 +581,20 @@ sub view { my $self = shift; my %var; - $var{'edit_survey_url'} = $self->getUrl('func=editSurvey'); - $var{'take_survey_url'} = $self->getUrl('func=takeSurvey'); + $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}); + $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; } - #------------------------------------------------------------------- =head2 www_view ( ) @@ -593,17 +608,17 @@ sub www_view { $self->SUPER::www_view(@_); } - #------------------------------------------------------------------- -sub www_takeSurvey{ +sub www_takeSurvey { my $self = shift; my %var; - - my $out = $self->processTemplate(\%var,$self->get("surveyTakeTemplateId")); - eval{ + my $out = + $self->processTemplate( \%var, $self->get("surveyTakeTemplateId") ); + + eval { my $responseId = $self->getResponseId(); - if(!$responseId){ + if ( !$responseId ) { return $self->surveyEnd(); } }; @@ -611,28 +626,25 @@ sub www_takeSurvey{ return $out; } - - - - #handles questions that were submitted #------------------------------------------------------------------- -sub www_submitQuestions{ - my $self=shift; - #can user take survey - if(!$self->canTakeSurvey()){ - # return encode_json({"type","FAIL LOGIN"}); +sub www_submitQuestions { + my $self = shift; + + #can user take survey + if ( !$self->canTakeSurvey() ) { + + # return encode_json({"type","FAIL LOGIN"}); return $self->surveyEnd(); } - + my $responseId = $self->getResponseId(); - if(!$responseId){return $self->surveyEnd();} - + if ( !$responseId ) { return $self->surveyEnd(); } my $responses = $self->session->form->paramsHashRef(); delete $$responses{'func'}; - my @goodResponses = keys %$responses;#load everything. + my @goodResponses = keys %$responses; #load everything. $self->loadBothJSON(); @@ -640,16 +652,16 @@ sub www_submitQuestions{ $self->saveResponseJSON(); - if($termInfo->[0]){ - return $self->surveyEnd($termInfo->[1]); + if ( $termInfo->[0] ) { + return $self->surveyEnd( $termInfo->[1] ); } return $self->www_loadQuestions(); my $files = 0; - + # for my $id(@$orderOf){ - #if a file upload, write to disk +#if a file upload, write to disk # my $path; # if($id->{'questionType'} eq 'File Upload'){ # $files = 1; @@ -658,19 +670,20 @@ sub www_submitQuestions{ # $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 +# $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){ + 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'}); - if(!$questionId){ + my $questionId = + $self->getNextQuestionId( $lastA->{'Survey_questionId'} ); + if ( !$questionId ) { my $currentSection = $self->getCurrentSection($responseId); $currentSection = $self->getNextSection($currentSection); - if($currentSection){ - $self->setCurrentSection($responseId,$currentSection); + if ($currentSection) { + $self->setCurrentSection( $responseId, $currentSection ); } } return; @@ -678,232 +691,261 @@ sub www_submitQuestions{ return $self->www_loadQuestions($responseId); } - - - - - #finds the questions to display next and builds the data structre to hold them #------------------------------------------------------------------- -sub www_loadQuestions{ - my $self=shift; - - - if(!$self->canTakeSurvey()){ +sub www_loadQuestions { + my $self = shift; + + if ( !$self->canTakeSurvey() ) { return $self->surveyEnd(); } - my $responseId = $self->getResponseId();#also loads the survey and response - if(!$responseId){ - return $self->surveyEnd(); + my $responseId = $self->getResponseId(); #also loads the survey and response + if ( !$responseId ) { + return $self->surveyEnd(); } - - return $self->surveyEnd() if($self->response->surveyEnd()); + + return $self->surveyEnd() if ( $self->response->surveyEnd() ); my $questions; -eval{ - $questions = $self->response->nextQuestions(); -}; - - + eval { $questions = $self->response->nextQuestions(); }; my $section = $self->response->nextSection(); - + #return $self->prepareShowSurveyTemplate($section,$questions); $section->{id} = $self->response->nextSectionId(); - my $text = $self->prepareShowSurveyTemplate($section,$questions); + my $text = $self->prepareShowSurveyTemplate( $section, $questions ); return $text; } #------------------------------------------------------------------- #called when the survey is over. -sub surveyEnd{ - my $self = shift; - my $url = shift; - my $responseId = $self->getResponseId();#also loads the survey and response +sub surveyEnd { + my $self = shift; + my $url = shift; + 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->setRow("Survey_response","Survey_responseId",{ - Survey_responseId=>$responseId, - endDate=>WebGUI::DateTime->now->toDatabase, - isComplete=>1 - }); - 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()]); - if(!$url){ + $self->session->db->setRow( + "Survey_response", + "Survey_responseId", + { + Survey_responseId => $responseId, + endDate => WebGUI::DateTime->now->toDatabase, + isComplete => 1 + } + ); + 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() ] + ); + if ( !$url ) { $url = "/"; } } $self->session->http->setMimeType('application/json'); - return encode_json({"type","forward","url",$url}); + return encode_json( { "type", "forward", "url", $url } ); } - - #------------------------------------------------------------------- #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); - 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); +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 + ); + 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 ); - foreach my $q(@$questions){ - if($fileUpload{$$q{'questionType'}}){ $q->{'fileLoader'} = 1; } - elsif($text{$$q{'questionType'}}){ $q->{'textType'} = 1; } - elsif($hidden{$$q{'questionType'}}){ $q->{'hidden'} = 1; } - elsif($multipleChoice{$$q{'questionType'}}){ - $q->{'multipleChoice'} = 1; - if($$q{'maxAnswers'} > 1){ - $q->{'maxMoreOne'} = 1; + foreach my $q (@$questions) { + if ( $fileUpload{ $$q{'questionType'} } ) { $q->{'fileLoader'} = 1; } + elsif ( $text{ $$q{'questionType'} } ) { $q->{'textType'} = 1; } + elsif ( $hidden{ $$q{'questionType'} } ) { $q->{'hidden'} = 1; } + elsif ( $multipleChoice{ $$q{'questionType'} } ) { + $q->{'multipleChoice'} = 1; + if ( $$q{'maxAnswers'} > 1 ) { + $q->{'maxMoreOne'} = 1; } } - elsif($dateType{$$q{'questionType'}}){ - $q->{'dateType'} = 1; + elsif ( $dateType{ $$q{'questionType'} } ) { + $q->{'dateType'} = 1; } - elsif($slider{$$q{'questionType'}}){ + elsif ( $slider{ $$q{'questionType'} } ) { $q->{'slider'} = 1; - if($$q{'questionType'} eq 'Dual Slider - Range'){ + if ( $$q{'questionType'} eq 'Dual Slider - Range' ) { $q->{'dualSlider'} = 1; - $q->{'a1'} = [$q->{'answers'}->[0]]; - $q->{'a2'} = [$q->{'answers'}->[1]]; + $q->{'a1'} = [ $q->{'answers'}->[0] ]; + $q->{'a2'} = [ $q->{'answers'}->[1] ]; } } - - if($$q{'verticalDisplay'}){ $$q{'verts'} = "

    "; $$q{'verte'} = "

    "; } + + if ( $$q{'verticalDisplay'} ) { + $$q{'verts'} = "

    "; + $$q{'verte'} = "

    "; + } } $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 + } + ); } - #------------------------------------------------------------------- -sub loadBothJSON{ +sub loadBothJSON { my $self = shift; - my $rId = shift; - if(defined $self->survey and defined $self->response){return;} - my $ref = $self->session->db->buildArrayRefOfHashRefs(" + my $rId = shift; + if ( defined $self->survey and defined $self->response ) { return; } + my $ref = $self->session->db->buildArrayRefOfHashRefs( " select s.surveyJSON,r.responseJSON from Survey s, Survey_response r where s.assetId = ? and r.Survey_responseId = ?", - [$self->getId,$rId]); - $self->loadSurveyJSON($ref->[0]->{surveyJSON}); - $self->loadResponseJSON($ref->[0]->{responseJSON}, $rId); + [ $self->getId, $rId ] ); + $self->loadSurveyJSON( $ref->[0]->{surveyJSON} ); + $self->loadResponseJSON( $ref->[0]->{responseJSON}, $rId ); } #------------------------------------------------------------------- -sub loadResponseJSON{ - my $self = shift; +sub loadResponseJSON { + my $self = shift; my $jsonHash = shift; - my $rId = shift; + my $rId = shift; $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( +"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 ); } #------------------------------------------------------------------- -sub saveResponseJSON{ +sub saveResponseJSON { my $self = shift; 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} ] + ); } - - - #------------------------------------------------------------------- -sub response{ +sub response { my $self = shift; return $self->{response}; } - #------------------------------------------------------------------- -sub getResponseId{ +sub getResponseId { my $self = shift; - return $self->{responseId} if(defined $self->{responseId}); + return $self->{responseId} if ( defined $self->{responseId} ); 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; - $self->session->http->setCookie("Survey2AnonId",$anonId) if($anonId); + my $anonId = + $self->session->form->process("userid") + || $self->session->http->getCookies->{"Survey2AnonId"} + || undef; + $self->session->http->setCookie( "Survey2AnonId", $anonId ) if ($anonId); -$self->log("here"); my $responseId; - my $string; - - #if there is an anonid or id is for a WG user - if($anonId or $id != 1){ - $string = 'userId'; - if($anonId){ - $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()]); + my $string; - }elsif($id == 1){ - $responseId = $self->session->db->quickScalar("select Survey_responseId from Survey_response where userId = ? and ipAddress = ? and assetId = ? and isComplete = 0", - [$id,$ip,$self->getId()]); + #if there is an anonid or id is for a WG user + if ( $anonId or $id != 1 ) { + $string = 'userId'; + if ($anonId) { + $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() ] + ); + + } + elsif ( $id == 1 ) { + $responseId = $self->session->db->quickScalar( +"select Survey_responseId from Survey_response where userId = ? and ipAddress = ? and assetId = ? and isComplete = 0", + [ $id, $ip, $self->getId() ] + ); } - if(! $responseId){ -$self->log("no response id"); - my $allowedTakes = $self->session->db->quickScalar("select maxResponsesPerUser from Survey where assetId = ? order by revisionDate desc limit 1",[$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 $haveTaken; - if($id == 1 ){ - $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()]); + if ( $id == 1 ) { + $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() ] + ); } - if($haveTaken < $allowedTakes){ -$self->log("creating new response"); - $responseId = $self->session->db->setRow("Survey_response","Survey_responseId",{ - Survey_responseId=>"new", - userId=>$id, - ipAddress=>$ip, - username=>$self->session->user->username, - startDate=>WebGUI::DateTime->now->toDatabase, - endDate=>WebGUI::DateTime->now->toDatabase, - assetId=>$self->getId(), - anonId=>$anonId - }); -$self->log("1"); + if ( $haveTaken < $allowedTakes ) { + $responseId = $self->session->db->setRow( + "Survey_response", + "Survey_responseId", + { + Survey_responseId => "new", + userId => $id, + ipAddress => $ip, + username => $self->session->user->username, + startDate => WebGUI::DateTime->now->toDatabase, + endDate => WebGUI::DateTime->now->toDatabase, + assetId => $self->getId(), + anonId => $anonId + } + ); $self->loadBothJSON($responseId); -$self->log("2"); $self->response->createSurveyOrder(); -$self->log("3"); $self->{responseId} = $responseId; -$self->log("4"); $self->saveResponseJSON(); -$self->log("loaded nad saved survey and response"); - }else{ + } + else { } } $self->{responseId} = $responseId; @@ -911,37 +953,40 @@ $self->log("loaded nad saved survey and response"); return $responseId; } - #------------------------------------------------------------------- -sub canTakeSurvey{ +sub canTakeSurvey { my $self = shift; - - return $self->{canTake} if(defined $self->{canTake}); - - if(!$self->session->user->isInGroup($self->get("groupToTakeSurvey"))){ + return $self->{canTake} if ( defined $self->{canTake} ); + + if ( !$self->session->user->isInGroup( $self->get("groupToTakeSurvey") ) ) { return 0; } #Does user have too many finished survey responses - my $maxTakes = $self->getValue("maxResponsesPerUser"); - my $ip = $self->session->env->getIp; - my $id = $self->session->user->userId(); - my $takenCount = 0; + my $maxTakes = $self->getValue("maxResponsesPerUser"); + my $ip = $self->session->env->getIp; + my $id = $self->session->user->userId(); + my $takenCount = 0; - - if($id == 1){ - $takenCount = $self->session->db->quickScalar("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]); + if ( $id == 1 ) { + $takenCount = $self->session->db->quickScalar( +"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 ] + ); } - - if($takenCount >= $maxTakes){ + if ( $takenCount >= $maxTakes ) { $self->{canTake} = 0; - }else{ + } + else { $self->{canTake} = 1; } return $self->{canTake}; @@ -950,63 +995,95 @@ 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()]); - return $self->export($filename,$content); + 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() ] + ); + return $self->export( $filename, $content ); } #------------------------------------------------------------------- -sub export{ - my $self = shift; - my $filename = shift; - $filename =~ s/[^\w\d\.]/_/g; - my $content = shift; - #Create a temporary directory to store files if it doesn't already exist - my $store = WebGUI::Storage->createTemp( $self->session ); - 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"; - } - print TEMP $content; - close TEMP; - my $fileurl = $store->getUrl($filename); +sub export { + my $self = shift; + my $filename = shift; + $filename =~ s/[^\w\d\.]/_/g; + my $content = shift; - $self->session->http->setRedirect($fileurl); + #Create a temporary directory to store files if it doesn't already exist + my $store = WebGUI::Storage->createTemp( $self->session ); + 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"; + } + print TEMP $content; + close TEMP; + my $fileurl = $store->getUrl($filename); - return undef; + $self->session->http->setRedirect($fileurl); + + return undef; } - -sub loadTempReportTable{ +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 = ?",[$self->getId()]); - for my $ref(@$refs){ - $self->loadResponseJSON(undef,$ref->{Survey_responseId}); + 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]); + 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 + ] + ); 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]); + 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 + ] + ); } } } return 1; } -sub log{ + +sub log { my $self = shift; $self->session->errorHandler->error(shift); } diff --git a/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm b/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm index 22ccc9f86..1c2f61473 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/ResponseJSON.pm @@ -4,19 +4,24 @@ use strict; use JSON; use Data::Dumper; -sub new{ - my $class = shift; - my $json = shift; - my $log = shift; +sub new { + my $class = shift; + my $json = shift; + my $log = shift; my $survey = shift; - my $self = {}; + my $self = {}; $self->{survey} = $survey; - $self->{log} = $log; + $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->{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); + $self->{lastResponse} = + defined $temp->{lastResponse} ? $temp->{lastResponse} : -1; + bless( $self, $class ); return $self; } @@ -30,308 +35,366 @@ Forks are passed in to show where to branch the new order. =cut -sub createSurveyOrder{ +sub createSurveyOrder { my $self = shift; my $order; my $qstarting = 0; -$self->log('wtf am I faling for'); - 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])})); - }else{ - @qorder = (($qstarting .. $#{$self->survey->questions([$s])})); + if ( $self->survey->section( [$s] )->{randomizeQuestions} ) { + @qorder = shuffle( + ( $qstarting .. $#{ $self->survey->questions( [$s] ) } ) ); + } + else { + @qorder = + ( ( $qstarting .. $#{ $self->survey->questions( [$s] ) } ) ); } - #if this is an empty section, make sure it is still on the list to be seen - if(@qorder == 0){ - push(@$order,[$s]); + #if this is an empty section, make sure it is still on the list to be seen + if ( @qorder == 0 ) { + push( @$order, [$s] ); } $qstarting = 0; + #create answer order for question - for (@qorder){ + for (@qorder) { my @aorder; - if($self->survey->question([$s,$_])->{randomizeAnswers}){ - @aorder = shuffle(($qstarting .. $#{$self->survey->question([$s,$_])->{answers}})); - }else{ - @aorder = (($qstarting .. $#{$self->survey->question([$s,$_])->{answers}})); + if ( $self->survey->question( [ $s, $_ ] )->{randomizeAnswers} ) { + @aorder = shuffle( + ( + $qstarting .. + $#{ $self->survey->question( [ $s, $_ ] )->{answers} } + ) + ); } - push(@$order,[$s,$_,\@aorder]); + else { + @aorder = ( + ( + $qstarting .. + $#{ $self->survey->question( [ $s, $_ ] )->{answers} } + ) + ); + } + push( @$order, [ $s, $_, \@aorder ] ); } } $self->{surveyOrder} = $order; } + sub shuffle { my @a = splice @_; - for my $i (0 .. $#a) { + for my $i ( 0 .. $#a ) { my $j = int rand @a; - @a[$i, $j] = @a[$j, $i]; + @a[ $i, $j ] = @a[ $j, $i ]; } return @a; } -sub freeze{ +sub freeze { my $self = shift; my %temp = %{$self}; delete $temp{log}; delete $temp{survey}; - return encode_json(\%temp); + return encode_json( \%temp ); } #the index of the last surveyOrder entry shown -sub lastResponse{ +sub lastResponse { my $self = shift; - my $res = shift; - if(defined $res){ + my $res = shift; + if ( defined $res ) { $self->{lastResponse} = $res; - }else{ + } + else { return $self->{lastResponse}; } } + #array of addresses in which the survey should be presented -sub surveyOrder{ +sub surveyOrder { my $self = shift; return $self->{surveyOrder}; } - -sub nextSectionId{ +sub nextSectionId { my $self = shift; - return $self->surveyOrder->[$self->lastResponse + 1]->[0]; + return $self->surveyOrder->[ $self->lastResponse + 1 ]->[0]; } - -sub nextSection{ +sub nextSection { my $self = shift; - 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 + 1 ]->[0] ] ); } -sub recordResponses{ +sub currentSection { my $self = shift; + return $self->survey->section( + [ $self->surveyOrder->[ $self->lastResponse ]->[0] ] ); +} + +sub recordResponses { + my $self = shift; my $responses = shift; - my $session = shift; + 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); - 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. + 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 + ); + 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. my $questions = $self->nextQuestions(); my $qAnswered = 1; - my $terminal = 0; + my $terminal = 0; my $terminalUrl; my $goto; + #my $section = $self->survey->section([$questions->[0]->{sid}]); my $section = $self->currentSection(); - if($section->{terminal}){ - $terminal = 1; + if ( $section->{terminal} ) { + $terminal = 1; $terminalUrl = $section->{terminalUrl}; } - - #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); - #$self->log("Incrementing last response by one"); - return [$terminal,$terminalUrl]; - } -#$self->log("There are questions to be submitted in this section"); - for my $question(@$questions){ +#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 ]; + } + + for my $question (@$questions) { my $aAnswered = 0; - if($question->{terminal}){ - $terminal = 1; + if ( $question->{terminal} ) { + $terminal = 1; $terminalUrl = $question->{terminalUrl}; } - $self->responses->{$question->{id}}->{comment} = $responses->{$question->{id}."comment"}; - for my $answer(@{$question->{answers}}){ + $self->responses->{ $question->{id} }->{comment} = + $responses->{ $question->{id} . "comment" }; + for my $answer ( @{ $question->{answers} } ) { - if(defined($responses->{$answer->{id}}) and $responses->{$answer->{id}} =~ /\S/){ + if ( defined( $responses->{ $answer->{id} } ) + and $responses->{ $answer->{id} } =~ /\S/ ) + { $aAnswered = 1; - if($mcTypes{$question->{questionType}}){ - $self->responses->{$answer->{id}}->{value} = $answer->{recordedAnswer}; -#$self->log("Recorded Answer ".$answer->{recordedAnswer}); + if ( $mcTypes{ $question->{questionType} } ) { + $self->responses->{ $answer->{id} }->{value} = + $answer->{recordedAnswer}; } - else{ -#$self->log("Returned Answer ".$responses->{$answer->{id}}); - $self->responses->{$answer->{id}}->{value} = $responses->{$answer->{id}}; + else { + $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} }->{'time'} = time(); + $self->responses->{ $answer->{id} }->{comment} = + $responses->{ $answer->{id} . "comment" }; - if($answer->{terminal}){ - $terminal = 1; + if ( $answer->{terminal} ) { + $terminal = 1; $terminalUrl = $answer->{terminalUrl}; } - elsif($answer->{goto} =~ /\w/){ - $goto = $answer->{goto}; + elsif ( $answer->{goto} =~ /\w/ ) { + $goto = $answer->{goto}; } } } - $qAnswered = 0 if(!$aAnswered and $question->{required}); + $qAnswered = 0 if ( !$aAnswered and $question->{required} ); } - - #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); - }else{ + +#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 ); + } + else { $terminal = 0; } - return [$terminal,$terminalUrl]; + return [ $terminal, $terminalUrl ]; } -sub goto{ + +sub goto { my $self = shift; my $goto = shift; -#$self->log("In goto for '$goto'"); - 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){ -#$self->log("setting lastResponse to section ".($i-1)); - $self->lastResponse($i - 1); + 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 ) { + $self->lastResponse( $i - 1 ); last; } - if(ref $question eq 'HASH' and $question->{variable} eq $goto){ -#$self->log("setting lastResponse to question ".($i-1)); - $self->lastResponse($i - 1); + if ( ref $question eq 'HASH' and $question->{variable} eq $goto ) { + $self->lastResponse( $i - 1 ); last; } - } + } } -sub getPreviousAnswer{ - my $self = shift; + +sub getPreviousAnswer { + my $self = shift; my $questionParam = shift; - for my $q (@{$self->surveyOrder}){ - 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}; + for my $q ( @{ $self->surveyOrder } ) { + 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}; } } } } } -sub nextQuestions{ +sub nextQuestions { my $self = shift; -#$self->log("In nextQuestions"); - if($self->lastResponse >= $#{$self->surveyOrder}){ + if ( $self->lastResponse >= $#{ $self->surveyOrder } ) { return []; } my $nextSectionId = $self->nextSectionId; -#$self->log("next sectionid is $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(); -#$self->log("Section text is ".$section->{text}); + my $section = $self->nextSection(); $section->{'text'} =~ s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg; -#$self->log("qperpage $qPerPage"); - my $questions; - for(my $i = 1; $i <= $qPerPage; $i++){ - my $qAddy = $self->surveyOrder->[$self->lastResponse + $i]; -#$self->log("qAddy was $$qAddy[0]-$$qAddy[1]"); - next if(! exists $$qAddy[1]);#skip this if it doesn't have a question (for sections with no questions) + 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($$qAddy[0] != $nextSectionId){ -#$self->log("Next question section did not match current section"); + if ( $$qAddy[0] != $nextSectionId ) { last; } -#$self->log("wtf"); - 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{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; + for ( @{ $$qAddy[2] } ) { + my $ans = $self->survey->answer( [ $$qAddy[0], $$qAddy[1], $_ ] ); + $ans->{'text'} =~ + s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg; $ans->{id} = "$$qAddy[0]-$$qAddy[1]-$_"; - push(@{$question{answers}},$ans); + push( @{ $question{answers} }, $ans ); } - push(@$questions,\%question); + push( @$questions, \%question ); } -#$self->log("Next Questions returning with "); - return $questions + return $questions; } -sub surveyEnd{ +sub surveyEnd { my $self = shift; -#$self->log("LR is ".$self->lastResponse." and order is ".$#{$self->surveyOrder}); -#$self->log("ENDING THE SURVEY\n\n\n") if($self->lastResponse > $#{$self->surveyOrder}); - return 1 if($self->lastResponse >= $#{$self->surveyOrder}); + return 1 if ( $self->lastResponse >= $#{ $self->surveyOrder } ); return 0; } -sub returnResponseForReporting{ - my $self = shift; +sub returnResponseForReporting { + my $self = shift; my @responses = (); - for my $entry(@{$self->surveyOrder}){ - if(@$entry == 1){ + for my $entry ( @{ $self->surveyOrder } ) { + if ( @$entry == 1 ) { next; } my @answers; - for (@{$$entry[2]}){ - if(defined $self->responses->{"$$entry[0]-$$entry[1]-$_"}){ + 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}){ - my $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}; + 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}; } - $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; + else { + $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; } - push(@answers,($self->responses->{"$$entry[0]-$$entry[1]-$_"})); + else { + $self->responses->{"$$entry[0]-$$entry[1]-$_"} + ->{isCorrect} = 0; + } + push( @answers, + ( $self->responses->{"$$entry[0]-$$entry[1]-$_"} ) ); } } - 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})); + 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 + } + ) + ); } -#$self->log(Dumper @responses); return \@responses; } #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. #Answers only contain, entered text, entered verbatim, their index in the Survey Question Answer array, and the assetId to the uploaded file. -sub responses{ +sub responses { my $self = shift; return $self->{responses}; } -sub survey{ +sub survey { my $self = shift; return $self->{survey}; } -sub log{ - my ($self,$message) = @_; - if(defined $self->{log}){ + +sub log { + my ( $self, $message ) = @_; + if ( defined $self->{log} ) { $self->{log}->error($message); } } diff --git a/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm b/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm index 9e54a379c..1b5c2c0b1 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm @@ -2,444 +2,566 @@ package WebGUI::Asset::Wobject::Survey::SurveyJSON; use strict; use JSON; -use Data::Dumper; -sub new{ +sub new { my $class = shift; - my $json = shift; - my $log = shift; - my $self = {}; + my $json = shift; + my $log = shift; + my $self = {}; $self->{log} = $log; my $temp = decode_json($json) if defined $json; $self->{sections} = defined $temp->{sections} ? $temp->{sections} : []; - $self->{survey} = defined $temp->{survey} ? $temp->{survey} : {}; - bless($self,$class); - if(@{$self->sections} == 0){ - $self->newObject([]); + $self->{survey} = defined $temp->{survey} ? $temp->{survey} : {}; + bless( $self, $class ); + + if ( @{ $self->sections } == 0 ) { + $self->newObject( [] ); } return $self; } -sub freeze{ + +sub freeze { my $self = shift; my %temp; $temp{sections} = $self->{sections}; - $temp{survey} = $self->{survey}; - return encode_json(\%temp); + $temp{survey} = $self->{survey}; + return encode_json( \%temp ); } -sub newObject{ - my $self = shift; + +sub newObject { + my $self = shift; my $address = shift; - if(@$address == 0){ - push(@{$self->sections}, $self->newSection()); - return [$#{$self->sections}]; - }elsif(@$address == 1){ - push( @{$self->questions($address)}, $self->newQuestion($address)); - $$address[1] = $#{$self->questions($address)}; + if ( @$address == 0 ) { + push( @{ $self->sections }, $self->newSection() ); + return [ $#{ $self->sections } ]; + } + elsif ( @$address == 1 ) { + push( @{ $self->questions($address) }, $self->newQuestion($address) ); + $$address[1] = $#{ $self->questions($address) }; return $address; - }elsif(@$address == 2){ - push(@{$self->answers($address)}, $self->newAnswer($address)); - $$address[2] = $#{$self->answers($address)}; + } + elsif ( @$address == 2 ) { + push( @{ $self->answers($address) }, $self->newAnswer($address) ); + $$address[2] = $#{ $self->answers($address) }; return $address; } } #address is the array of objects currently selected in the edit screen -#data is the array of hash items for displaying -sub getDragDropList{ - my $self = shift; +#data is the array of hash items for displaying +sub getDragDropList { + my $self = shift; my $address = shift; my @data; -#$self->log("dd'ing sections".$#{$self->sections}); -eval{ - for(my $i = 0; $i <= $#{$self->sections}; $i++){ - push(@data,{text=>$self->section([$i])->{title}, type=>'section'}); - if($address->[0] == $i){ + 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++){ -##$self->log("dd'ing questions".$#{$self->questions}); - push(@data,{text=>$self->question([$i,$x])->{text}, type=>'question'}); - if($address->[1] == $x){ - for(my $y = 0; $y <= $#{$self->answers($address)}; $y++){ -##$self->log("dd'ing answers".$#{$self->answers}); - push(@data,{text=>$self->answer([$i,$x,$y])->{text}, type=>'answer'}); + for ( my $x = 0 ; $x <= $#{ $self->questions($address) } ; $x++ ) { + push( + @data, + { + text => $self->question( [ $i, $x ] )->{text}, + type => 'question' + } + ); + if ( $address->[1] == $x ) { + for ( + my $y = 0 ; + $y <= $#{ $self->answers($address) } ; + $y++ + ) + { + push( + @data, + { + text => $self->answer( [ $i, $x, $y ] )->{text}, + type => 'answer' + } + ); } } } } } -}; -#$self->log($@); -##$self->log('finished dding'); return \@data; } -sub getObject{ - my ($self,$address) = @_; - if(@$address == 1){ - return $self->{sections}->[$address->[0]]; - }elsif(@$address == 2){ - return $self->{sections}->[$address->[0]]->{questions}->[$address->[1]]; - }else{ - return $self->{sections}->[$address->[0]]->{questions}->[$address->[1]]->{answers}->[$address->[2]]; +sub getObject { + my ( $self, $address ) = @_; + if ( @$address == 1 ) { + return $self->{sections}->[ $address->[0] ]; + } + elsif ( @$address == 2 ) { + return $self->{sections}->[ $address->[0] ]->{questions} + ->[ $address->[1] ]; + } + else { + return $self->{sections}->[ $address->[0] ]->{questions} + ->[ $address->[1] ]->{answers}->[ $address->[2] ]; } } -sub getEditVars{ - my ($self,$address) = @_; - - if(@$address == 1){ +sub getEditVars { + my ( $self, $address ) = @_; + + if ( @$address == 1 ) { return $self->getSectionEditVars($address); - }elsif(@$address == 2){ + } + elsif ( @$address == 2 ) { return $self->getQuestionEditVars($address); - }elsif(@$address == 3){ + } + elsif ( @$address == 3 ) { return $self->getAnswerEditVars($address); } } -sub getSectionEditVars{ - my $self = shift; + +sub getSectionEditVars { + my $self = shift; my $address = shift; - my $object = $self->section($address); - my %var = %{$object}; - $var{id} = $address->[0]; - $var{displayed_id} = $address->[0]+1; + my $object = $self->section($address); + my %var = %{$object}; + $var{id} = $address->[0]; + $var{displayed_id} = $address->[0] + 1; delete $var{questions}; delete $var{questionsPerPage}; - for(1 .. 20){ -# if($_ == $self->section($address)->{questionsPerPage}){ - if($_ == $object->{questionsPerPage}){ - push(@{$var{questionsPerPage}},{'index',$_,'selected',1}); - }else{ - push(@{$var{questionsPerPage}},{'index',$_,'selected',0}); + + for ( 1 .. 20 ) { + + # if($_ == $self->section($address)->{questionsPerPage}){ + if ( $_ == $object->{questionsPerPage} ) { + push( @{ $var{questionsPerPage} }, { 'index', $_, 'selected', 1 } ); + } + else { + push( @{ $var{questionsPerPage} }, { 'index', $_, 'selected', 0 } ); } } return \%var; } -sub getQuestionEditVars{ - my $self = shift; + +sub getQuestionEditVars { + my $self = shift; my $address = shift; - my $object = $self->question($address); - my %var = %{$object}; - $var{id} = $address->[0]."-".$address->[1]; - $var{displayed_id} = $address->[1]+1; + my $object = $self->question($address); + my %var = %{$object}; + $var{id} = $address->[0] . "-" . $address->[1]; + $var{displayed_id} = $address->[1] + 1; 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','Yes/No'); - for(@types){ - if($_ eq $object->{questionType}){ - push(@{$var{questionType}},{'text',$_,'selected',1}); - }else{ - push(@{$var{questionType}},{'text',$_,'selected',0}); + 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', + 'Yes/No' + ); + + for (@types) { + if ( $_ eq $object->{questionType} ) { + push( @{ $var{questionType} }, { 'text', $_, 'selected', 1 } ); + } + else { + push( @{ $var{questionType} }, { 'text', $_, 'selected', 0 } ); } } return \%var; } -sub getAnswerEditVars{ - my $self = shift; + +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{displayed_id} = $address->[2]+1; + my $object = $self->answer($address); + my %var = %{$object}; + $var{id} = $address->[0] . "-" . $address->[1] . "-" . $address->[2]; + $var{displayed_id} = $address->[2] + 1; return \%var; } -sub update{ - my ($self,$address,$ref) = @_; +sub update { + my ( $self, $address, $ref ) = @_; my $object; my $newQuestion = 0; - if(@$address == 1){ -#$self->log("A section"); + if ( @$address == 1 ) { $object = $self->section($address); - if(! defined $object){ + if ( !defined $object ) { $object = $self->newSection(); - push(@{$self->sections},$object); + push( @{ $self->sections }, $object ); } - }elsif(@$address == 2){ -#$self->log("A question"); + } + elsif ( @$address == 2 ) { $object = $self->question($address); - if(! defined $object){ + if ( !defined $object ) { my $newQuestion = 1; $object = $self->newQuestion(); - push(@{$self->questions($address)},$object); + push( @{ $self->questions($address) }, $object ); } - }elsif(@$address == 3){ -#$self->log("A answer"); + } + elsif ( @$address == 3 ) { $object = $self->answer($address); - if(! defined $object){ + if ( !defined $object ) { $object = $self->newAnswer(); - push(@{$self->answers($address)},$object); + push( @{ $self->answers($address) }, $object ); } } - if(@$address == 2 and ! $newQuestion){ - if($ref->{questionType} ne $self->question($address)->{questionType}){ - $self->updateQuestionAnswers($address,$ref->{questionType}); + if ( @$address == 2 and !$newQuestion ) { + if ( $ref->{questionType} ne $self->question($address)->{questionType} ) + { + $self->updateQuestionAnswers( $address, $ref->{questionType} ); } } - for my $key(keys %$object){ -#$self->log("$key $$object{$key}"); - $object->{$key} = $ref->{$key} if(defined $$ref{$key}); + for my $key ( keys %$object ) { + $object->{$key} = $ref->{$key} if ( defined $$ref{$key} ); } } - #determine what to add and add it. # ref should contain all the information for the new -sub insertObject{ - my ($self,$object,$address) = @_; -#$self->log("Inserting ".join(',',@$address)); - if(@$address == 1){ - splice(@{$self->sections($address)},$$address[0] + 1, 0, $object); - }elsif(@$address == 2){ - splice(@{$self->questions($address)},$$address[1] + 1, 0, $object); - }elsif(@$address == 3){ - splice(@{$self->answers($address)},$$address[2] + 1, 0, $object); +sub insertObject { + my ( $self, $object, $address ) = @_; + if ( @$address == 1 ) { + splice( @{ $self->sections($address) }, $$address[0] + 1, 0, $object ); + } + elsif ( @$address == 2 ) { + splice( @{ $self->questions($address) }, $$address[1] + 1, 0, $object ); + } + elsif ( @$address == 3 ) { + splice( @{ $self->answers($address) }, $$address[2] + 1, 0, $object ); } -#$self->log("Finished inserting "); } -sub copy{ - my ($self,$address) = @_; - if(@$address == 1){ - my %newSection = %{$self->section($address)}; - push(@{$self->sections}, \%newSection); - return [$#{$self->sections}]; -#$self->log("copying here $$address[0] :".$#{$self->sections}); - }elsif(@$address == 2){ -#$self->log("copying question $$address[0] $$address[1]"); - my %newQuestion = %{$self->question($address)}; - push( @{$self->questions($address)}, \%newQuestion); - $$address[1] = $#{$self->questions($address)}; -#$self->log("to $$address[0] $$address[1]"); - return $address; +sub copy { + my ( $self, $address ) = @_; + if ( @$address == 1 ) { + my %newSection = %{ $self->section($address) }; + push( @{ $self->sections }, \%newSection ); + return [ $#{ $self->sections } ]; + } + elsif ( @$address == 2 ) { + my %newQuestion = %{ $self->question($address) }; + push( @{ $self->questions($address) }, \%newQuestion ); + $$address[1] = $#{ $self->questions($address) }; + return $address; } } - -sub remove{ - my ($self,$address,$movingOverride) = @_; - if(@$address == 1){ -#$self->log("removing here $$address[0] :".$#{$self->sections}) if($$address[0] != 0 or defined $movingOverride);; - splice(@{$self->{sections}},$$address[0],1) if($$address[0] != 0 or defined $movingOverride);#can't delete the first section -#$self->log("removing here $$address[0] :".$#{$self->sections}); - }elsif(@$address == 2){ -#$self->log("removing here $$address[0] $$address[1]"); - splice(@{$self->questions($address)},$$address[1],1); - }elsif(@$address == 3){ -#$self->log("removing here $$address[0] $$address[1] $$address[2]"); - splice(@{$self->answers($address)},$$address[2],1); +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 + } + elsif ( @$address == 2 ) { + splice( @{ $self->questions($address) }, $$address[1], 1 ); + } + elsif ( @$address == 3 ) { + splice( @{ $self->answers($address) }, $$address[2], 1 ); } } -sub newSection{ +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, - 'type','section' - ); + '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} = []; return \%members; } -sub newQuestion{ + +sub newQuestion { my %members = ( - 'text', '', - 'variable','', - 'allowComment',0, - 'commentCols',10, - 'commentRows',5, - 'randomizeAnswers',0, - 'questionType','Multiple Choice', - 'randomWords','', - 'verticalDisplay',0, - 'required',0, - 'maxAnswers',1, - 'value',1, - 'textInButton',0, -# 'terminal',0, -# 'terminalUrl','', - 'type','question' - ); + 'text', '', + 'variable', '', + 'allowComment', 0, + 'commentCols', 10, + 'commentRows', 5, + 'randomizeAnswers', 0, + 'questionType', 'Multiple Choice', + 'randomWords', '', + 'verticalDisplay', 0, + 'required', 0, + 'maxAnswers', 1, + 'value', 1, + 'textInButton', 0, + + # 'terminal',0, + # 'terminalUrl','', + 'type', 'question' + ); $members{answers} = []; return \%members; } -sub newAnswer{ + +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; } -sub updateQuestionAnswers{ - my $self = shift; +sub updateQuestionAnswers { + my $self = shift; my $address = shift; - my $type = shift; + my $type = shift; -#$self->log("In updateQuestion"); - - my @addy = @{$address}; + my @addy = @{$address}; my $question = $self->question($address); $question->{answers} = []; - if($type eq 'Date Range' or $type eq 'Multi Slider - Allocate' or $type eq 'Dual Slider - Range'){ - push(@{$question->{answers}},$self->newAnswer()); - push(@{$question->{answers}},$self->newAnswer()); - }elsif($type eq 'Currency'){ - push(@{$question->{answers}},$self->newAnswer()); - $addy[2] = 0; - $self->update(\@addy,{'text','Currency Amount'}); - }elsif($type eq 'Text Date'){ - push(@{$question->{answers}},$self->newAnswer()); - $addy[2] = 0; - $self->update(\@addy,{'text','Date:'}); - }elsif($type eq 'Phone Number'){ - push(@{$question->{answers}},$self->newAnswer()); - $addy[2] = 0; - $self->update(\@addy,{'text','Phone Number:'}); - }elsif($type eq 'Email'){ - push(@{$question->{answers}},$self->newAnswer()); - $addy[2] = 0; - $self->update(\@addy,{'text','Email:'}); - }elsif($type eq 'Education'){ - my @ans = ('Elementary or some high school','High school/GED','Some college/vocational school','College graduate', - 'Some graduate work','Master\'s degree','Doctorate (of any type)','Other degree (verbatim)'); - $self->addAnswersToQuestion(\@addy,\@ans,{7,1}); - }elsif($type eq 'Party'){ - 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)'); - $self->addAnswersToQuestion(\@addy,\@ans,{5,1}); - }elsif($type eq 'Ideology'){ - my @ans = ('Strongly liberal','Liberal','Somewhat liberal','Middle of the road','Slightly conservative','Conservative','Strongly conservative'); - $self->addAnswersToQuestion(\@addy,\@ans,{}); - }elsif($type eq 'Security'){ - my @ans = ('Not at all secure','','','','','','','','','','Extremely secure'); - $self->addAnswersToQuestion(\@addy,\@ans,{}); - }elsif($type eq 'Threat'){ - my @ans = ('No threat','','','','','','','','','','Extreme threat'); - $self->addAnswersToQuestion(\@addy,\@ans,{}); - }elsif($type eq 'Risk'){ - my @ans = ('No risk','','','','','','','','','','Extreme risk'); - $self->addAnswersToQuestion(\@addy,\@ans,{}); - }elsif($type eq 'Concern'){ - my @ans = ('Not at all concerned','','','','','','','','','','Extremely concerned'); - $self->addAnswersToQuestion(\@addy,\@ans,{}); - }elsif($type eq 'Effectiveness'){ - my @ans = ('Not at all effective','','','','','','','','','','Extremely effective'); - $self->addAnswersToQuestion(\@addy,\@ans,{}); - }elsif($type eq 'Confidence'){ - my @ans = ('Not at all confident','','','','','','','','','','Extremely confident'); - $self->addAnswersToQuestion(\@addy,\@ans,{}); - }elsif($type eq 'Satisfaction'){ - my @ans = ('Not at all satisfied','','','','','','','','','','Extremely satisfied'); - $self->addAnswersToQuestion(\@addy,\@ans,{}); - }elsif($type eq 'Certainty'){ - my @ans = ('Not at all certain','','','','','','','','','','Extremely certain'); - $self->addAnswersToQuestion(\@addy,\@ans,{}); - }elsif($type eq 'Likelihood'){ - my @ans = ('Not at all likely','','','','','','','','','','Extremely likely'); - $self->addAnswersToQuestion(\@addy,\@ans,{}); - }elsif($type eq 'Importance'){ - my @ans = ('Not at all important','','','','','','','','','','Extremely important'); - $self->addAnswersToQuestion(\@addy,\@ans,{}); - }elsif($type eq 'Oppose/Support'){ - my @ans = ('Strongly oppose','','','','','','Strongly Support'); - $self->addAnswersToQuestion(\@addy,\@ans,{}); - }elsif($type eq 'Agree/Disagree'){ - my @ans = ('Strongly disagree','','','','','','Strongly agree'); - $self->addAnswersToQuestion(\@addy,\@ans,{}); - }elsif($type eq 'True/False'){ - my @ans = ('True','False'); - $self->addAnswersToQuestion(\@addy,\@ans,{}); - }elsif($type eq 'Yes/No'){ - my @ans = ('Yes','No'); - $self->addAnswersToQuestion(\@addy,\@ans,{}); - }elsif($type eq 'Gender'){ - my @ans = ('Male','Female'); - $self->addAnswersToQuestion(\@addy,\@ans,{}); - }else{ - push(@{$question->{answers}},$self->newAnswer()); + if ( $type eq 'Date Range' + or $type eq 'Multi Slider - Allocate' + or $type eq 'Dual Slider - Range' ) + { + push( @{ $question->{answers} }, $self->newAnswer() ); + push( @{ $question->{answers} }, $self->newAnswer() ); } -} -sub addAnswersToQuestion{ - my $self = shift; - my $addy = shift; - my $ans = shift; - my $verbs = shift; -#$self->log(Dumper $verbs); - for(0 .. $#$ans){ - push(@{$self->question($addy)->{answers}},$self->newAnswer()); - $$addy[2] = $_; -#$self->log("$_:".defined $$verbs{$_}." ".$$verbs{$_}); - if(defined $$verbs{$_} and $_ == $$verbs{$_}){ - $self->update($addy,{'text',$$ans[$_],'recordedAnswer',$_+1,'verbatim',1}); - }else{ - $self->update($addy,{'text',$$ans[$_],'recordedAnswer',$_+1}); - } + elsif ( $type eq 'Currency' ) { + push( @{ $question->{answers} }, $self->newAnswer() ); + $addy[2] = 0; + $self->update( \@addy, { 'text', 'Currency Amount' } ); + } + elsif ( $type eq 'Text Date' ) { + push( @{ $question->{answers} }, $self->newAnswer() ); + $addy[2] = 0; + $self->update( \@addy, { 'text', 'Date:' } ); + } + elsif ( $type eq 'Phone Number' ) { + push( @{ $question->{answers} }, $self->newAnswer() ); + $addy[2] = 0; + $self->update( \@addy, { 'text', 'Phone Number:' } ); + } + elsif ( $type eq 'Email' ) { + push( @{ $question->{answers} }, $self->newAnswer() ); + $addy[2] = 0; + $self->update( \@addy, { 'text', 'Email:' } ); + } + elsif ( $type eq 'Education' ) { + my @ans = ( + 'Elementary or some high school', + 'High school/GED', + 'Some college/vocational school', + 'College graduate', + 'Some graduate work', + 'Master\'s degree', + 'Doctorate (of any type)', + 'Other degree (verbatim)' + ); + $self->addAnswersToQuestion( \@addy, \@ans, { 7, 1 } ); + } + elsif ( $type eq 'Party' ) { + 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)' + ); + $self->addAnswersToQuestion( \@addy, \@ans, { 5, 1 } ); + } + elsif ( $type eq 'Ideology' ) { + my @ans = ( + 'Strongly liberal', + 'Liberal', + 'Somewhat liberal', + 'Middle of the road', + 'Slightly conservative', + 'Conservative', + 'Strongly conservative' + ); + $self->addAnswersToQuestion( \@addy, \@ans, {} ); + } + elsif ( $type eq 'Security' ) { + my @ans = ( + 'Not at all secure', + '', '', '', '', '', '', '', '', '', 'Extremely secure' + ); + $self->addAnswersToQuestion( \@addy, \@ans, {} ); + } + elsif ( $type eq 'Threat' ) { + my @ans = + ( 'No threat', '', '', '', '', '', '', '', '', '', 'Extreme threat' ); + $self->addAnswersToQuestion( \@addy, \@ans, {} ); + } + elsif ( $type eq 'Risk' ) { + my @ans = + ( 'No risk', '', '', '', '', '', '', '', '', '', 'Extreme risk' ); + $self->addAnswersToQuestion( \@addy, \@ans, {} ); + } + elsif ( $type eq 'Concern' ) { + my @ans = ( + 'Not at all concerned', + '', '', '', '', '', '', '', '', '', 'Extremely concerned' + ); + $self->addAnswersToQuestion( \@addy, \@ans, {} ); + } + elsif ( $type eq 'Effectiveness' ) { + my @ans = ( + 'Not at all effective', + '', '', '', '', '', '', '', '', '', 'Extremely effective' + ); + $self->addAnswersToQuestion( \@addy, \@ans, {} ); + } + elsif ( $type eq 'Confidence' ) { + my @ans = ( + 'Not at all confident', + '', '', '', '', '', '', '', '', '', 'Extremely confident' + ); + $self->addAnswersToQuestion( \@addy, \@ans, {} ); + } + elsif ( $type eq 'Satisfaction' ) { + my @ans = ( + 'Not at all satisfied', + '', '', '', '', '', '', '', '', '', 'Extremely satisfied' + ); + $self->addAnswersToQuestion( \@addy, \@ans, {} ); + } + elsif ( $type eq 'Certainty' ) { + my @ans = ( + 'Not at all certain', + '', '', '', '', '', '', '', '', '', 'Extremely certain' + ); + $self->addAnswersToQuestion( \@addy, \@ans, {} ); + } + elsif ( $type eq 'Likelihood' ) { + my @ans = ( + 'Not at all likely', + '', '', '', '', '', '', '', '', '', 'Extremely likely' + ); + $self->addAnswersToQuestion( \@addy, \@ans, {} ); + } + elsif ( $type eq 'Importance' ) { + my @ans = ( + 'Not at all important', + '', '', '', '', '', '', '', '', '', 'Extremely important' + ); + $self->addAnswersToQuestion( \@addy, \@ans, {} ); + } + elsif ( $type eq 'Oppose/Support' ) { + my @ans = ( 'Strongly oppose', '', '', '', '', '', 'Strongly Support' ); + $self->addAnswersToQuestion( \@addy, \@ans, {} ); + } + elsif ( $type eq 'Agree/Disagree' ) { + my @ans = ( 'Strongly disagree', '', '', '', '', '', 'Strongly agree' ); + $self->addAnswersToQuestion( \@addy, \@ans, {} ); + } + elsif ( $type eq 'True/False' ) { + my @ans = ( 'True', 'False' ); + $self->addAnswersToQuestion( \@addy, \@ans, {} ); + } + elsif ( $type eq 'Yes/No' ) { + my @ans = ( 'Yes', 'No' ); + $self->addAnswersToQuestion( \@addy, \@ans, {} ); + } + elsif ( $type eq 'Gender' ) { + my @ans = ( 'Male', 'Female' ); + $self->addAnswersToQuestion( \@addy, \@ans, {} ); + } + else { + push( @{ $question->{answers} }, $self->newAnswer() ); } } +sub addAnswersToQuestion { + my $self = shift; + my $addy = shift; + my $ans = shift; + my $verbs = shift; + for ( 0 .. $#$ans ) { + push( @{ $self->question($addy)->{answers} }, $self->newAnswer() ); + $$addy[2] = $_; + if ( defined $$verbs{$_} and $_ == $$verbs{$_} ) { + $self->update( $addy, + { 'text', $$ans[$_], 'recordedAnswer', $_ + 1, 'verbatim', 1 } + ); + } + else { + $self->update( $addy, + { 'text', $$ans[$_], 'recordedAnswer', $_ + 1 } ); + } + } +} #------------------------------ #accessors and helpers #------------------------------ -sub sections{ +sub sections { my $self = shift; return $self->{sections}; } -sub section{ - my $self = shift; + +sub section { + my $self = shift; my $address = shift; - return $self->{sections}->[$$address[0]]; + return $self->{sections}->[ $$address[0] ]; } -sub questions{ - my $self = shift; + +sub questions { + my $self = shift; my $address = shift; - return $self->{sections}->[$$address[0]]->{questions}; + return $self->{sections}->[ $$address[0] ]->{questions}; } -sub question{ - my $self = shift; + +sub question { + my $self = shift; my $address = shift; - return $self->{sections}->[$$address[0]]->{questions}->[$$address[1]]; + return $self->{sections}->[ $$address[0] ]->{questions}->[ $$address[1] ]; } -sub answers{ - my $self = shift; + +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; + +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{ - my ($self,$message) = @_; - if(defined $self->{log}){ + +sub log { + my ( $self, $message ) = @_; + if ( defined $self->{log} ) { $self->{log}->error($message); } }