Grades: can generate XML final grades
This commit is contained in:
Mercier Pierre-Olivier
parent
37a7bd4b3f
commit
b0b438098c
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;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -10,15 +10,19 @@ use lib "..";
|
|||
use ACU::Grading;
|
||||
use ACU::Trace;
|
||||
|
||||
do {
|
||||
my $xmltrace;
|
||||
open $xmltrace, "<", shift or die $!;
|
||||
binmode $xmltrace;
|
||||
my $trace = Trace->new($xmltrace);
|
||||
close $xmltrace unless $xmltrace eq *STDIN;
|
||||
my $grade = Grading->new();
|
||||
|
||||
do {
|
||||
my $xml;
|
||||
open $xml, "<", shift or die $!;
|
||||
binmode $xml;
|
||||
|
||||
my $trace = Trace->new($xml);
|
||||
|
||||
close $xml unless $xml eq *STDIN;
|
||||
|
||||
my $grade = Grading->new();
|
||||
$grade->create_from_trace("rendu_1", "rendu-1", $trace);
|
||||
|
||||
say $grade->to_string();
|
||||
} while ($#ARGV >= 0);
|
||||
|
||||
print $grade->to_string();
|
||||
|
|
|
|||
|
|
@ -3,23 +3,21 @@
|
|||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
use File::Basename;
|
||||
use Getopt::Long;
|
||||
use Pod::Usage;
|
||||
|
||||
BEGIN {
|
||||
push @INC, "../common";
|
||||
}
|
||||
use Grading;
|
||||
use Trace;
|
||||
use lib "../";
|
||||
use ACU::Grading;
|
||||
use ACU::Log;
|
||||
use ACU::Trace;
|
||||
|
||||
# Parse arguments
|
||||
our $debug;
|
||||
my $input; my $format;
|
||||
my $input; my $format = "csv";
|
||||
my $help; my $man;
|
||||
GetOptions ("help|h|?" => \$help,
|
||||
"man" => \$man,
|
||||
"format|F" => \$format,
|
||||
"debug|d" => \$debug,
|
||||
"format|F=s" => \$format,
|
||||
"" => \$input)
|
||||
or pod2usage(2);
|
||||
pod2usage(1) if $help;
|
||||
|
|
@ -27,32 +25,39 @@ pod2usage(-exitval => 0, -verbose => 2) if $man;
|
|||
|
||||
|
||||
my $xmlgrading;
|
||||
if ($#ARGV == -1) {
|
||||
pod2usage(1);
|
||||
if (defined $input) {
|
||||
$xmlgrading = *STDIN;
|
||||
}
|
||||
else {
|
||||
open $xmlgrading, "<", shift or die $!;
|
||||
}
|
||||
|
||||
binmode $xmlgrading;
|
||||
my $grade = Grading->new($xmlgrading);
|
||||
close $xmlgrading;
|
||||
close $xmlgrading unless $xmlgrading eq *STDIN;
|
||||
|
||||
my $who = "";
|
||||
while ($#ARGV >= -1)
|
||||
{
|
||||
my $arg = shift // "//";
|
||||
|
||||
do {
|
||||
my $xmltrace;
|
||||
if (defined $input || $#ARGV == -1) {
|
||||
$xmltrace = *STDIN;
|
||||
if ($arg eq "//")
|
||||
{
|
||||
say $who.",".$grade->compute() if ($format eq "csv" or $format eq "CSV");
|
||||
print $grade->computeXML($who) if ($format eq "xml" or $format eq "XML");
|
||||
|
||||
$grade->reset();
|
||||
$who = "";
|
||||
|
||||
last if ($#ARGV == -1);
|
||||
}
|
||||
else {
|
||||
open $xmltrace, "<", shift or die $!;
|
||||
else
|
||||
{
|
||||
open my $xmltrace, "<", $arg or die $!;
|
||||
binmode $xmltrace;
|
||||
my $trace = Trace->new($xmltrace);
|
||||
close $xmltrace;
|
||||
|
||||
$grade->fill($trace->getIds);
|
||||
$who = $trace->getFirstWho() // basename $arg, ".xml", ".trace", ".traces", ".defense", ".defenses", ".mill";
|
||||
}
|
||||
|
||||
binmode $xmltrace;
|
||||
my $trace = Trace->new($xmltrace);
|
||||
close $xmltrace unless $xmltrace eq *STDIN;
|
||||
|
||||
$grade->fill($trace->getIds);
|
||||
|
||||
say $trace->getFirstWho().",".$grade->compute();
|
||||
} while ($#ARGV >= 0);
|
||||
}
|
||||
|
|
|
|||
Reference in New Issue
Block a user