SurveyJSON->update() should iterate over supplied object keys, not

existing object keys. Also applied PBP formatting, fat commas, etc..
This commit is contained in:
Patrick Donelan 2008-12-15 05:52:07 +00:00
parent b8ef0d659c
commit fa04344b7d

View file

@ -29,6 +29,7 @@ Asset in WebGUI.
use strict; use strict;
use JSON; use JSON;
#use Clone qw/clone/; #use Clone qw/clone/;
use Storable qw/dclone/; use Storable qw/dclone/;
@ -182,16 +183,16 @@ sub getDragDropList {
for ( my $x = 0; $x <= $#{ $self->questions($address) }; $x++ ) { for ( my $x = 0; $x <= $#{ $self->questions($address) }; $x++ ) {
push( push(
@data, { @data,
text => $self->question( [ $i, $x ] )->{text}, { text => $self->question( [ $i, $x ] )->{text},
type => 'question' type => 'question'
} }
); );
if ( $address->[1] == $x ) { if ( $address->[1] == $x ) {
for ( my $y = 0; $y <= $#{ $self->answers($address) }; $y++ ) { for ( my $y = 0; $y <= $#{ $self->answers($address) }; $y++ ) {
push( push(
@data, { @data,
text => $self->answer( [ $i, $x, $y ] )->{text}, { text => $self->answer( [ $i, $x, $y ] )->{text},
type => 'answer' type => 'answer'
} }
); );
@ -245,7 +246,8 @@ sub getObject {
return dclone $self->{sections}->[ $address->[0] ]->{questions}->[ $address->[1] ]; return dclone $self->{sections}->[ $address->[0] ]->{questions}->[ $address->[1] ];
} }
else { else {
return dclone $self->{sections}->[ $address->[0] ]->{questions}->[ $address->[1] ]->{answers}->[ $address->[2] ]; return dclone $self->{sections}->[ $address->[0] ]->{questions}->[ $address->[1] ]->{answers}
->[ $address->[2] ];
} }
} }
@ -363,7 +365,7 @@ type to the Survey, you must handle it here, and also in updateQuestionAnswers
=cut =cut
sub getValidQuestionTypes { sub getValidQuestionTypes {
return( return (
'Agree/Disagree', 'Certainty', 'Concern', 'Confidence', 'Agree/Disagree', 'Certainty', 'Concern', 'Confidence',
'Currency', 'Date', 'Date Range', 'Dual Slider - Range', 'Currency', 'Date', 'Date Range', 'Dual Slider - Range',
'Education', 'Effectiveness', 'Email', 'File Upload', 'Education', 'Effectiveness', 'Email', 'File Upload',
@ -474,7 +476,7 @@ sub update {
$self->updateQuestionAnswers( $address, $ref->{questionType} ); $self->updateQuestionAnswers( $address, $ref->{questionType} );
} }
} }
for my $key ( keys %$object ) { for my $key ( keys %$ref ) {
$object->{$key} = $ref->{$key} if ( defined $$ref{$key} ); $object->{$key} = $ref->{$key} if ( defined $$ref{$key} );
} }
} ## end sub update } ## end sub update
@ -646,18 +648,22 @@ Returns a reference to a new, empty section.
=cut =cut
sub newSection { sub newSection {
my %members = ( return {
'text', '', text => '',
'title', 'NEW SECTION', ##i18n title => 'NEW SECTION', ##i18n
'variable', '', 'questionsPerPage', 5, variable => '',
'questionsOnSectionPage', 1, 'randomizeQuestions', 0, questionsPerPage => 5,
'everyPageTitle', 1, 'everyPageText', 1, questionsOnSectionPage => 1,
'terminal', 0, 'terminalUrl', '', randomizeQuestions => 0,
'goto', '', 'timeLimit', 0, everyPageTitle => 1,
'type', 'section' everyPageText => 1,
); terminal => 0,
$members{questions} = []; terminalUrl => '',
return \%members; goto => '',
timeLimit => 0,
type => 'section',
questions => [],
};
} }
=head2 newQuestion =head2 newQuestion
@ -667,28 +673,26 @@ Returns a reference to a new, empty question.
=cut =cut
sub newQuestion { sub newQuestion {
my %members = ( return {
'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,
# 'terminal',0, # terminalUrl => '',
# 'terminalUrl','', type => 'question',
'type', 'question' answers => [],
); };
$members{answers} = []; }
return \%members;
} ## end sub newQuestion
=head2 newAnswer =head2 newAnswer
@ -697,11 +701,22 @@ Returns a reference to a new, empty answer.
=cut =cut
sub newAnswer { sub newAnswer {
my %members = ( return {
'text', '', 'verbatim', 0, 'textCols', 10, 'textRows', 5, 'goto', '', 'recordedAnswer', '', 'isCorrect', 1, text => '',
'min', 1, 'max', 10, 'step', 1, 'value', 1, 'terminal', 0, 'terminalUrl', '', 'type', 'answer' verbatim => 0,
); textCols => 10,
return \%members; textRows => 5,
goto => '',
recordedAnswer => '',
isCorrect => 1,
min => 1,
max => 10,
step => 1,
value => 1,
terminal => 0,
terminalUrl => '',
type => 'answer'
};
} }
=head2 updateQuestionAnswers ($address, $type); =head2 updateQuestionAnswers ($address, $type);
@ -769,12 +784,13 @@ sub updateQuestionAnswers {
$self->addAnswersToQuestion( \@addy, \@ans, { 7, 1 } ); $self->addAnswersToQuestion( \@addy, \@ans, { 7, 1 } );
} }
elsif ( $type eq 'Party' ) { elsif ( $type eq 'Party' ) {
my @ans = ( 'Democratic party', 'Republican party (or GOP)', 'Independant party', 'Other party (verbatim)' ); my @ans
= ( 'Democratic party', 'Republican party (or GOP)', 'Independant party', 'Other party (verbatim)' );
$self->addAnswersToQuestion( \@addy, \@ans, { 3, 1 } ); $self->addAnswersToQuestion( \@addy, \@ans, { 3, 1 } );
} }
elsif ( $type eq 'Race' ) { elsif ( $type eq 'Race' ) {
my @ans my @ans = ( 'American Indian', 'Asian', 'Black', 'Hispanic', 'White non-Hispanic',
= ( 'American Indian', 'Asian', 'Black', 'Hispanic', 'White non-Hispanic', 'Something else (verbatim)' ); 'Something else (verbatim)' );
$self->addAnswersToQuestion( \@addy, \@ans, { 5, 1 } ); $self->addAnswersToQuestion( \@addy, \@ans, { 5, 1 } );
} }
elsif ( $type eq 'Ideology' ) { elsif ( $type eq 'Ideology' ) {