Need to finish the template packages, reports, fix up a small branching issue, copying, and an upgrade path.
This commit is contained in:
Kaleb Murphy
parent
2de1d83d65
commit
c2fc74ae85
8 changed files with 329 additions and 1175 deletions
File diff suppressed because it is too large
Load diff
|
|
@ -1,60 +0,0 @@
|
|||
package WebGUI::Asset::Wobject::Survey::AnswerJSON;
|
||||
|
||||
use strict;
|
||||
use Data::Structure::Util qw/unbless/;
|
||||
|
||||
sub new{
|
||||
my $class = shift;
|
||||
my $self = shift || {};
|
||||
my $posts = shift;
|
||||
$self->{answers} = $self->{answers} || [];
|
||||
$self->{text} = $self->{text} || '';
|
||||
$self->{verbatim} = $self->{verbatim} || '';
|
||||
$self->{textCols} = $self->{textCols} || 10;
|
||||
$self->{textRows} = $self->{textRows} || 5;
|
||||
$self->{gotoQuestion} = $self->{gotoQuestion} || '';
|
||||
$self->{recordedAnswer} = $self->{recordedAnswer} || '';
|
||||
$self->{isCorrect} = $self->{isCorrect} || 1;
|
||||
$self->{min} = $self->{min} || 1;
|
||||
$self->{max} = $self->{max} || 10;
|
||||
$self->{step} = $self->{step} || 1;
|
||||
$self->{value} = $self->{value} || 1;
|
||||
$self->{terminal} = $self->{terminal} || 0;
|
||||
$self->{terminalUrl} = $self->{terminalUrl} || '';
|
||||
$self->{type} = 'answer';
|
||||
|
||||
if(defined $posts and ref $posts eq 'HASH'){
|
||||
while(my ($key,$value) = each %$posts){
|
||||
if(defined $self->{$key}){
|
||||
$self->{$key} = $value;
|
||||
}
|
||||
}
|
||||
}
|
||||
bless($self,$class);
|
||||
return $self;
|
||||
}
|
||||
sub update{
|
||||
my ($self,$ref) = @_;
|
||||
|
||||
while(my ($key,$value) = keys %{$ref->{object}}){
|
||||
$self->{$key} = $value;
|
||||
}
|
||||
}
|
||||
sub remove{
|
||||
my $self = shift;
|
||||
}
|
||||
sub freeze{
|
||||
my $self = shift;
|
||||
my %temp = %{$self};
|
||||
# $temp{parent} = undef;
|
||||
# unbless $self;
|
||||
return \%temp;
|
||||
}
|
||||
|
||||
#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,$data,$address,$selected) = @_;
|
||||
push(@$data, { "type",$self->{type},"text",$self->{"text"}, "recorded", $self->{'recordedAnswer'} });
|
||||
}
|
||||
1;
|
||||
|
|
@ -1,101 +0,0 @@
|
|||
package WebGUI::Asset::Wobject::Survey::QuestionJSON;
|
||||
|
||||
use strict;
|
||||
use Data::Structure::Util qw/unbless/;
|
||||
|
||||
sub new{
|
||||
my $class = shift;
|
||||
my $self = shift || {};
|
||||
my $posts = shift;
|
||||
|
||||
if(defined $self->{answers}){
|
||||
foreach(@{$self->{answers}}){
|
||||
$_ = WebGUI::Asset::Wobject::Survey::AnswerJSON->new($_);
|
||||
}
|
||||
}else{
|
||||
$self->{answers} = [];
|
||||
}
|
||||
|
||||
$self->{variableName} = $self->{variableName} || '';
|
||||
$self->{text} = $self->{text} || '';
|
||||
$self->{allowComment} = $self->{allowComment} || 0;
|
||||
$self->{commentCols} = $self->{commentCols} || 10;
|
||||
$self->{commentRows} = $self->{commentRows} || 5;
|
||||
$self->{randomizeAnswers} = $self->{randomizeAnswers} || 0;
|
||||
$self->{questionType} = $self->{questionType} || '';
|
||||
$self->{randomizedWords} = $self->{randomizedWords} || '';
|
||||
$self->{verticalDisplay} = $self->{verticalDisplay} || 0;
|
||||
$self->{required} = $self->{required} || 0;
|
||||
$self->{maxAnswers} = $self->{maxAnswers} || 1;
|
||||
$self->{value} = $self->{value} || 1;
|
||||
$self->{textInButton} = $self->{textInButton} || 0;
|
||||
$self->{terminal} = $self->{terminal} || 0;
|
||||
$self->{terminalUrl} = $self->{terminalUrl} || '';
|
||||
$self->{type} = 'question';
|
||||
|
||||
if(defined $posts and ref $posts eq 'HASH'){
|
||||
while(my ($key,$value) = each %$posts){
|
||||
if(defined $self->{$key}){
|
||||
$self->{$key} = $value;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
bless($self,$class);
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub update{
|
||||
my ($self,$ref) = @_;
|
||||
#is a question
|
||||
if(@{$$ref{ids}} == 1){
|
||||
while (my ($key,$value) = each %{$ref->{object}}){
|
||||
$self->{$key} = $value;
|
||||
}
|
||||
#is a new answer
|
||||
}elsif($$ref{ids}->[2] eq 'NEW'){
|
||||
push(@{$self->{answers}}, WebGUI::Assest::Wobject::Survey::AnswerJSON->new( {},$ref) );
|
||||
#is updating a answer
|
||||
}else{
|
||||
$self->{answers}->[$$ref{ids}->[2]]->update($ref);
|
||||
}
|
||||
}
|
||||
sub getObject{
|
||||
my ($self,$address) = @_;
|
||||
return $self->{answers}->[$address->[2]];
|
||||
}
|
||||
|
||||
sub createTemp{
|
||||
my ($self,$ref) = @_;
|
||||
return WebGUI::Asset::Wobject::Survey::AnswerJSON->new($self);
|
||||
}
|
||||
|
||||
sub remove{
|
||||
my ($self,$address) = @_;
|
||||
splice(@{$self->{answers}},$$address[2],1);
|
||||
}
|
||||
|
||||
|
||||
sub freeze{
|
||||
my $self = shift;
|
||||
$self->{parent} = undef;
|
||||
my %temp = %{$self};
|
||||
$temp{answers} = [];
|
||||
foreach(@{$self->{answers}}){
|
||||
push(@{$temp{answers}},$_->freeze());
|
||||
}
|
||||
return \%temp;
|
||||
}
|
||||
#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,$data,$address,$selected) = @_;
|
||||
push(@$data, { "type",$self->{type},"text",$self->{text} });
|
||||
if($selected){
|
||||
for (@{$self->{answers}}){
|
||||
$_->getDragDropList($data, $address);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -1,155 +0,0 @@
|
|||
package WebGUI::Asset::Wobject::Survey::SectionJSON;
|
||||
|
||||
use strict;
|
||||
use Data::Structure::Util qw/unbless/;
|
||||
use WebGUI::Asset::Wobject::Survey::QuestionJSON;
|
||||
|
||||
use Data::Dumper;
|
||||
|
||||
sub new{
|
||||
my $class = shift;
|
||||
my $self = shift || {};
|
||||
my $postInfo = shift;
|
||||
my $log = shift;
|
||||
if(defined $self->{questions}){
|
||||
foreach(@{$self->{questions}}){
|
||||
$_ = WebGUI::Asset::Wobject::Survey::QuestionJSON->new($_);
|
||||
}
|
||||
}else{
|
||||
$self->{questions} = [];
|
||||
}
|
||||
$self->{log} = $log if defined $log;
|
||||
$self->{text} = $self->{text} || '';
|
||||
$self->{title} = $self->{title} || 'New Section';
|
||||
$self->{variable} = $self->{variable} || '';
|
||||
$self->{questionsPerPage} = $self->{questionsPerPage} || 5;
|
||||
$self->{questionsOnSectionPage} = defined $self->{questionsOnSectionPage} ? $self->{questionsOnSectionPage} : 1;
|
||||
$self->{randomizeQuestions} = $self->{randomizeQuestions} || 0;
|
||||
$self->{everyPageTitle} = defined $self->{everyPageTitle} ? $self->{everyPageTitle} : 1;
|
||||
$self->{everyPageText} = defined $self->{everyPageText} ? $self->{everyPageText} : 1;
|
||||
$self->{terminal} = $self->{terminal} || 0;
|
||||
$self->{terminalUrl} = $self->{terminalUrl} || '';
|
||||
$self->{goto} = $self->{goto} || '';
|
||||
$self->{timeLimit} = $self->{timeLimit} || 0;
|
||||
$self->{type} = 'section';
|
||||
|
||||
if(defined $postInfo and ref $postInfo eq 'HASH'){
|
||||
while(my ($key,$value) = each %$postInfo){
|
||||
if(defined $self->{$key}){
|
||||
$self->{$key} = $value;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
bless($self,$class);
|
||||
return $self;
|
||||
}
|
||||
sub getObject{
|
||||
my ($self,$address) = @_;
|
||||
if(@$address == 2){
|
||||
return $self->{questions}->[$address->[1]];
|
||||
}else{
|
||||
return $self->{questions}->[$address->[1]]->getObject($address);
|
||||
}
|
||||
}
|
||||
sub getEditVars{
|
||||
my ($self,$address) = @_;
|
||||
$self->{log}->error("section geteditvars");
|
||||
if(@$address > 1){
|
||||
return $self->{questions}->[$address->[1]]->getEditVars($address);
|
||||
}
|
||||
#Fill in a template var hash and return it
|
||||
my %var;
|
||||
while (my ($key,$value) = each %{$self}){
|
||||
if($key ne 'questions' and $key ne 'questionsPerPage' and $key ne 'log'){
|
||||
$var{$key} = $value;
|
||||
}
|
||||
}
|
||||
for(1 .. 10){
|
||||
if($_ == $self->{questionsPerPage}){
|
||||
push(@{$var{questionsPerPage}},{'index',$_,'selected',1});
|
||||
}else{
|
||||
push(@{$var{questionsPerPage}},{'index',$_,'selected',0});
|
||||
}
|
||||
}
|
||||
return \%var;
|
||||
|
||||
}
|
||||
sub newQuestion{
|
||||
my $self = shift;
|
||||
push(@{$self->{questions}}, WebGUI::Assest::Wobject::Survey::QuestionJSON->new( $self,@{$self->{questions}}) );
|
||||
}
|
||||
sub remove{
|
||||
my ($self,$address) = @_;
|
||||
if(@$address == 2){
|
||||
splice(@{$self->{questions}},$$address[1],1);
|
||||
}else{
|
||||
$self->{questions}->[$$address[1]]->remove($address);
|
||||
}
|
||||
}
|
||||
|
||||
sub update{
|
||||
my ($self,$address,$ref,$log) = @_;
|
||||
if(@{$address} == 1){
|
||||
while(my ($key,$value) = each %{$ref}){
|
||||
$self->{$key} = $value if defined $self->{$key};
|
||||
}
|
||||
#is a new question
|
||||
}elsif($$ref{ids}->[1] eq 'NEW'){
|
||||
push(@{$self->{questions}}, WebGUI::Assest::Wobject::Survey::QuestionJSON->new({},$ref) );
|
||||
|
||||
#is updating a question or answer
|
||||
}else{
|
||||
$self->{questions}->[$$ref{ids}->[1]]->update($address,$ref);
|
||||
}
|
||||
}
|
||||
|
||||
sub loadQuestion{
|
||||
my ($self,$questionHash) = @_;
|
||||
push(@{$self->{questions}}, WebGUI::Assest::Wobject::Survey::QuestionJSON->new( $self,@{$self->{questions}},$questionHash) );
|
||||
}
|
||||
|
||||
sub deleteQuestion{
|
||||
my $self = shift;
|
||||
my $index = shift;
|
||||
splice(@{$self->{questions}},$index,1) if defined $index;
|
||||
}
|
||||
#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,$data,$address,$selected) = @_;
|
||||
push(@$data,{ "type",$self->{type},"text",$self->{"title"} });
|
||||
if($selected){
|
||||
for(my $i=0; $i<=$#{$self->{questions}}; $i++){
|
||||
$self->{questions}->[$i]->getDragDropList($data, $address, $i == $address->[1]);
|
||||
}
|
||||
}
|
||||
}
|
||||
sub getQuestion{
|
||||
my $self = shift;
|
||||
my $index = shift;
|
||||
return $self->{questions}->[$index] if defined $index;
|
||||
}
|
||||
|
||||
sub freeze{
|
||||
my $self = shift;
|
||||
|
||||
my %temp = %{$self};
|
||||
|
||||
$temp{questions} = [];
|
||||
foreach(@{$self->{questions}}){
|
||||
push(@{$temp{questions}}, $_->freeze());
|
||||
}
|
||||
delete $temp{log};
|
||||
return \%temp;
|
||||
}
|
||||
|
||||
sub createTemp{
|
||||
my ($self,$ref) = @_;
|
||||
if(@{$$ref{ids}} > 1){
|
||||
return $self->{questions}->[$$ref{ids}->[1]]->createTemp($ref);
|
||||
}else{
|
||||
return WebGUI::Asset::Wobject::Survey::QuestionJSON->new($self);
|
||||
}
|
||||
}
|
||||
1;
|
||||
|
|
@ -148,6 +148,7 @@ sub getAnswerEditVars{
|
|||
sub update{
|
||||
my ($self,$address,$ref) = @_;
|
||||
my $object;
|
||||
my $newQuestion = 0;
|
||||
if(@$address == 1){
|
||||
$object = $self->section($address);
|
||||
if(! defined $object){
|
||||
|
|
@ -157,18 +158,22 @@ sub update{
|
|||
}elsif(@$address == 2){
|
||||
$object = $self->question($address);
|
||||
if(! defined $object){
|
||||
$self->log("$object didn't exist");
|
||||
my $newQuestion = 1;
|
||||
$object = $self->newQuestion();
|
||||
push(@{$self->questions($address)},$object);
|
||||
}
|
||||
}elsif(@$address == 3){
|
||||
$object = $self->answer($address);
|
||||
if(! defined $object){
|
||||
$self->log("$object didn't exist");
|
||||
$object = $self->newAnswer();
|
||||
push(@{$self->answers($address)},$object);
|
||||
}
|
||||
}
|
||||
if(@$address == 2 and ! $newQuestion){
|
||||
if($ref->{questionType} ne $self->question($address)->{questionType}){
|
||||
$self->updateQuestionAnswers($address,$ref->{questionType});
|
||||
}
|
||||
}
|
||||
for my $key(keys %$object){
|
||||
$object->{$key} = $ref->{$key} if(defined $$ref{$key});
|
||||
}
|
||||
|
|
@ -264,6 +269,115 @@ sub newAnswer{
|
|||
return \%members;
|
||||
}
|
||||
|
||||
sub updateQuestionAnswers{
|
||||
my $self = shift;
|
||||
my $address = shift;
|
||||
my $type = shift;
|
||||
|
||||
$self->log("In updateQuestion");
|
||||
|
||||
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());
|
||||
}
|
||||
}
|
||||
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});
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#------------------------------
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue