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

Removed some debug statements and perltidied the code

Browse source
This commit is contained in:
Kaleb Murphy 2008-11-13 18:59:01 +00:00
parent e75357160a
commit 02d76504a6
3 changed files with 1286 additions and 1024 deletions
Download patch file Download diff file Expand all files Collapse all files

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

File diff suppressed because it is too large Load diff

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

@ -4,19 +4,24 @@ use strict;
use JSON; use JSON;
use Data::Dumper; use Data::Dumper;
sub new{ sub new {
my $class = shift; my $class = shift;
my $json = shift; my $json = shift;
my $log = shift; my $log = shift;
my $survey = shift; my $survey = shift;
my $self = {}; my $self = {};
$self->{survey} = $survey; $self->{survey} = $survey;
$self->{log} = $log; $self->{log} = $log;
my $temp = decode_json($json) if defined $json; my $temp = decode_json($json) if defined $json;
$self->{surveyOrder} = 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->{responses} = defined $temp->{responses} ? $temp->{responses} : {};
$self->{lastResponse} = defined $temp->{lastResponse} ? $temp->{lastResponse} : -1; $self->{lastResponse} =
bless($self,$class); defined $temp->{lastResponse} ? $temp->{lastResponse} : -1;
bless( $self, $class );
return $self; return $self;
} }
@ -30,308 +35,366 @@ Forks are passed in to show where to branch the new order.
=cut =cut
sub createSurveyOrder{ sub createSurveyOrder {
my $self = shift; my $self = shift;
my $order; my $order;
my $qstarting = 0; 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 #create question order for section
my @qorder; my @qorder;
if($self->survey->section([$s])->{randomizeQuestions}){ if ( $self->survey->section( [$s] )->{randomizeQuestions} ) {
@qorder = shuffle(($qstarting .. $#{$self->survey->questions([$s])})); @qorder = shuffle(
}else{ ( $qstarting .. $#{ $self->survey->questions( [$s] ) } ) );
@qorder = (($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 this is an empty section, make sure it is still on the list to be seen
if(@qorder == 0){ if ( @qorder == 0 ) {
push(@$order,[$s]); push( @$order, [$s] );
} }
$qstarting = 0; $qstarting = 0;
#create answer order for question #create answer order for question
for (@qorder){ for (@qorder) {
my @aorder; my @aorder;
if($self->survey->question([$s,$_])->{randomizeAnswers}){ if ( $self->survey->question( [ $s, $_ ] )->{randomizeAnswers} ) {
@aorder = shuffle(($qstarting .. $#{$self->survey->question([$s,$_])->{answers}})); @aorder = shuffle(
}else{ (
@aorder = (($qstarting .. $#{$self->survey->question([$s,$_])->{answers}})); $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; $self->{surveyOrder} = $order;
} }
sub shuffle { sub shuffle {
my @a = splice @_; my @a = splice @_;
for my $i (0 .. $#a) { for my $i ( 0 .. $#a ) {
my $j = int rand @a; my $j = int rand @a;
@a[$i, $j] = @a[$j, $i]; @a[ $i, $j ] = @a[ $j, $i ];
} }
return @a; return @a;
} }
sub freeze{ sub freeze {
my $self = shift; my $self = shift;
my %temp = %{$self}; my %temp = %{$self};
delete $temp{log}; delete $temp{log};
delete $temp{survey}; delete $temp{survey};
return encode_json(\%temp); return encode_json( \%temp );
} }
#the index of the last surveyOrder entry shown #the index of the last surveyOrder entry shown
sub lastResponse{ sub lastResponse {
my $self = shift; my $self = shift;
my $res = shift; my $res = shift;
if(defined $res){ if ( defined $res ) {
$self->{lastResponse} = $res; $self->{lastResponse} = $res;
}else{ }
else {
return $self->{lastResponse}; return $self->{lastResponse};
} }
} }
#array of addresses in which the survey should be presented #array of addresses in which the survey should be presented
sub surveyOrder{ sub surveyOrder {
my $self = shift; my $self = shift;
return $self->{surveyOrder}; return $self->{surveyOrder};
} }
sub nextSectionId {
sub nextSectionId{
my $self = shift; my $self = shift;
return $self->surveyOrder->[$self->lastResponse + 1]->[0]; return $self->surveyOrder->[ $self->lastResponse + 1 ]->[0];
} }
sub nextSection {
sub nextSection{
my $self = shift; my $self = shift;
return $self->survey->section([$self->surveyOrder->[$self->lastResponse + 1]->[0]]); return $self->survey->section(
} [ $self->surveyOrder->[ $self->lastResponse + 1 ]->[0] ] );
sub currentSection{
my $self = shift;
return $self->survey->section([$self->surveyOrder->[$self->lastResponse]->[0]]);
} }
sub recordResponses{ sub currentSection {
my $self = shift; my $self = shift;
return $self->survey->section(
[ $self->surveyOrder->[ $self->lastResponse ]->[0] ] );
}
sub recordResponses {
my $self = shift;
my $responses = 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, my %mcTypes = (
'Likelihood',1,'Party',1,'Multiple Choice',1,'Oppose/Support',1,'Race',1,'Risk',1,'Satisfaction',1,'Scale',1,'Security',1, 'Agree/Disagree', 1, 'Certainty', 1, 'Concern', 1,
'Threat',1,'True/False',1,'Yes/No',1); 'Confidence', 1, 'Education', 1, 'Effectiveness', 1,
my %sliderTypes = ('Dual Slider - Range',1,'Multi Slider - Allocate',1,'Slider',1); 'Gender', 1, 'Ideology', 1, 'Importance', 1,
my %textTypes = ('Currency','Email',1,'Phone Number',1,'Text',1,'Text Date',1); 'Likelihood', 1, 'Party', 1, 'Multiple Choice', 1,
my %fileTypes = ('File Upload',1); 'Oppose/Support', 1, 'Race', 1, 'Risk', 1,
my %dateTypes = ('Date','Date Range',1); 'Satisfaction', 1, 'Scale', 1, 'Security', 1,
my %hiddenTypes = ('Hidden',1); 'Threat', 1, 'True/False', 1, 'Yes/No', 1
#These were just submitted from the user, so we need to see what and how they were (un)answered. );
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 $questions = $self->nextQuestions();
my $qAnswered = 1; my $qAnswered = 1;
my $terminal = 0; my $terminal = 0;
my $terminalUrl; my $terminalUrl;
my $goto; my $goto;
#my $section = $self->survey->section([$questions->[0]->{sid}]); #my $section = $self->survey->section([$questions->[0]->{sid}]);
my $section = $self->currentSection(); my $section = $self->currentSection();
if($section->{terminal}){ if ( $section->{terminal} ) {
$terminal = 1; $terminal = 1;
$terminalUrl = $section->{terminalUrl}; $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; my $aAnswered = 0;
if($question->{terminal}){ if ( $question->{terminal} ) {
$terminal = 1; $terminal = 1;
$terminalUrl = $question->{terminalUrl}; $terminalUrl = $question->{terminalUrl};
} }
$self->responses->{$question->{id}}->{comment} = $responses->{$question->{id}."comment"}; $self->responses->{ $question->{id} }->{comment} =
for my $answer(@{$question->{answers}}){ $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; $aAnswered = 1;
if($mcTypes{$question->{questionType}}){ if ( $mcTypes{ $question->{questionType} } ) {
$self->responses->{$answer->{id}}->{value} = $answer->{recordedAnswer}; $self->responses->{ $answer->{id} }->{value} =
#$self->log("Recorded Answer ".$answer->{recordedAnswer}); $answer->{recordedAnswer};
} }
else{ else {
#$self->log("Returned Answer ".$responses->{$answer->{id}}); $self->responses->{ $answer->{id} }->{value} =
$self->responses->{$answer->{id}}->{value} = $responses->{$answer->{id}}; $responses->{ $answer->{id} };
} }
$self->responses->{$answer->{id}}->{'time'} = time(); $self->responses->{ $answer->{id} }->{'time'} = time();
$self->responses->{$answer->{id}}->{comment} = $responses->{$answer->{id}."comment"}; $self->responses->{ $answer->{id} }->{comment} =
$responses->{ $answer->{id} . "comment" };
if($answer->{terminal}){ if ( $answer->{terminal} ) {
$terminal = 1; $terminal = 1;
$terminalUrl = $answer->{terminalUrl}; $terminalUrl = $answer->{terminalUrl};
} }
elsif($answer->{goto} =~ /\w/){ elsif ( $answer->{goto} =~ /\w/ ) {
$goto = $answer->{goto}; $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 all responses completed, move the lastResponse index to the last question shown
if($qAnswered){ if ($qAnswered) {
$self->lastResponse($self->lastResponse + @$questions); $self->lastResponse( $self->lastResponse + @$questions );
$self->goto($goto) if(defined $goto); $self->goto($goto) if ( defined $goto );
}else{ }
else {
$terminal = 0; $terminal = 0;
} }
return [$terminal,$terminalUrl]; return [ $terminal, $terminalUrl ];
} }
sub goto{
sub goto {
my $self = shift; my $self = shift;
my $goto = shift; my $goto = shift;
#$self->log("In goto for '$goto'"); for ( my $i = 0 ; $i <= $#{ $self->surveyOrder() } ; $i++ ) {
for(my $i = 0; $i <= $#{$self->surveyOrder()}; $i++){ my $section = $self->survey->section( $self->surveyOrder()->[$i] );
my $section = $self->survey->section($self->surveyOrder()->[$i]); my $question = $self->survey->question( $self->surveyOrder()->[$i] );
my $question = $self->survey->question($self->surveyOrder()->[$i]); if ( ref $section eq 'HASH' and $section->{variable} eq $goto ) {
if(ref $section eq 'HASH' and $section->{variable} eq $goto){ $self->lastResponse( $i - 1 );
#$self->log("setting lastResponse to section ".($i-1));
$self->lastResponse($i - 1);
last; last;
} }
if(ref $question eq 'HASH' and $question->{variable} eq $goto){ if ( ref $question eq 'HASH' and $question->{variable} eq $goto ) {
#$self->log("setting lastResponse to question ".($i-1)); $self->lastResponse( $i - 1 );
$self->lastResponse($i - 1);
last; last;
} }
} }
} }
sub getPreviousAnswer{
my $self = shift; sub getPreviousAnswer {
my $self = shift;
my $questionParam = shift; my $questionParam = shift;
for my $q (@{$self->surveyOrder}){ for my $q ( @{ $self->surveyOrder } ) {
my $question = $self->survey->question([$$q[0],$$q[1]]); my $question = $self->survey->question( [ $$q[0], $$q[1] ] );
if($question->{variable} eq $questionParam){ if ( $question->{variable} eq $questionParam ) {
for (0 .. @{$self->survey->answers([$$q[0],$$q[1]])}){ for ( 0 .. @{ $self->survey->answers( [ $$q[0], $$q[1] ] ) } ) {
if(exists $self->responses->{$$q[0]."-".$$q[1]."-".$_}){ if (
return $self->responses->{$$q[0]."-".$$q[1]."-".$_}->{value}; exists $self->responses->{ $$q[0] . "-"
. $$q[1] . "-"
. $_ } )
{
return $self->responses->{ $$q[0] . "-"
. $$q[1] . "-"
. $_ }->{value};
} }
} }
} }
} }
} }
sub nextQuestions{ sub nextQuestions {
my $self = shift; my $self = shift;
#$self->log("In nextQuestions");
if($self->lastResponse >= $#{$self->surveyOrder}){ if ( $self->lastResponse >= $#{ $self->surveyOrder } ) {
return []; return [];
} }
my $nextSectionId = $self->nextSectionId; 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 #load Previous answer text
my $section = $self->nextSection(); my $section = $self->nextSection();
#$self->log("Section text is ".$section->{text});
$section->{'text'} =~ s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg; $section->{'text'} =~ s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg;
#$self->log("qperpage $qPerPage");
my $questions; my $questions;
for(my $i = 1; $i <= $qPerPage; $i++){ for ( my $i = 1 ; $i <= $qPerPage ; $i++ ) {
my $qAddy = $self->surveyOrder->[$self->lastResponse + $i]; my $qAddy = $self->surveyOrder->[ $self->lastResponse + $i ];
#$self->log("qAddy was $$qAddy[0]-$$qAddy[1]"); next
next if(! exists $$qAddy[1]);#skip this if it doesn't have a question (for sections with no questions) if ( !exists $$qAddy[1] )
; #skip this if it doesn't have a question (for sections with no questions)
if($$qAddy[0] != $nextSectionId){ if ( $$qAddy[0] != $nextSectionId ) {
#$self->log("Next question section did not match current section");
last; last;
} }
#$self->log("wtf"); my %question =
my %question = %{$self->survey->question([$$qAddy[0],$$qAddy[1]])}; %{ $self->survey->question( [ $$qAddy[0], $$qAddy[1] ] ) };
$question{'text'} =~ s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg; $question{'text'} =~
s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg;
delete $question{answers}; delete $question{answers};
$question{id} = "$$qAddy[0]-$$qAddy[1]"; $question{id} = "$$qAddy[0]-$$qAddy[1]";
$question{sid} = "$$qAddy[0]"; $question{sid} = "$$qAddy[0]";
for (@{$$qAddy[2]}){ for ( @{ $$qAddy[2] } ) {
my $ans = $self->survey->answer([$$qAddy[0],$$qAddy[1],$_]); my $ans = $self->survey->answer( [ $$qAddy[0], $$qAddy[1], $_ ] );
$ans->{'text'} =~ s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg; $ans->{'text'} =~
s/\[\[([^\%]*?)\]\]/$self->getPreviousAnswer($1)/eg;
$ans->{id} = "$$qAddy[0]-$$qAddy[1]-$_"; $ans->{id} = "$$qAddy[0]-$$qAddy[1]-$_";
push(@{$question{answers}},$ans); push( @{ $question{answers} }, $ans );
} }
push(@$questions,\%question); push( @$questions, \%question );
} }
#$self->log("Next Questions returning with "); return $questions;
return $questions
} }
sub surveyEnd{ sub surveyEnd {
my $self = shift; my $self = shift;
#$self->log("LR is ".$self->lastResponse." and order is ".$#{$self->surveyOrder}); return 1 if ( $self->lastResponse >= $#{ $self->surveyOrder } );
#$self->log("ENDING THE SURVEY\n\n\n") if($self->lastResponse > $#{$self->surveyOrder});
return 1 if($self->lastResponse >= $#{$self->surveyOrder});
return 0; return 0;
} }
sub returnResponseForReporting{ sub returnResponseForReporting {
my $self = shift; my $self = shift;
my @responses = (); my @responses = ();
for my $entry(@{$self->surveyOrder}){ for my $entry ( @{ $self->surveyOrder } ) {
if(@$entry == 1){ if ( @$entry == 1 ) {
next; next;
} }
my @answers; my @answers;
for (@{$$entry[2]}){ for ( @{ $$entry[2] } ) {
if(defined $self->responses->{"$$entry[0]-$$entry[1]-$_"}){ if ( defined $self->responses->{"$$entry[0]-$$entry[1]-$_"} ) {
$self->responses->{"$$entry[0]-$$entry[1]-$_"}->{id} = $_; $self->responses->{"$$entry[0]-$$entry[1]-$_"}->{id} = $_;
if($self->survey->answer([$$entry[0],$$entry[1],$_])->{isCorrect}){ if ( $self->survey->answer( [ $$entry[0], $$entry[1], $_ ] )
my $value; ->{isCorrect} )
if($self->survey->answer([$$entry[0],$$entry[1],$_])->{value} =~ /\w/){ {
$value = $self->survey->answer([$$entry[0],$$entry[1],$_])->{value}; my $value;
}else{ if ( $self->survey->answer( [ $$entry[0], $$entry[1], $_ ] )
$value = $self->survey->question([$$entry[0],$$entry[1]])->{value}; ->{value} =~ /\w/ )
{
$value = $self->survey->answer(
[ $$entry[0], $$entry[1], $_ ] )->{value};
} }
$self->responses->{"$$entry[0]-$$entry[1]-$_"}->{value} = $value; else {
$self->responses->{"$$entry[0]-$$entry[1]-$_"}->{isCorrect} = 1; $value =
}else{ $self->survey->question( [ $$entry[0], $$entry[1] ] )
$self->responses->{"$$entry[0]-$$entry[1]-$_"}->{isCorrect} = 0; ->{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], push(
'sectionName',$self->survey->section([$$entry[0]])->{variable}, @responses,
'questionName',$self->survey->question([$$entry[0],$$entry[1]])->{variable}, (
'questionComment',$self->responses->{"$$entry[0]-$$entry[1]"}->{comment}, {
'answers',\@answers})); '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; 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. #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. #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; my $self = shift;
return $self->{responses}; return $self->{responses};
} }
sub survey{ sub survey {
my $self = shift; my $self = shift;
return $self->{survey}; return $self->{survey};
} }
sub log{
my ($self,$message) = @_; sub log {
if(defined $self->{log}){ my ( $self, $message ) = @_;
if ( defined $self->{log} ) {
$self->{log}->error($message); $self->{log}->error($message);
} }
} }

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

@ -2,444 +2,566 @@ package WebGUI::Asset::Wobject::Survey::SurveyJSON;
use strict; use strict;
use JSON; use JSON;
use Data::Dumper;
sub new{ sub new {
my $class = shift; my $class = shift;
my $json = shift; my $json = shift;
my $log = shift; my $log = shift;
my $self = {}; my $self = {};
$self->{log} = $log; $self->{log} = $log;
my $temp = decode_json($json) if defined $json; my $temp = decode_json($json) if defined $json;
$self->{sections} = defined $temp->{sections} ? $temp->{sections} : []; $self->{sections} = defined $temp->{sections} ? $temp->{sections} : [];
$self->{survey} = defined $temp->{survey} ? $temp->{survey} : {}; $self->{survey} = defined $temp->{survey} ? $temp->{survey} : {};
bless($self,$class); bless( $self, $class );
if(@{$self->sections} == 0){
$self->newObject([]); if ( @{ $self->sections } == 0 ) {
$self->newObject( [] );
} }
return $self; return $self;
} }
sub freeze{
sub freeze {
my $self = shift; my $self = shift;
my %temp; my %temp;
$temp{sections} = $self->{sections}; $temp{sections} = $self->{sections};
$temp{survey} = $self->{survey}; $temp{survey} = $self->{survey};
return encode_json(\%temp); return encode_json( \%temp );
} }
sub newObject{
my $self = shift; sub newObject {
my $self = shift;
my $address = shift; my $address = shift;
if(@$address == 0){ if ( @$address == 0 ) {
push(@{$self->sections}, $self->newSection()); push( @{ $self->sections }, $self->newSection() );
return [$#{$self->sections}]; return [ $#{ $self->sections } ];
}elsif(@$address == 1){ }
push( @{$self->questions($address)}, $self->newQuestion($address)); elsif ( @$address == 1 ) {
$$address[1] = $#{$self->questions($address)}; push( @{ $self->questions($address) }, $self->newQuestion($address) );
$$address[1] = $#{ $self->questions($address) };
return $address; return $address;
}elsif(@$address == 2){ }
push(@{$self->answers($address)}, $self->newAnswer($address)); elsif ( @$address == 2 ) {
$$address[2] = $#{$self->answers($address)}; push( @{ $self->answers($address) }, $self->newAnswer($address) );
$$address[2] = $#{ $self->answers($address) };
return $address; return $address;
} }
} }
#address is the array of objects currently selected in the edit screen #address is the array of objects currently selected in the edit screen
#data is the array of hash items for displaying #data is the array of hash items for displaying
sub getDragDropList{ sub getDragDropList {
my $self = shift; my $self = shift;
my $address = shift; my $address = shift;
my @data; my @data;
#$self->log("dd'ing sections".$#{$self->sections}); for ( my $i = 0 ; $i <= $#{ $self->sections } ; $i++ ) {
eval{ push( @data,
for(my $i = 0; $i <= $#{$self->sections}; $i++){ { text => $self->section( [$i] )->{title}, type => 'section' } );
push(@data,{text=>$self->section([$i])->{title}, type=>'section'}); if ( $address->[0] == $i ) {
if($address->[0] == $i){
for(my $x = 0; $x <= $#{$self->questions($address)}; $x++){ for ( my $x = 0 ; $x <= $#{ $self->questions($address) } ; $x++ ) {
##$self->log("dd'ing questions".$#{$self->questions}); push(
push(@data,{text=>$self->question([$i,$x])->{text}, type=>'question'}); @data,
if($address->[1] == $x){ {
for(my $y = 0; $y <= $#{$self->answers($address)}; $y++){ text => $self->question( [ $i, $x ] )->{text},
##$self->log("dd'ing answers".$#{$self->answers}); type => 'question'
push(@data,{text=>$self->answer([$i,$x,$y])->{text}, type=>'answer'}); }
);
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; return \@data;
} }
sub getObject{ sub getObject {
my ($self,$address) = @_; my ( $self, $address ) = @_;
if(@$address == 1){ if ( @$address == 1 ) {
return $self->{sections}->[$address->[0]]; return $self->{sections}->[ $address->[0] ];
}elsif(@$address == 2){ }
return $self->{sections}->[$address->[0]]->{questions}->[$address->[1]]; elsif ( @$address == 2 ) {
}else{ return $self->{sections}->[ $address->[0] ]->{questions}
return $self->{sections}->[$address->[0]]->{questions}->[$address->[1]]->{answers}->[$address->[2]]; ->[ $address->[1] ];
}
else {
return $self->{sections}->[ $address->[0] ]->{questions}
->[ $address->[1] ]->{answers}->[ $address->[2] ];
} }
} }
sub getEditVars{ sub getEditVars {
my ($self,$address) = @_; my ( $self, $address ) = @_;
if(@$address == 1){ if ( @$address == 1 ) {
return $self->getSectionEditVars($address); return $self->getSectionEditVars($address);
}elsif(@$address == 2){ }
elsif ( @$address == 2 ) {
return $self->getQuestionEditVars($address); return $self->getQuestionEditVars($address);
}elsif(@$address == 3){ }
elsif ( @$address == 3 ) {
return $self->getAnswerEditVars($address); return $self->getAnswerEditVars($address);
} }
} }
sub getSectionEditVars{
my $self = shift; sub getSectionEditVars {
my $self = shift;
my $address = shift; my $address = shift;
my $object = $self->section($address); my $object = $self->section($address);
my %var = %{$object}; my %var = %{$object};
$var{id} = $address->[0]; $var{id} = $address->[0];
$var{displayed_id} = $address->[0]+1; $var{displayed_id} = $address->[0] + 1;
delete $var{questions}; delete $var{questions};
delete $var{questionsPerPage}; delete $var{questionsPerPage};
for(1 .. 20){
# if($_ == $self->section($address)->{questionsPerPage}){ for ( 1 .. 20 ) {
if($_ == $object->{questionsPerPage}){
push(@{$var{questionsPerPage}},{'index',$_,'selected',1}); # if($_ == $self->section($address)->{questionsPerPage}){
}else{ if ( $_ == $object->{questionsPerPage} ) {
push(@{$var{questionsPerPage}},{'index',$_,'selected',0}); push( @{ $var{questionsPerPage} }, { 'index', $_, 'selected', 1 } );
}
else {
push( @{ $var{questionsPerPage} }, { 'index', $_, 'selected', 0 } );
} }
} }
return \%var; return \%var;
} }
sub getQuestionEditVars{
my $self = shift; sub getQuestionEditVars {
my $self = shift;
my $address = shift; my $address = shift;
my $object = $self->question($address); my $object = $self->question($address);
my %var = %{$object}; my %var = %{$object};
$var{id} = $address->[0]."-".$address->[1]; $var{id} = $address->[0] . "-" . $address->[1];
$var{displayed_id} = $address->[1]+1; $var{displayed_id} = $address->[1] + 1;
delete $var{answers}; delete $var{answers};
delete $var{questionType}; delete $var{questionType};
my @types = ('Agree/Disagree','Certainty','Concern','Confidence','Currency','Date','Date Range','Dual Slider - Range','Education','Effectiveness', my @types = (
'Email','File Upload','Gender','Hidden','Ideology','Importance','Likelihood','Multi Slider - Allocate','Multiple Choice','Oppose/Support', 'Agree/Disagree', 'Certainty',
'Party','Phone Number','Race','Risk','Satisfaction','Scale','Security','Slider','Text','Text Date','Threat','True/False','Yes/No'); 'Concern', 'Confidence',
for(@types){ 'Currency', 'Date',
if($_ eq $object->{questionType}){ 'Date Range', 'Dual Slider - Range',
push(@{$var{questionType}},{'text',$_,'selected',1}); 'Education', 'Effectiveness',
}else{ 'Email', 'File Upload',
push(@{$var{questionType}},{'text',$_,'selected',0}); '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; return \%var;
} }
sub getAnswerEditVars{
my $self = shift; sub getAnswerEditVars {
my $self = shift;
my $address = shift; my $address = shift;
my $object = $self->answer($address); my $object = $self->answer($address);
my %var = %{$object}; my %var = %{$object};
$var{id} = $address->[0]."-".$address->[1]."-".$address->[2]; $var{id} = $address->[0] . "-" . $address->[1] . "-" . $address->[2];
$var{displayed_id} = $address->[2]+1; $var{displayed_id} = $address->[2] + 1;
return \%var; return \%var;
} }
sub update{ sub update {
my ($self,$address,$ref) = @_; my ( $self, $address, $ref ) = @_;
my $object; my $object;
my $newQuestion = 0; my $newQuestion = 0;
if(@$address == 1){ if ( @$address == 1 ) {
#$self->log("A section");
$object = $self->section($address); $object = $self->section($address);
if(! defined $object){ if ( !defined $object ) {
$object = $self->newSection(); $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); $object = $self->question($address);
if(! defined $object){ if ( !defined $object ) {
my $newQuestion = 1; my $newQuestion = 1;
$object = $self->newQuestion(); $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); $object = $self->answer($address);
if(! defined $object){ if ( !defined $object ) {
$object = $self->newAnswer(); $object = $self->newAnswer();
push(@{$self->answers($address)},$object); push( @{ $self->answers($address) }, $object );
} }
} }
if(@$address == 2 and ! $newQuestion){ if ( @$address == 2 and !$newQuestion ) {
if($ref->{questionType} ne $self->question($address)->{questionType}){ if ( $ref->{questionType} ne $self->question($address)->{questionType} )
$self->updateQuestionAnswers($address,$ref->{questionType}); {
$self->updateQuestionAnswers( $address, $ref->{questionType} );
} }
} }
for my $key(keys %$object){ for my $key ( keys %$object ) {
#$self->log("$key $$object{$key}"); $object->{$key} = $ref->{$key} if ( defined $$ref{$key} );
$object->{$key} = $ref->{$key} if(defined $$ref{$key});
} }
} }
#determine what to add and add it. #determine what to add and add it.
# ref should contain all the information for the new # ref should contain all the information for the new
sub insertObject{ sub insertObject {
my ($self,$object,$address) = @_; my ( $self, $object, $address ) = @_;
#$self->log("Inserting ".join(',',@$address)); if ( @$address == 1 ) {
if(@$address == 1){ splice( @{ $self->sections($address) }, $$address[0] + 1, 0, $object );
splice(@{$self->sections($address)},$$address[0] + 1, 0, $object); }
}elsif(@$address == 2){ elsif ( @$address == 2 ) {
splice(@{$self->questions($address)},$$address[1] + 1, 0, $object); splice( @{ $self->questions($address) }, $$address[1] + 1, 0, $object );
}elsif(@$address == 3){ }
splice(@{$self->answers($address)},$$address[2] + 1, 0, $object); elsif ( @$address == 3 ) {
splice( @{ $self->answers($address) }, $$address[2] + 1, 0, $object );
} }
#$self->log("Finished inserting ");
} }
sub copy{ sub copy {
my ($self,$address) = @_; my ( $self, $address ) = @_;
if(@$address == 1){ if ( @$address == 1 ) {
my %newSection = %{$self->section($address)}; my %newSection = %{ $self->section($address) };
push(@{$self->sections}, \%newSection); push( @{ $self->sections }, \%newSection );
return [$#{$self->sections}]; return [ $#{ $self->sections } ];
#$self->log("copying here $$address[0] :".$#{$self->sections}); }
}elsif(@$address == 2){ elsif ( @$address == 2 ) {
#$self->log("copying question $$address[0] $$address[1]"); my %newQuestion = %{ $self->question($address) };
my %newQuestion = %{$self->question($address)}; push( @{ $self->questions($address) }, \%newQuestion );
push( @{$self->questions($address)}, \%newQuestion); $$address[1] = $#{ $self->questions($address) };
$$address[1] = $#{$self->questions($address)}; return $address;
#$self->log("to $$address[0] $$address[1]");
return $address;
} }
} }
sub remove {
sub remove{ my ( $self, $address, $movingOverride ) = @_;
my ($self,$address,$movingOverride) = @_; if ( @$address == 1 ) {
if(@$address == 1){ splice( @{ $self->{sections} }, $$address[0], 1 )
#$self->log("removing here $$address[0] :".$#{$self->sections}) if($$address[0] != 0 or defined $movingOverride);; 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 ; #can't delete the first section
#$self->log("removing here $$address[0] :".$#{$self->sections}); }
}elsif(@$address == 2){ elsif ( @$address == 2 ) {
#$self->log("removing here $$address[0] $$address[1]"); splice( @{ $self->questions($address) }, $$address[1], 1 );
splice(@{$self->questions($address)},$$address[1],1); }
}elsif(@$address == 3){ elsif ( @$address == 3 ) {
#$self->log("removing here $$address[0] $$address[1] $$address[2]"); splice( @{ $self->answers($address) }, $$address[2], 1 );
splice(@{$self->answers($address)},$$address[2],1);
} }
} }
sub newSection{ sub newSection {
my %members = ( my %members = (
'text', '', 'text', '',
'title', 'NEW SECTION', 'title', 'NEW SECTION',
'variable', '', 'variable', '',
'questionsPerPage', 5, 'questionsPerPage', 5,
'questionsOnSectionPage', 1, 'questionsOnSectionPage', 1,
'randomizeQuestions', 0, 'randomizeQuestions', 0,
'everyPageTitle', 1, 'everyPageTitle', 1,
'everyPageText', 1, 'everyPageText', 1,
'terminal', 0, 'terminal', 0,
'terminalUrl', '', 'terminalUrl', '',
'goto', '', 'goto', '',
'timeLimit', 0, 'timeLimit', 0,
'type','section' 'type', 'section'
); );
$members{questions} = []; $members{questions} = [];
return \%members; return \%members;
} }
sub newQuestion{
sub newQuestion {
my %members = ( my %members = (
'text', '', 'text', '',
'variable','', 'variable', '',
'allowComment',0, 'allowComment', 0,
'commentCols',10, 'commentCols', 10,
'commentRows',5, 'commentRows', 5,
'randomizeAnswers',0, 'randomizeAnswers', 0,
'questionType','Multiple Choice', 'questionType', 'Multiple Choice',
'randomWords','', 'randomWords', '',
'verticalDisplay',0, 'verticalDisplay', 0,
'required',0, 'required', 0,
'maxAnswers',1, 'maxAnswers', 1,
'value',1, 'value', 1,
'textInButton',0, 'textInButton', 0,
# 'terminal',0,
# 'terminalUrl','', # 'terminal',0,
'type','question' # 'terminalUrl','',
); 'type', 'question'
);
$members{answers} = []; $members{answers} = [];
return \%members; return \%members;
} }
sub newAnswer{
sub newAnswer {
my %members = ( my %members = (
'text', '', 'text', '', 'verbatim', 0,
'verbatim',0, 'textCols', 10, 'textRows', 5,
'textCols',10, 'goto', '', 'recordedAnswer', '',
'textRows',5, 'isCorrect', 1, 'min', 1,
'goto','', 'max', 10, 'step', 1,
'recordedAnswer','', 'value', 1, 'terminal', 0,
'isCorrect',1, 'terminalUrl', '', 'type', 'answer'
'min',1, );
'max',10,
'step',1,
'value',1,
'terminal',0,
'terminalUrl','',
'type','answer'
);
return \%members; return \%members;
} }
sub updateQuestionAnswers{ sub updateQuestionAnswers {
my $self = shift; my $self = shift;
my $address = 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); my $question = $self->question($address);
$question->{answers} = []; $question->{answers} = [];
if($type eq 'Date Range' or $type eq 'Multi Slider - Allocate' or $type eq 'Dual Slider - Range'){ if ( $type eq 'Date Range'
push(@{$question->{answers}},$self->newAnswer()); or $type eq 'Multi Slider - Allocate'
push(@{$question->{answers}},$self->newAnswer()); or $type eq 'Dual Slider - Range' )
}elsif($type eq 'Currency'){ {
push(@{$question->{answers}},$self->newAnswer()); push( @{ $question->{answers} }, $self->newAnswer() );
$addy[2] = 0; push( @{ $question->{answers} }, $self->newAnswer() );
$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());
} }
} elsif ( $type eq 'Currency' ) {
sub addAnswersToQuestion{ push( @{ $question->{answers} }, $self->newAnswer() );
my $self = shift; $addy[2] = 0;
my $addy = shift; $self->update( \@addy, { 'text', 'Currency Amount' } );
my $ans = shift; }
my $verbs = shift; elsif ( $type eq 'Text Date' ) {
#$self->log(Dumper $verbs); push( @{ $question->{answers} }, $self->newAnswer() );
for(0 .. $#$ans){ $addy[2] = 0;
push(@{$self->question($addy)->{answers}},$self->newAnswer()); $self->update( \@addy, { 'text', 'Date:' } );
$$addy[2] = $_; }
#$self->log("$_:".defined $$verbs{$_}." ".$$verbs{$_}); elsif ( $type eq 'Phone Number' ) {
if(defined $$verbs{$_} and $_ == $$verbs{$_}){ push( @{ $question->{answers} }, $self->newAnswer() );
$self->update($addy,{'text',$$ans[$_],'recordedAnswer',$_+1,'verbatim',1}); $addy[2] = 0;
}else{ $self->update( \@addy, { 'text', 'Phone Number:' } );
$self->update($addy,{'text',$$ans[$_],'recordedAnswer',$_+1}); }
} 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 #accessors and helpers
#------------------------------ #------------------------------
sub sections{ sub sections {
my $self = shift; my $self = shift;
return $self->{sections}; return $self->{sections};
} }
sub section{
my $self = shift; sub section {
my $self = shift;
my $address = 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; 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; 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; 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; 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) = @_; sub log {
if(defined $self->{log}){ my ( $self, $message ) = @_;
if ( defined $self->{log} ) {
$self->{log}->error($message); $self->{log}->error($message);
} }
} }