Hah, it ah, doesnt throw errors upon modperl start and ah, the editor, ah, kind of works, and err. ah, the JSON is 99% working, with objects instantiating themselves correctly then serializing themselves as appropriate. Definitely not a working version though.
This commit is contained in:
Kaleb Murphy
parent
6832eacc7c
commit
c4f939f306
9 changed files with 482 additions and 246 deletions
55
lib/WebGUI/Asset/Wobject/Survey/AnswerJSON.pm
Normal file
55
lib/WebGUI/Asset/Wobject/Survey/AnswerJSON.pm
Normal file
|
|
@ -0,0 +1,55 @@
|
|||
package WebGUI::Asset::Wobject::Survey::AnswerJSON;
|
||||
|
||||
use strict;
|
||||
use Data::Structure::Util qw/unbless/;
|
||||
|
||||
sub new{
|
||||
my $class = shift;
|
||||
my $parent = shift;
|
||||
my $self = shift || {};
|
||||
$self->{answers} = $self->{answers} || [];
|
||||
$self->{text};
|
||||
$self->{index};
|
||||
$self->{parentIndex};
|
||||
$self->{parent} = $parent;
|
||||
$self->{verbatim};
|
||||
$self->{textCols};
|
||||
$self->{textRows};
|
||||
$self->{gotoQuestion};
|
||||
$self->{recordedAnswer};
|
||||
$self->{isCorrect};
|
||||
$self->{min};
|
||||
$self->{max};
|
||||
$self->{step};
|
||||
$self->{value};
|
||||
$self->{terminal};
|
||||
$self->{terminalUrl};
|
||||
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;
|
||||
$self->{parent} = undef;
|
||||
}
|
||||
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","answer","text",$self->{"text"}, "recorded", $self->{'recordedAnswer'} });
|
||||
}
|
||||
1;
|
||||
101
lib/WebGUI/Asset/Wobject/Survey/QuestionJSON.pm
Normal file
101
lib/WebGUI/Asset/Wobject/Survey/QuestionJSON.pm
Normal file
|
|
@ -0,0 +1,101 @@
|
|||
package WebGUI::Asset::Wobject::Survey::QuestionJSON;
|
||||
|
||||
use strict;
|
||||
use Data::Structure::Util qw/unbless/;
|
||||
|
||||
sub new{
|
||||
my $class = shift;
|
||||
my $self = shift || {};
|
||||
my $parent = 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->{parent} = $self->{parent} || $parent;
|
||||
$self->{allowComment};
|
||||
$self->{commentCols};
|
||||
$self->{commentRows};
|
||||
$self->{randomizeAnswers};
|
||||
$self->{questionType};
|
||||
$self->{randomizedWords};
|
||||
$self->{verticalDisplay};
|
||||
$self->{required};
|
||||
$self->{maxAnswers};
|
||||
$self->{value};
|
||||
$self->{textInButton};
|
||||
$self->{terminal};
|
||||
$self->{terminalUrl};
|
||||
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( $self,@{$self->{object}}) );
|
||||
#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,$ref) = @_;
|
||||
if(@$$ref{ids} <= 1){
|
||||
$self->{parent} = undef;
|
||||
for my $answer(@{$self->{answers}}){
|
||||
$answer->remove();
|
||||
}
|
||||
}
|
||||
elsif(@$$ref{ids} == 2){
|
||||
$self->{answers}->[$$ref{ids}->[2]]->remove();
|
||||
splice(@{$self->{answers}},$$ref->{ids}->[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","question","text",$self->{text} });
|
||||
if($selected){
|
||||
for (@{$self->{answers}}){
|
||||
$_->getDragDropList($data, $address);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
126
lib/WebGUI/Asset/Wobject/Survey/SectionJSON.pm
Normal file
126
lib/WebGUI/Asset/Wobject/Survey/SectionJSON.pm
Normal file
|
|
@ -0,0 +1,126 @@
|
|||
package WebGUI::Asset::Wobject::Survey::SectionJSON;
|
||||
|
||||
use strict;
|
||||
use Data::Structure::Util qw/unbless/;
|
||||
use WebGUI::Asset::Wobject::Survey::QuestionJSON;
|
||||
|
||||
sub new{
|
||||
my $class = shift;
|
||||
my $self = shift || {};
|
||||
my $parent = shift;
|
||||
|
||||
if(defined $self->{questions}){
|
||||
foreach(@{$self->{questions}}){
|
||||
$_ = WebGUI::Asset::Wobject::Survey::QuestionJSON->new($_);
|
||||
}
|
||||
}else{
|
||||
$self->{questions} = [];
|
||||
}
|
||||
|
||||
$self->{text} = $self->{text} || '';
|
||||
$self->{title} = $self->{title} || '';
|
||||
$self->{parent} = $parent;
|
||||
$self->{questionsPerPage} = $self->{questionsPerPage} || 5;
|
||||
$self->{questionsOnSectionPage} = $self->{questionsOnSectionPage} || 1;
|
||||
$self->{randomizeQuestions} = $self->{randomizeQuestions} || 0;
|
||||
$self->{everyPageTitle} = $self->{everyPageTitle} || 1;
|
||||
$self->{everyPageText} = $self->{everyPageText} || 1;
|
||||
$self->{terminal} = $self->{terminal} || 0;
|
||||
$self->{terminalUrl};
|
||||
$self->{goto};
|
||||
$self->{timeLimit};
|
||||
|
||||
bless($self,$class);
|
||||
return $self;
|
||||
}
|
||||
sub getObject{
|
||||
my ($self,$address) = @_;
|
||||
if(@$address == 1){
|
||||
return $self->{questions}->[$address->[1]];
|
||||
}else{
|
||||
return $self->{questions}->[$address->[1]]->getObject($address);
|
||||
}
|
||||
}
|
||||
sub newQuestion{
|
||||
my $self = shift;
|
||||
push(@{$self->{questions}}, WebGUI::Assest::Wobject::Survey::QuestionJSON->new( $self,@{$self->{questions}}) );
|
||||
}
|
||||
sub remove{
|
||||
my ($self,$ref) = @_;
|
||||
$self->{questions}->[$$ref{ids}->[1]]->remove($ref);
|
||||
if(@$$ref{ids} == 0){
|
||||
for my $question(@{$self->{questions}}){
|
||||
$question->remove($ref);
|
||||
}
|
||||
$self->{parent} = undef;
|
||||
}
|
||||
if(@$$ref{ids} == 1){
|
||||
splice(@{$self->{questions}},$$ref->{ids}->[1],1);
|
||||
}
|
||||
}
|
||||
|
||||
sub update{
|
||||
my ($self,$ref) = @_;
|
||||
|
||||
#is a section
|
||||
if(@{$$ref{ids}} == 0){
|
||||
while(my ($key,$value) = keys %{$ref->{object}}){
|
||||
$self->{$key} = $value;
|
||||
}
|
||||
#is a new question
|
||||
}elsif($$ref{ids}->[1] eq 'NEW'){
|
||||
push(@{$self->{questions}}, WebGUI::Assest::Wobject::Survey::QuestionJSON->new( $self,@{$self->{object}}) );
|
||||
|
||||
#is updating a question or answer
|
||||
}else{
|
||||
$self->{questions}->[$$ref{ids}->[1]]->update($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","section","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;
|
||||
$self->{parent} = undef;
|
||||
my %temp = %{$self};
|
||||
$temp{questions} = [];
|
||||
foreach(@{$self->{questions}}){
|
||||
push(@{$temp{questions}}, $_->freeze());
|
||||
}
|
||||
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;
|
||||
79
lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm
Normal file
79
lib/WebGUI/Asset/Wobject/Survey/SurveyJSON.pm
Normal file
|
|
@ -0,0 +1,79 @@
|
|||
package WebGUI::Asset::Wobject::Survey::SurveyJSON;
|
||||
|
||||
use strict;
|
||||
use Data::Structure::Util qw/unbless/;
|
||||
use WebGUI::Asset::Wobject::Survey::SectionJSON;
|
||||
|
||||
sub new{
|
||||
my $class = shift;
|
||||
my $self = shift || {};
|
||||
my $log = shift;
|
||||
if(defined $self->{sections}){
|
||||
foreach(@{$self->{sections}}){
|
||||
$_ = WebGUI::Asset::Wobject::Survey::SectionJSON->new($_);
|
||||
}
|
||||
}else{
|
||||
$self->{sections} = [];
|
||||
}
|
||||
$self->{log} = $log;
|
||||
bless($self,$class);
|
||||
return $self;
|
||||
}
|
||||
#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,$address,$data) = @_;
|
||||
for(my $i=0; $i<=$#{$self->{sections}}; $i++){
|
||||
$self->{sections}->[$i]->getDragDropList($data, $address, $i == $address->[0]);
|
||||
}
|
||||
}
|
||||
|
||||
sub getObject{
|
||||
my ($self,$address) = @_;
|
||||
if(@$address == 1){
|
||||
return $self->{sections}->[$address->[0]];
|
||||
}else{
|
||||
return $self->{sections}->[$address->[0]]->getObject($address);
|
||||
}
|
||||
}
|
||||
|
||||
sub update{
|
||||
my ($self,$ref) = @_;
|
||||
if(ref $$ref{ids} eq 'ARRAY' and $$ref{ids}->[0] ne 'NEW'){
|
||||
$self->{sections}->[$$ref{ids}->[0]]->update($ref);
|
||||
}else{
|
||||
push(@{$self->{sections}}, WebGUI::Asset::Wobject::Survey::SectionJSON->new($self,$ref->{object}));
|
||||
}
|
||||
}
|
||||
#determine what to add and add it.
|
||||
# ref should contain all the information for the new
|
||||
|
||||
sub remove{
|
||||
my ($self,$ref) = @_;
|
||||
$self->{sections}->[$$ref{ids}->[0]]->remove($ref);
|
||||
if(@$$ref{ids} == 0){
|
||||
splice(@{$self->{sections}},$$ref->{ids}->[0],1);
|
||||
}
|
||||
}
|
||||
|
||||
sub createTemp{
|
||||
my ($self,$ref) = @_;#ref{ids} contains the parent of the temp object which should be created and returned.
|
||||
|
||||
if(ref $$ref{ids} eq 'ARRAY'){
|
||||
return $self->{sections}->[$$ref{ids}->[0]]->createTemp($ref);
|
||||
}else{
|
||||
return WebGUI::Asset::Wobject::Survey::SectionJSON->new($self);
|
||||
}
|
||||
}
|
||||
|
||||
sub freeze{
|
||||
my $self = shift;
|
||||
my %temp = %{$self};
|
||||
$temp{sections} = [];
|
||||
$temp{log} = undef;
|
||||
foreach (@{$self->{sections}}){
|
||||
push(@{$temp{sections}},$_->freeze($self->{log}));
|
||||
}
|
||||
return \%temp;
|
||||
}
|
||||
1;
|
||||
Loading…
Add table
Add a link
Reference in a new issue