Grades: can generate XML final grades
This commit is contained in:
parent
37a7bd4b3f
commit
b0b438098c
3 changed files with 121 additions and 80 deletions
122
ACU/Grading.pm
122
ACU/Grading.pm
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
|||
Reference in a new issue