Archived
1
0
Fork 0

Grades: can generate XML final grades

This commit is contained in:
Mercier Pierre-Olivier 2013-09-09 13:42:44 +02:00
commit b0b438098c
3 changed files with 121 additions and 80 deletions

View file

@ -32,6 +32,7 @@ sub _initialize
my $dom = XML::LibXML->load_xml(IO => shift);
$self->{tree} = $self->parseGrade($dom->documentElement());
$self->{max} = $dom->documentElement()->getAttribute("max") // "20";
}
sub create_from_trace ($$)
@ -52,23 +53,6 @@ sub create_from_trace ($$)
push @{ $self->{tree} }, $g;
}
sub to_string ($)
{
my $self = shift;
my $doc = XML::LibXML::Document->new('1.0');
my $root = $doc->createElement("grading");
for my $grade (@{ $self->{tree} }) {
$grade->to_string($doc, $root, $root);
}
$doc->setDocumentElement( $root );
return $doc->toString();
}
sub parseGrade ($$)
{
my $self = shift;
@ -105,7 +89,7 @@ sub parseGrade ($$)
push @$ret, $n;
}
}
return $ret;
}
@ -126,8 +110,35 @@ sub insert ($$$)
sub fill ($$)
{
my $self = shift;
my $ids = shift;
$self->{ids} = shift;
for my $k (keys %{ $ids }) {
$self->{ids}{$k} = $ids->{$k};
}
}
sub to_string ($)
{
my $self = shift;
my $doc = XML::LibXML::Document->new('1.0');
my $root = $doc->createElement("grading");
for my $op (keys %{ $self->{operators} }) {
my $ope = $doc->createElement("operator");
$ope->addChild( $doc->createAttribute("name", $op) );
$ope->appendText($self->{operators}{$op});
$root->appendChild($ope);
}
for my $grade (@{ $self->{tree} }) {
$grade->to_string($doc, $root, $root);
}
$doc->setDocumentElement( $root );
return $doc->toString();
}
sub compute ($)
@ -143,26 +154,29 @@ sub compute ($)
return $sum;
}
sub generate ($;$)
sub computeXML ($;$)
{
my $self = shift;
my $sum = 0;
my $output = shift;
my $doc = XML::LibXML::Document->new('1.0');
my $root = $doc->createElement("grading");
my $final = $doc->createElement("grade");
my $xmlout;
if (not $output) {
$xmlout = *STDOUT;
for my $grade (@{ $self->{tree} }) {
my $tmp = $grade->compute($self->{operators}, $self->{ids}, $doc, $final);
}
else {
open $xmlout, "<", $output or die $!;
}
binmode $xmlout;
my $dom = XML::LibXML::Document->createDocument("1.0", "UTF-8");
my $root = $dom->createElement("grade");
$final->addChild( $doc->createAttribute("value", $self->compute()) );
$final->addChild( $doc->createAttribute("name", "Note finale") );
$root->appendChild( $final );
$root->addChild( $doc->createAttribute("max", $self->{max}) );
$doc->setDocumentElement( $root );
return $doc->toString();
}
package Grade;
use v5.10.1;
@ -212,34 +226,54 @@ sub append ($@)
push @{ $self->{tree} }, @_;
}
sub compute ($$$)
sub compute ($$$;$$)
{
my $self = shift;
my $operators = shift;
my $ids = shift;
my $doc = shift;
my $parent = shift;
my @current = ();
my $grade;
if ($doc && $parent)
{
$grade = $doc->createElement("grade");
$grade->addChild( $doc->createAttribute("factor", $self->{factor}) );
$grade->addChild( $doc->createAttribute("name", $self->{title}) );
$parent->appendChild( $grade );
}
for my $node (@{ $self->{tree} }) {
my $t = $node->compute($operators, $ids);
my $t = $node->compute($operators, $ids, $doc, $grade);
push @current, $t if $t;
}
#TODO: Be more secure!
#$cpt = new Safe;
#$cpt->permit_only(qw(:base_core :base_mem :base_loop));
#$safe->share_from('List::Util', [ 'reduce' ]);
my $res = 0;
my $res;
if (@current > 1)
{
no warnings "uninitialized";
$res = reduce { eval $operators->{ $self->{operator} } } @current if @current > 1;
$res = $current[0] if @current == 1;
my $operator = $self->{operator};
my $cpt = new Safe;
$cpt->permit_only(qw(:base_core :base_mem :base_loop padany));
$res = reduce {
$cpt->share('$a');
$cpt->share('$b');
$cpt->reval($operators->{ $operator }) or die $@;
}
@current;
}
else {
$res = $current[0];
}
$res = $res * $self->{factor};
$ids->{ $self->{id} } = $res;
$grade->addChild( $doc->createAttribute("value", $res) ) if ($grade);
return $grade if ($grade);
return $res;
}
@ -294,7 +328,7 @@ sub getValue ($$)
}
}
sub compute ($$$)
sub compute ($$$;$$)
{
my $self = shift;
my $operators = shift;
@ -313,8 +347,6 @@ sub compute ($$$)
}
}
say "$self->{ref}\t$ret" if (defined $main::debug and defined $ret);
return $ret;
}