Removed some debug statements and perltidied the code
This commit is contained in:
Kaleb Murphy
parent
e75357160a
commit
02d76504a6
3 changed files with 1286 additions and 1024 deletions
File diff suppressed because it is too large
Load diff
|
|
@ -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);
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
}
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue