Tag defense,... done
This commit is contained in:
Mercier Pierre-Olivier
parent
bad4dd3766
commit
951470b06b
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} };
|
||||
}
|
||||
|
||||
|
||||
|
||||
93
commands/defenses/prepare_xml.pl
Normal file
93
commands/defenses/prepare_xml.pl
Normal file
@ -0,0 +1,93 @@
|
||||
#! /usr/bin/env perl
|
||||
|
||||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Getopt::Long;
|
||||
use Pod::Usage;
|
||||
use XML::LibXML;
|
||||
|
||||
use lib "../";
|
||||
|
||||
use ACU::Defense;
|
||||
|
||||
# Parse arguments
|
||||
my $input; my $output;
|
||||
my $help; my $man;
|
||||
GetOptions ("output|O=s" => \$output,
|
||||
"help|h|?" => \$help,
|
||||
"man" => \$man,
|
||||
"" => \$input)
|
||||
or pod2usage(2);
|
||||
pod2usage(1) if $help;
|
||||
pod2usage(-exitval => 0, -verbose => 2) if $man;
|
||||
|
||||
# Open defense XML file
|
||||
my $xmlin;
|
||||
if (defined $input || $#ARGV == -1) {
|
||||
$xmlin = *STDIN;
|
||||
}
|
||||
else {
|
||||
open $xmlin, "<", $ARGV[0] or die $!;
|
||||
}
|
||||
|
||||
binmode $xmlin;
|
||||
|
||||
my $str;
|
||||
$str .= $_ while(<$xmlin>);
|
||||
|
||||
my $defense = Defense->new($str);
|
||||
close $xmlin unless $xmlin eq *STDIN;
|
||||
|
||||
$defense->genIds;
|
||||
|
||||
# Save defense XML file
|
||||
my $xmlout;
|
||||
if (defined $output) {
|
||||
open $xmlout, '>', $output;
|
||||
binmode $xmlout;
|
||||
}
|
||||
else {
|
||||
$xmlout = *STDOUT;
|
||||
}
|
||||
print {$xmlout} $defense->toString();
|
||||
close $xmlout unless $xmlout eq *STDOUT;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
prepare_xml.pl - Prepare defense XML by adding id to groups, questions and answers
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
prepare_xml.pl [options] [file]
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Parse the XML file given (or stdin if no file is given) and add id to groups, questions and answers that have any or duplicate id.
|
||||
|
||||
Options:
|
||||
-output=file.xml save prepared XML to this location
|
||||
-help brief help message
|
||||
-man full documentation
|
||||
|
||||
=head1 OPTIONS
|
||||
|
||||
=over 8
|
||||
|
||||
=item B<-output=file.xml>
|
||||
|
||||
Save the prepared XML to a file instead of printing it on standard output.
|
||||
|
||||
=item B<-help>
|
||||
|
||||
Print a brief help message and exits.
|
||||
|
||||
=item B<-man>
|
||||
|
||||
Prints the manual page and exits.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
@ -1,158 +0,0 @@
|
||||
#! /usr/bin/env perl
|
||||
|
||||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Getopt::Long;
|
||||
use Pod::Usage;
|
||||
use XML::LibXML;
|
||||
|
||||
# Extract IDs and remove duplicates
|
||||
sub extract_ids (\@@)
|
||||
{
|
||||
my $ids = shift @_;
|
||||
|
||||
foreach my $node (@_)
|
||||
{
|
||||
my $att = $node->getAttribute("id");
|
||||
if (defined $att)
|
||||
{
|
||||
if (grep {$_ eq $att} @$ids) {
|
||||
$node->removeAttribute("id");
|
||||
}
|
||||
else {
|
||||
push @$ids, $att;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Parse arguments
|
||||
my $input; my $output;
|
||||
my $help; my $man;
|
||||
GetOptions ("output|O=s" => \$output,
|
||||
"help|h|?" => \$help,
|
||||
"man" => \$man,
|
||||
"" => \$input)
|
||||
or pod2usage(2);
|
||||
pod2usage(1) if $help;
|
||||
pod2usage(-exitval => 0, -verbose => 2) if $man;
|
||||
|
||||
# Open defense XML file
|
||||
my $xmlin;
|
||||
if (defined $input || $#ARGV == -1) {
|
||||
$xmlin = *STDIN;
|
||||
}
|
||||
else {
|
||||
open $xmlin, "<", $ARGV[0] or die $!;
|
||||
}
|
||||
|
||||
binmode $xmlin;
|
||||
my $dom = XML::LibXML->load_xml(IO => $xmlin);
|
||||
close $xmlin unless $xmlin eq *STDIN;
|
||||
|
||||
# First, get all existing ID and remove duplicates
|
||||
my @ids;
|
||||
extract_ids @ids, $dom->getElementsByTagName("group");
|
||||
extract_ids @ids, $dom->getElementsByTagName("question");
|
||||
extract_ids @ids, $dom->getElementsByTagName("answer");
|
||||
|
||||
# Then, attribute an ID to node that hasn't
|
||||
my $grp_i = 0;
|
||||
foreach my $group ($dom->getElementsByTagName("group"))
|
||||
{
|
||||
my $cur_gid = $group->getAttribute("id");
|
||||
if (!defined $cur_gid) {
|
||||
do {
|
||||
$cur_gid = "defg".$grp_i;
|
||||
$grp_i += 1;
|
||||
} while (grep {$_ eq $cur_gid} @ids);
|
||||
$group->setAttribute("id", $cur_gid);
|
||||
}
|
||||
else {
|
||||
$grp_i += 1;
|
||||
}
|
||||
|
||||
my $qst_i = 0;
|
||||
foreach my $question ($group->getElementsByTagName("question"))
|
||||
{
|
||||
my $cur_qid = $question->getAttribute("id");
|
||||
if (!defined $cur_qid) {
|
||||
do {
|
||||
$cur_qid = $cur_gid."q".$qst_i;
|
||||
$qst_i += 1;
|
||||
} while (grep {$_ eq $cur_qid} @ids);
|
||||
$question->setAttribute("id", $cur_qid);
|
||||
}
|
||||
else {
|
||||
$qst_i += 1;
|
||||
}
|
||||
|
||||
my $ans_i = 0;
|
||||
foreach my $answer ($question->getElementsByTagName("answer"))
|
||||
{
|
||||
my $cur_aid = $answer->getAttribute("id");
|
||||
if (!defined $cur_aid) {
|
||||
do {
|
||||
$cur_aid = $cur_qid."a".$ans_i;
|
||||
$ans_i += 1;
|
||||
} while (grep {$_ eq $cur_aid} @ids);
|
||||
$answer->setAttribute("id", $cur_aid);
|
||||
}
|
||||
else {
|
||||
$ans_i += 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Save defense XML file
|
||||
my $xmlout;
|
||||
if (defined $output) {
|
||||
open $xmlout, '>', $output;
|
||||
binmode $xmlout;
|
||||
}
|
||||
else {
|
||||
$xmlout = *STDOUT;
|
||||
}
|
||||
print {$xmlout} $dom->toString();
|
||||
close $xmlout unless $xmlout eq *STDOUT;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
prepare_xml.pl - Prepare defense XML by adding id to groups, questions and answers
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
prepare_xml.pl [options] [file]
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Parse the XML file given (or stdin if no file is given) and add id to groups, questions and answers that have any or duplicate id.
|
||||
|
||||
Options:
|
||||
-output=file.xml save prepared XML to this location
|
||||
-help brief help message
|
||||
-man full documentation
|
||||
|
||||
=head1 OPTIONS
|
||||
|
||||
=over 8
|
||||
|
||||
=item B<-output=file.xml>
|
||||
|
||||
Save the prepared XML to a file instead of printing it on standard output.
|
||||
|
||||
=item B<-help>
|
||||
|
||||
Print a brief help message and exits.
|
||||
|
||||
=item B<-man>
|
||||
|
||||
Prints the manual page and exits.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
@ -7,6 +7,7 @@ use Digest::SHA qw(sha1_base64);
|
||||
use File::Basename;
|
||||
|
||||
use ACU::API::Projects;
|
||||
use ACU::Defense;
|
||||
use ACU::LDAP;
|
||||
use ACU::Log;
|
||||
$ACU::Log::log_file = "/var/log/hooks/" . basename($0) . ".log";
|
||||
@ -83,7 +84,7 @@ sub tag_defense
|
||||
# 4: $path
|
||||
# 5: $year
|
||||
|
||||
my $version = $_[3] // 1;
|
||||
my $version = $_[2] // 1;
|
||||
|
||||
my $project_id = repository_name();
|
||||
if ($_[3])
|
||||
@ -97,7 +98,37 @@ sub tag_defense
|
||||
}
|
||||
$project_id = lc $project_id;
|
||||
$project_id =~ s/[^a-z0-9-_]/_/g;
|
||||
|
||||
|
||||
my $path;
|
||||
if ($_[4])
|
||||
{
|
||||
if ($_[4] =~ /(?:defenses\/)?([a-zA-Z0-9\/]+)(?:.xml)/) {
|
||||
$path = "defenses/".$1.".xml";
|
||||
} else {
|
||||
$path = $_[4];
|
||||
}
|
||||
}
|
||||
else {
|
||||
# Looking for an uniq defense file in defenses/
|
||||
$path = qx(git ls-tree -r --name-only HEAD defenses/ | egrep '\.xml\$');
|
||||
my $nb_defenses = $path =~ tr/\n//;
|
||||
if ($nb_defenses > 1) {
|
||||
log ERROR, "Veuillez préciser le chemin de la soutenance à utiliser";
|
||||
exit 1;
|
||||
}
|
||||
elsif ($nb_defenses == 0) {
|
||||
log ERROR, "Aucune soutenance n'a été trouvée dans le dossier defenses/";
|
||||
exit 1;
|
||||
}
|
||||
chomp($path);
|
||||
}
|
||||
|
||||
my $defense_id;
|
||||
if ($_[4] =~ /(?:defenses\/)?([a-zA-Z0-9\/]+)(?:.xml)/) {
|
||||
$defense_id = $1;
|
||||
} else {
|
||||
log ERROR, "Déplacez votre soutenance dans le dossier defenses ou simplifiez le nom du fichier.";
|
||||
}
|
||||
|
||||
my $year;
|
||||
if ($_[5])
|
||||
@ -117,40 +148,44 @@ sub tag_defense
|
||||
{
|
||||
my $newref = $ARGV[2];
|
||||
|
||||
my $path;
|
||||
if ($_[4]) {
|
||||
$path = $_[4];
|
||||
}
|
||||
else
|
||||
{
|
||||
|
||||
}
|
||||
|
||||
log INFO, "Création/mise à jour de la soutenance...";
|
||||
|
||||
my $content = qx(git show $newref:project.xml);
|
||||
log INFO, "Looking for $path...";
|
||||
# Check file exists
|
||||
my $content = qx(git show $newref:$path);
|
||||
if ($?) {
|
||||
log ERROR, "Créez un fichier project.xml à la racine du dépôt.";
|
||||
log ERROR, "Impossible de trouver la soutenance.";
|
||||
}
|
||||
|
||||
# Check DTD validity
|
||||
if (check_xml(\$content, "http://acu.epita.fr/dtd/defense.dtd")) {
|
||||
log ERROR, "Corrigez les erreurs du fichier XXX.xml avant de lancer la création du projet.";
|
||||
log ERROR, "Corrigez les erreurs du fichier $path avant de publier la soutenance.";
|
||||
}
|
||||
|
||||
# TODO: check user permissions
|
||||
|
||||
# Generate questions and answer id
|
||||
my $defense = Defense->new(\$content);
|
||||
$defense->genIds();
|
||||
|
||||
# Send data to intradata
|
||||
log INFO, "Attente d'un processus de publication...";
|
||||
if (my $err = Process::Client::launch("intradata_get", { action => "update", type => "defense", id => $project_id, "year" => $year, "defense_id" => $defense_id, "version" => $version }, { "$defense_id.xml" => $defense->toString() }))
|
||||
{
|
||||
if (${ $err } ne "Ok") {
|
||||
log ERROR, "Erreur durant le processus de publication : " . ${ $err };
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
sub tag_document
|
||||
{
|
||||
|
||||
|
||||
}
|
||||
|
||||
sub tag_grades
|
||||
{
|
||||
|
||||
|
||||
}
|
||||
|
||||
sub tag_project
|
||||
@ -293,10 +328,10 @@ sub tag_project
|
||||
|
||||
sub tag_ref
|
||||
{
|
||||
|
||||
|
||||
}
|
||||
|
||||
sub tag_tests
|
||||
{
|
||||
|
||||
|
||||
}
|
||||
|
||||
@ -18,6 +18,9 @@ my %actions = (
|
||||
"create" => \&update_project,
|
||||
"update" => \&update_project,
|
||||
"delete" => \&delete_project,
|
||||
},
|
||||
"defense" => {
|
||||
"update" => \&update_defense,
|
||||
}
|
||||
);
|
||||
|
||||
@ -71,6 +74,53 @@ sub update_project
|
||||
return "Ok";
|
||||
}
|
||||
|
||||
sub update_defense
|
||||
{
|
||||
my $args = shift;
|
||||
|
||||
my $project_id = $args->{param}{id};
|
||||
my $year = $args->{param}{year} // LDAP::get_year;
|
||||
|
||||
if (! $project_id) {
|
||||
log ERROR, "No project_id given.";
|
||||
return "No project_id given";
|
||||
}
|
||||
|
||||
my $defense_id = $args->{param}{defense_id};
|
||||
|
||||
if (! $defense_id) {
|
||||
log ERROR, "No defense_id given.";
|
||||
return "No defense_id given";
|
||||
}
|
||||
|
||||
my $defense;
|
||||
if (exists $args->{files}{"$defense_id.xml"}) {
|
||||
$defense = $args->{files}{"$defense_id.xml"};
|
||||
}
|
||||
if (! $defense) {
|
||||
log ERROR, "Invalid $defense_id.xml received!";
|
||||
return "Invalid $defense_id.xml received!";
|
||||
}
|
||||
|
||||
log INFO, "Update $year/$project_id/defenses/$defense_id.xml";
|
||||
|
||||
if (! -e "$basedir/$year/$project_id/defenses/") {
|
||||
mkdir "$basedir/$year/$project_id/defenses/";
|
||||
}
|
||||
if (! -e "$basedir/$year/$project_id/traces/") {
|
||||
mkdir "$basedir/$year/$project_id/traces/";
|
||||
}
|
||||
if (! -e "$basedir/$year/$project_id/traces/defense_$defense_id/") {
|
||||
mkdir "$basedir/$year/$project_id/traces/defense_$defense_id/";
|
||||
}
|
||||
|
||||
open my $out, ">", "$basedir/$year/$project_id/defenses/$defense_id.xml";
|
||||
print $out $defense;
|
||||
close $out;
|
||||
|
||||
return "Ok";
|
||||
}
|
||||
|
||||
sub delete_project
|
||||
{
|
||||
log WARN, "delete_project: not implemented."
|
||||
|
||||
Reference in New Issue
Block a user