474 lines
11 KiB
Perl
474 lines
11 KiB
Perl
#! /usr/bin/env perl
|
|
|
|
package Defense;
|
|
|
|
use v5.10.1;
|
|
use strict;
|
|
use warnings;
|
|
use Carp;
|
|
use utf8;
|
|
use open qw(:encoding(UTF-8) :std);
|
|
use XML::LibXML;
|
|
use XML::SAX::ParserFactory;
|
|
|
|
use ACU::Log;
|
|
|
|
sub new ($$)
|
|
{
|
|
my $class = shift;
|
|
my $self = {
|
|
groups => [],
|
|
infos => {},
|
|
comments => {},
|
|
who => {},
|
|
};
|
|
|
|
bless $self, $class;
|
|
if ($#_ >= 0) {
|
|
$self->_initialize(@_);
|
|
}
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub _initialize ($$)
|
|
{
|
|
my $self = shift;
|
|
|
|
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");
|
|
}
|
|
|
|
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 ($)
|
|
{
|
|
my $self = shift;
|
|
return $self->{version};
|
|
}
|
|
|
|
sub getIds ($)
|
|
{
|
|
my $self = shift;
|
|
|
|
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} // 0 if ($answer->{id});
|
|
}
|
|
}
|
|
}
|
|
|
|
return \%ids;
|
|
}
|
|
|
|
sub genIds ($;$)
|
|
{
|
|
my $self = shift;
|
|
my $def_i = shift // 1;
|
|
my @ids;
|
|
|
|
my $grp_i = 0;
|
|
for my $group (@{ $self->{groups} })
|
|
{
|
|
my $cur_gid;
|
|
if (! $group->{id} || grep { $_ == $group->{id} } @ids)
|
|
{
|
|
do {
|
|
$cur_gid = "def_".$def_i."g".$grp_i;
|
|
$grp_i += 1;
|
|
} while (grep {$_ eq $cur_gid} @ids);
|
|
$group->{id} = $cur_gid;
|
|
}
|
|
else {
|
|
$grp_i += 1;
|
|
$cur_gid = $group->{id};
|
|
}
|
|
|
|
my $qst_i = 0;
|
|
for my $question (@{ $group->{questions_list} })
|
|
{
|
|
my $cur_qid;
|
|
if (! $question->{id} || grep { $_ == $question->{id} } @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;
|
|
$cur_qid = $question->{id};
|
|
}
|
|
|
|
my $ans_i = 0;
|
|
for my $answer (@{ $question->{answers} })
|
|
{
|
|
if (! $answer->{id} || grep { $_ == $answer->{id} } @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 Defense::Group;
|
|
|
|
use v5.10.1;
|
|
use strict;
|
|
use warnings;
|
|
use Carp;
|
|
|
|
sub new
|
|
{
|
|
my $class = shift;
|
|
my $self = {
|
|
id => shift,
|
|
title => shift,
|
|
questions => shift,
|
|
questions_list => []
|
|
};
|
|
|
|
return bless $self;
|
|
}
|
|
|
|
sub addQuestion($@)
|
|
{
|
|
my $self = shift;
|
|
|
|
push @{ $self->{questions_list} }, @_;
|
|
}
|
|
|
|
sub parseQuestions($@)
|
|
{
|
|
my $self = shift;
|
|
my @ret;
|
|
|
|
for my $question (@_)
|
|
{
|
|
my $expl;
|
|
$expl = @{ $question->getElementsByTagName("explanation") }[0]->textContent if $question->getElementsByTagName("explanation");
|
|
|
|
my $q = Defense::Question->new(
|
|
@{ $question->getElementsByTagName("ask") }[0]->textContent,
|
|
$expl // "",
|
|
$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;
|
|
}
|
|
|
|
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);
|
|
}
|
|
}
|
|
|
|
|
|
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;
|