Tag defense,... done
This commit is contained in:
Mercier Pierre-Olivier
parent
bad4dd3766
commit
951470b06b
8 changed files with 597 additions and 228 deletions
447
ACU/Defense.pm
447
ACU/Defense.pm
|
|
@ -17,14 +17,16 @@ sub new ($$)
|
|||
{
|
||||
my $class = shift;
|
||||
my $self = {
|
||||
ids => {},
|
||||
groups => [],
|
||||
infos => {},
|
||||
comments => {},
|
||||
who => {},
|
||||
};
|
||||
|
||||
bless $self, $class;
|
||||
$self->_initialize(@_);
|
||||
if ($#_ >= 0) {
|
||||
$self->_initialize(@_);
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
|
@ -33,10 +35,63 @@ sub _initialize ($$)
|
|||
{
|
||||
my $self = shift;
|
||||
|
||||
my $sax_handler = DefenseHandler->new($self);
|
||||
my $parser = XML::SAX::ParserFactory->parser( Handler => $sax_handler );
|
||||
my $dom = XML::LibXML->load_xml(string => shift);
|
||||
$self->{groups} = $self->parseDefense($dom->documentElement());
|
||||
$self->{version} = $dom->documentElement()->getAttribute("version") // "1";
|
||||
$self->{duration} = $dom->documentElement()->getAttribute("duration") if $dom->documentElement()->hasAttribute("duration");
|
||||
$self->{type} = $dom->documentElement()->getAttribute("type") if $dom->documentElement()->hasAttribute("type");
|
||||
$self->{"strict-time"} = $dom->documentElement()->getAttribute("strict-time") if $dom->documentElement()->hasAttribute("strict-time");
|
||||
$self->{"can-correct"} = $dom->documentElement()->getAttribute("can-correct") if $dom->documentElement()->hasAttribute("can-correct");
|
||||
$self->{"operator"} = $dom->documentElement()->getAttribute("operator") if $dom->documentElement()->hasAttribute("operator");
|
||||
}
|
||||
|
||||
$parser->parse_file(shift);
|
||||
sub parseDefense ($$)
|
||||
{
|
||||
my $self = shift;
|
||||
my $ret = [];
|
||||
my $node = shift;
|
||||
|
||||
foreach my $group ($node->childNodes())
|
||||
{
|
||||
if ($group->nodeName eq "group")
|
||||
{
|
||||
my $g = Defense::Group->new(
|
||||
$group->getAttribute("id"),
|
||||
$group->getAttribute("title"),
|
||||
$group->getAttribute("questions")
|
||||
);
|
||||
$g->addQuestion(
|
||||
$g->parseQuestions($group->getElementsByTagName("question"))
|
||||
);
|
||||
push @$ret, $g;
|
||||
}
|
||||
}
|
||||
|
||||
return $ret;
|
||||
}
|
||||
|
||||
sub toString ($)
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
my $doc = XML::LibXML::Document->new('1.0');
|
||||
|
||||
my $root = $doc->createElement("defense");
|
||||
|
||||
$root->addChild( $doc->createAttribute("version", $self->{version}) );
|
||||
$root->addChild( $doc->createAttribute("duration", $self->{duration}) );
|
||||
$root->addChild( $doc->createAttribute("type", $self->{type}) ) if ($self->{type});
|
||||
$root->addChild( $doc->createAttribute("strict-time", $self->{"strict-time"}) ) if ($self->{"strict-time"});
|
||||
$root->addChild( $doc->createAttribute("can-correct", $self->{"can-correct"}) ) if ($self->{"can-correct"});
|
||||
$root->addChild( $doc->createAttribute("operator", $self->{"operator"}) ) if ($self->{"operator"});
|
||||
|
||||
for my $group (@{ $self->{groups} }) {
|
||||
$group->toString($doc, $root, $root);
|
||||
}
|
||||
|
||||
$doc->setDocumentElement( $root );
|
||||
|
||||
return $doc->toString();
|
||||
}
|
||||
|
||||
sub getVersion ($)
|
||||
|
|
@ -48,71 +103,365 @@ sub getVersion ($)
|
|||
sub getIds ($)
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{ids};
|
||||
|
||||
my %ids;
|
||||
|
||||
for my $group (@{ $self->{groups} })
|
||||
{
|
||||
$ids{ $group->{id} } = 1 if ($group->{id});
|
||||
|
||||
for my $question (@{ $group->{questions_list} })
|
||||
{
|
||||
$ids{ $question->{id} } = 1 if ($question->{id});
|
||||
|
||||
for my $answer (@{ $question->{answers} })
|
||||
{
|
||||
$ids{ $answer->{id} } = $answer->{value} if ($answer->{id});
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return %ids;
|
||||
}
|
||||
|
||||
sub genIds ($)
|
||||
{
|
||||
my $self = shift;
|
||||
my @ids;
|
||||
|
||||
my $grp_i = 0;
|
||||
for my $group (@{ $self->{groups} })
|
||||
{
|
||||
my $cur_gid;
|
||||
if (! $group->{id} || grep { /^\Q$group->{id}\E$/ } @ids)
|
||||
{
|
||||
do {
|
||||
$cur_gid = "defg".$grp_i;
|
||||
$grp_i += 1;
|
||||
} while (grep {$_ eq $cur_gid} @ids);
|
||||
$group->{id} = $cur_gid;
|
||||
}
|
||||
else {
|
||||
$grp_i += 1;
|
||||
}
|
||||
|
||||
my $qst_i = 0;
|
||||
for my $question (@{ $group->{questions_list} })
|
||||
{
|
||||
my $cur_qid;
|
||||
if (! $question->{id} || grep { /^\Q$question->{id}\E$/ } @ids)
|
||||
{
|
||||
do {
|
||||
$cur_qid = $cur_gid."q".$qst_i;
|
||||
$qst_i += 1;
|
||||
} while (grep {$_ eq $cur_qid} @ids);
|
||||
$question->{id} = $cur_qid;
|
||||
}
|
||||
else {
|
||||
$qst_i += 1;
|
||||
}
|
||||
|
||||
my $ans_i = 0;
|
||||
for my $answer (@{ $question->{answers} })
|
||||
{
|
||||
if (! $answer->{id} || grep { /^\Q$answer->{id}\E$/ } @ids)
|
||||
{
|
||||
my $cur_aid;
|
||||
do {
|
||||
$cur_aid = $cur_qid."a".$ans_i;
|
||||
$ans_i += 1;
|
||||
} while (grep {$_ eq $cur_aid} @ids);
|
||||
$answer->{id} = $cur_aid;
|
||||
}
|
||||
else {
|
||||
$ans_i += 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
package DefenseHandler;
|
||||
package Defense::Group;
|
||||
|
||||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
use constant NO_ID_VALUE => "__#";
|
||||
|
||||
use ACU::Log;
|
||||
|
||||
sub new ($$)
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $self = {
|
||||
parsed => shift,
|
||||
inComment => "",
|
||||
inEval => "",
|
||||
inInfo => "",
|
||||
inValue => "",
|
||||
inWho => "",
|
||||
values => ""
|
||||
id => shift,
|
||||
title => shift,
|
||||
questions => shift,
|
||||
questions_list => []
|
||||
};
|
||||
|
||||
bless $self, $class;
|
||||
|
||||
return $self;
|
||||
return bless $self;
|
||||
}
|
||||
|
||||
sub start_element
|
||||
sub addQuestion($@)
|
||||
{
|
||||
my ($self, $element) = @_;
|
||||
my $self = shift;
|
||||
|
||||
if ($element->{Name} eq "defense") {
|
||||
$self->{parsed}{version} = $element->{Attributes}{"{}version"}{Value};
|
||||
$self->{parsed}{duration} = $element->{Attributes}{"{}duration"}{Value};
|
||||
push @{ $self->{questions_list} }, @_;
|
||||
}
|
||||
|
||||
sub parseQuestions($@)
|
||||
{
|
||||
my $self = shift;
|
||||
my @ret;
|
||||
|
||||
for my $question (@_)
|
||||
{
|
||||
my $q = Defense::Question->new(
|
||||
@{ $question->getElementsByTagName("ask") }[0]->textContent,
|
||||
@{ $question->getElementsByTagName("explanation") }[0]->textContent // "",
|
||||
$question->getAttribute("id"),
|
||||
$question->getAttribute("title"),
|
||||
$question->getAttribute("type"),
|
||||
$question->getAttribute("difficulty"),
|
||||
$question->getAttribute("weight"),
|
||||
$question->getAttribute("imposed"),
|
||||
$question->getAttribute("mandatory"),
|
||||
$question->getAttribute("shuffled-answers")
|
||||
);
|
||||
$q->addAnswer(
|
||||
$q->parseAnswers($question->getElementsByTagName("answer"))
|
||||
);
|
||||
$q->addInput(
|
||||
$q->parseInputs($question->getElementsByTagName("input"))
|
||||
);
|
||||
|
||||
push @ret, $q;
|
||||
}
|
||||
elsif ($element->{Name} eq "question") {
|
||||
if ($element->{Attributes}{"{}id"}{Value}) {
|
||||
$self->{parsed}{ids}{ $element->{Attributes}{"{}id"}{Value} } = 0;
|
||||
}
|
||||
else {
|
||||
log WARN, "Question without ID!";
|
||||
}
|
||||
}
|
||||
elsif ($element->{Name} eq "answer") {
|
||||
if ($element->{Attributes}{"{}id"}{Value}) {
|
||||
$self->{parsed}{ids}{ $element->{Attributes}{"{}id"}{Value} } = $element->{Attributes}{"{}value"}{Value} // $element->{Attributes}{"{}mark"}{Value} // 0;
|
||||
}
|
||||
else {
|
||||
log WARN, "Answer without ID!";
|
||||
}
|
||||
}
|
||||
elsif ($element->{Name} ne "group" && $element->{Name} ne "ask" && $element->{Name} ne "answer" && $element->{Name} ne "explanation") {
|
||||
croak "Not a valid defense XML: unknown tag ".$element->{Name};
|
||||
|
||||
return @ret;
|
||||
}
|
||||
|
||||
sub toString ($$$)
|
||||
{
|
||||
my $self = shift;
|
||||
my $doc = shift;
|
||||
my $parent = shift;
|
||||
|
||||
my $group = $doc->createElement("group");
|
||||
$group->addChild( $doc->createAttribute("id", $self->{id}) );
|
||||
$group->addChild( $doc->createAttribute("title", $self->{title}) );
|
||||
$group->addChild( $doc->createAttribute("questions", $self->{questions}) ) if ($self->{questions});
|
||||
$parent->appendChild($group);
|
||||
|
||||
for my $item (@{ $self->{questions_list} }) {
|
||||
$item->toString($doc, $group);
|
||||
}
|
||||
}
|
||||
|
||||
sub characters
|
||||
{
|
||||
my ($self, $characters) = @_;
|
||||
|
||||
if ($self->{inValue} || $self->{inInfo} || $self->{inComment} || $self->{inWho}) {
|
||||
$self->{values} .= $characters->{Data};
|
||||
package Defense::Question;
|
||||
|
||||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $self = {
|
||||
ask => shift,
|
||||
explanation => shift,
|
||||
|
||||
id => shift,
|
||||
title => shift,
|
||||
type => shift,
|
||||
difficulty => shift,
|
||||
weight => shift,
|
||||
imposed => shift,
|
||||
mandatory => shift,
|
||||
"shuffled-answers" => shift,
|
||||
|
||||
answers => []
|
||||
};
|
||||
|
||||
return bless $self;
|
||||
}
|
||||
|
||||
sub addAnswer($@)
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
push @{ $self->{answers} }, @_;
|
||||
}
|
||||
|
||||
sub addInput($@)
|
||||
{
|
||||
my $self = shift;
|
||||
|
||||
push @{ $self->{answers} }, @_;
|
||||
}
|
||||
|
||||
sub parseAnswers($@)
|
||||
{
|
||||
my $self = shift;
|
||||
my @ret;
|
||||
|
||||
for my $answer (@_)
|
||||
{
|
||||
my $a = Defense::Answer->new(
|
||||
$answer->textContent,
|
||||
$answer->getAttribute("id"),
|
||||
$answer->getAttribute("value"),
|
||||
$answer->getAttribute("next")
|
||||
);
|
||||
|
||||
push @ret, $a;
|
||||
}
|
||||
|
||||
return @ret;
|
||||
}
|
||||
|
||||
sub parseInputs($@)
|
||||
{
|
||||
my $self = shift;
|
||||
my @ret;
|
||||
|
||||
for my $input (@_)
|
||||
{
|
||||
my $a = Defense::Input->new(
|
||||
$input->getAttribute("label"),
|
||||
$input->getAttribute("id"),
|
||||
$input->getAttribute("type"),
|
||||
$input->getAttribute("value"),
|
||||
$input->getAttribute("maxlength"),
|
||||
$input->getAttribute("pattern"),
|
||||
$input->getAttribute("placeholder"),
|
||||
$input->getAttribute("min"),
|
||||
$input->getAttribute("max"),
|
||||
$input->getAttribute("step")
|
||||
);
|
||||
|
||||
push @ret, $a;
|
||||
}
|
||||
|
||||
return @ret;
|
||||
}
|
||||
|
||||
sub toString ($$$)
|
||||
{
|
||||
my $self = shift;
|
||||
my $doc = shift;
|
||||
my $parent = shift;
|
||||
|
||||
my $question = $doc->createElement("question");
|
||||
$question->addChild( $doc->createAttribute("id", $self->{id}) );
|
||||
$question->addChild( $doc->createAttribute("title", $self->{title}) );
|
||||
$question->addChild( $doc->createAttribute("type", $self->{type}) ) if ($self->{type});
|
||||
$question->addChild( $doc->createAttribute("difficulty", $self->{difficulty}) ) if ($self->{difficulty});
|
||||
$question->addChild( $doc->createAttribute("weight", $self->{weight}) ) if ($self->{weight});
|
||||
$question->addChild( $doc->createAttribute("imposed", $self->{imposed}) ) if ($self->{imposed});
|
||||
$question->addChild( $doc->createAttribute("mandatory", $self->{mandatory}) ) if ($self->{mandatory});
|
||||
$question->addChild( $doc->createAttribute("shuffled-answers", $self->{"shuffled-answers"}) ) if ($self->{"shuffled-answers"});
|
||||
$parent->appendChild($question);
|
||||
|
||||
my $ask = $doc->createElement("ask");
|
||||
$ask->appendText($self->{ask});
|
||||
$question->appendChild($ask);
|
||||
|
||||
for my $item (@{ $self->{answers} }) {
|
||||
$item->toString($doc, $question);
|
||||
}
|
||||
|
||||
if ($self->{explanation})
|
||||
{
|
||||
my $expl = $doc->createElement("explanation");
|
||||
$expl->appendText($self->{explanation});
|
||||
$question->appendChild($expl);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
package Defense::Answer;
|
||||
|
||||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $self = {
|
||||
text => shift,
|
||||
|
||||
id => shift,
|
||||
value => shift,
|
||||
"next" => shift,
|
||||
};
|
||||
|
||||
return bless $self;
|
||||
}
|
||||
|
||||
sub toString ($$$)
|
||||
{
|
||||
my $self = shift;
|
||||
my $doc = shift;
|
||||
my $parent = shift;
|
||||
|
||||
my $answer = $doc->createElement("answer");
|
||||
$answer->appendText($self->{text});
|
||||
$answer->addChild( $doc->createAttribute("id", $self->{id}) );
|
||||
$answer->addChild( $doc->createAttribute("value", $self->{value}) ) if ($self->{"value"});
|
||||
$answer->addChild( $doc->createAttribute("next", $self->{"next"}) ) if ($self->{"next"});
|
||||
$parent->appendChild($answer);
|
||||
}
|
||||
|
||||
|
||||
package Defense::Input;
|
||||
|
||||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
|
||||
sub new
|
||||
{
|
||||
my $class = shift;
|
||||
my $self = {
|
||||
label => shift,
|
||||
id => shift,
|
||||
type => shift,
|
||||
value => shift,
|
||||
maxlength => shift,
|
||||
pattern => shift,
|
||||
placeholder => shift,
|
||||
min => shift,
|
||||
max => shift,
|
||||
step => shift
|
||||
};
|
||||
|
||||
return bless $self;
|
||||
}
|
||||
|
||||
sub toString ($$$)
|
||||
{
|
||||
my $self = shift;
|
||||
my $doc = shift;
|
||||
my $parent = shift;
|
||||
|
||||
my $answer = $doc->createElement("answer");
|
||||
$answer->addChild( $doc->createAttribute("label", $self->{label}) );
|
||||
$answer->addChild( $doc->createAttribute("id", $self->{id}) );
|
||||
$answer->addChild( $doc->createAttribute("type", $self->{type}) ) if ($self->{"type"});
|
||||
$answer->addChild( $doc->createAttribute("value", $self->{value}) ) if ($self->{"value"});
|
||||
$answer->addChild( $doc->createAttribute("maxlength", $self->{maxlength}) ) if ($self->{"maxlength"});
|
||||
$answer->addChild( $doc->createAttribute("pattern", $self->{pattern}) ) if ($self->{"pattern"});
|
||||
$answer->addChild( $doc->createAttribute("placeholder", $self->{placeholder}) ) if ($self->{"placeholder"});
|
||||
$answer->addChild( $doc->createAttribute("min", $self->{min}) ) if ($self->{"min"});
|
||||
$answer->addChild( $doc->createAttribute("max", $self->{max}) ) if ($self->{"max"});
|
||||
$answer->addChild( $doc->createAttribute("step", $self->{step}) ) if ($self->{"step"});
|
||||
$parent->appendChild($answer);
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
|
|||
|
|
@ -107,13 +107,13 @@ sub insert ($$$)
|
|||
$self->{ids}{$_[0]} = $_[1];
|
||||
}
|
||||
|
||||
sub fill ($$)
|
||||
sub fill ($%)
|
||||
{
|
||||
my $self = shift;
|
||||
my $ids = shift;
|
||||
my %ids = shift;
|
||||
|
||||
for my $k (keys %{ $ids }) {
|
||||
$self->{ids}{$k} = $ids->{$k};
|
||||
for my $k (keys %ids) {
|
||||
$self->{ids}{$k} = $ids{$k};
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -101,7 +101,7 @@ sub getValue ($$)
|
|||
sub getIds ($)
|
||||
{
|
||||
my $self = shift;
|
||||
return $self->{ids};
|
||||
return %{ $self->{ids} };
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
Reference in a new issue