Grades: can generate XML final grades
This commit is contained in:
parent
37a7bd4b3f
commit
b0b438098c
120
ACU/Grading.pm
120
ACU/Grading.pm
@ -32,6 +32,7 @@ sub _initialize
|
|||||||
|
|
||||||
my $dom = XML::LibXML->load_xml(IO => shift);
|
my $dom = XML::LibXML->load_xml(IO => shift);
|
||||||
$self->{tree} = $self->parseGrade($dom->documentElement());
|
$self->{tree} = $self->parseGrade($dom->documentElement());
|
||||||
|
$self->{max} = $dom->documentElement()->getAttribute("max") // "20";
|
||||||
}
|
}
|
||||||
|
|
||||||
sub create_from_trace ($$)
|
sub create_from_trace ($$)
|
||||||
@ -52,23 +53,6 @@ sub create_from_trace ($$)
|
|||||||
push @{ $self->{tree} }, $g;
|
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 ($$)
|
sub parseGrade ($$)
|
||||||
{
|
{
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
@ -126,8 +110,35 @@ sub insert ($$$)
|
|||||||
sub fill ($$)
|
sub fill ($$)
|
||||||
{
|
{
|
||||||
my $self = shift;
|
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 ($)
|
sub compute ($)
|
||||||
@ -143,26 +154,29 @@ sub compute ($)
|
|||||||
return $sum;
|
return $sum;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub generate ($;$)
|
sub computeXML ($;$)
|
||||||
{
|
{
|
||||||
my $self = shift;
|
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;
|
for my $grade (@{ $self->{tree} }) {
|
||||||
if (not $output) {
|
my $tmp = $grade->compute($self->{operators}, $self->{ids}, $doc, $final);
|
||||||
$xmlout = *STDOUT;
|
|
||||||
}
|
}
|
||||||
else {
|
|
||||||
open $xmlout, "<", $output or die $!;
|
|
||||||
}
|
|
||||||
binmode $xmlout;
|
|
||||||
|
|
||||||
my $dom = XML::LibXML::Document->createDocument("1.0", "UTF-8");
|
$final->addChild( $doc->createAttribute("value", $self->compute()) );
|
||||||
my $root = $dom->createElement("grade");
|
$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;
|
package Grade;
|
||||||
|
|
||||||
use v5.10.1;
|
use v5.10.1;
|
||||||
@ -212,34 +226,54 @@ sub append ($@)
|
|||||||
push @{ $self->{tree} }, @_;
|
push @{ $self->{tree} }, @_;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub compute ($$$)
|
sub compute ($$$;$$)
|
||||||
{
|
{
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $operators = shift;
|
my $operators = shift;
|
||||||
my $ids = shift;
|
my $ids = shift;
|
||||||
|
my $doc = shift;
|
||||||
|
my $parent = shift;
|
||||||
my @current = ();
|
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} }) {
|
for my $node (@{ $self->{tree} }) {
|
||||||
my $t = $node->compute($operators, $ids);
|
my $t = $node->compute($operators, $ids, $doc, $grade);
|
||||||
push @current, $t if $t;
|
push @current, $t if $t;
|
||||||
}
|
}
|
||||||
|
|
||||||
#TODO: Be more secure!
|
my $res;
|
||||||
#$cpt = new Safe;
|
if (@current > 1)
|
||||||
#$cpt->permit_only(qw(:base_core :base_mem :base_loop));
|
|
||||||
#$safe->share_from('List::Util', [ 'reduce' ]);
|
|
||||||
|
|
||||||
my $res = 0;
|
|
||||||
{
|
{
|
||||||
no warnings "uninitialized";
|
my $operator = $self->{operator};
|
||||||
$res = reduce { eval $operators->{ $self->{operator} } } @current if @current > 1;
|
|
||||||
$res = $current[0] if @current == 1;
|
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};
|
$res = $res * $self->{factor};
|
||||||
|
|
||||||
$ids->{ $self->{id} } = $res;
|
$ids->{ $self->{id} } = $res;
|
||||||
|
|
||||||
|
$grade->addChild( $doc->createAttribute("value", $res) ) if ($grade);
|
||||||
|
|
||||||
|
return $grade if ($grade);
|
||||||
return $res;
|
return $res;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -294,7 +328,7 @@ sub getValue ($$)
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
sub compute ($$$)
|
sub compute ($$$;$$)
|
||||||
{
|
{
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $operators = shift;
|
my $operators = shift;
|
||||||
@ -313,8 +347,6 @@ sub compute ($$$)
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
say "$self->{ref}\t$ret" if (defined $main::debug and defined $ret);
|
|
||||||
|
|
||||||
return $ret;
|
return $ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -10,15 +10,19 @@ use lib "..";
|
|||||||
use ACU::Grading;
|
use ACU::Grading;
|
||||||
use ACU::Trace;
|
use ACU::Trace;
|
||||||
|
|
||||||
do {
|
my $grade = Grading->new();
|
||||||
my $xmltrace;
|
|
||||||
open $xmltrace, "<", shift or die $!;
|
do {
|
||||||
binmode $xmltrace;
|
my $xml;
|
||||||
my $trace = Trace->new($xmltrace);
|
open $xml, "<", shift or die $!;
|
||||||
close $xmltrace unless $xmltrace eq *STDIN;
|
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);
|
$grade->create_from_trace("rendu_1", "rendu-1", $trace);
|
||||||
|
|
||||||
say $grade->to_string();
|
|
||||||
} while ($#ARGV >= 0);
|
} while ($#ARGV >= 0);
|
||||||
|
|
||||||
|
print $grade->to_string();
|
||||||
|
@ -3,23 +3,21 @@
|
|||||||
use v5.10.1;
|
use v5.10.1;
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
|
use File::Basename;
|
||||||
use Getopt::Long;
|
use Getopt::Long;
|
||||||
use Pod::Usage;
|
use Pod::Usage;
|
||||||
|
|
||||||
BEGIN {
|
use lib "../";
|
||||||
push @INC, "../common";
|
use ACU::Grading;
|
||||||
}
|
use ACU::Log;
|
||||||
use Grading;
|
use ACU::Trace;
|
||||||
use Trace;
|
|
||||||
|
|
||||||
# Parse arguments
|
# Parse arguments
|
||||||
our $debug;
|
my $input; my $format = "csv";
|
||||||
my $input; my $format;
|
|
||||||
my $help; my $man;
|
my $help; my $man;
|
||||||
GetOptions ("help|h|?" => \$help,
|
GetOptions ("help|h|?" => \$help,
|
||||||
"man" => \$man,
|
"man" => \$man,
|
||||||
"format|F" => \$format,
|
"format|F=s" => \$format,
|
||||||
"debug|d" => \$debug,
|
|
||||||
"" => \$input)
|
"" => \$input)
|
||||||
or pod2usage(2);
|
or pod2usage(2);
|
||||||
pod2usage(1) if $help;
|
pod2usage(1) if $help;
|
||||||
@ -27,32 +25,39 @@ pod2usage(-exitval => 0, -verbose => 2) if $man;
|
|||||||
|
|
||||||
|
|
||||||
my $xmlgrading;
|
my $xmlgrading;
|
||||||
if ($#ARGV == -1) {
|
if (defined $input) {
|
||||||
pod2usage(1);
|
$xmlgrading = *STDIN;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
open $xmlgrading, "<", shift or die $!;
|
open $xmlgrading, "<", shift or die $!;
|
||||||
}
|
}
|
||||||
|
|
||||||
binmode $xmlgrading;
|
binmode $xmlgrading;
|
||||||
my $grade = Grading->new($xmlgrading);
|
my $grade = Grading->new($xmlgrading);
|
||||||
close $xmlgrading;
|
close $xmlgrading unless $xmlgrading eq *STDIN;
|
||||||
|
|
||||||
|
my $who = "";
|
||||||
|
while ($#ARGV >= -1)
|
||||||
|
{
|
||||||
|
my $arg = shift // "//";
|
||||||
|
|
||||||
do {
|
if ($arg eq "//")
|
||||||
my $xmltrace;
|
{
|
||||||
if (defined $input || $#ARGV == -1) {
|
say $who.",".$grade->compute() if ($format eq "csv" or $format eq "CSV");
|
||||||
$xmltrace = *STDIN;
|
print $grade->computeXML($who) if ($format eq "xml" or $format eq "XML");
|
||||||
|
|
||||||
|
$grade->reset();
|
||||||
|
$who = "";
|
||||||
|
|
||||||
|
last if ($#ARGV == -1);
|
||||||
}
|
}
|
||||||
else {
|
else
|
||||||
open $xmltrace, "<", shift or die $!;
|
{
|
||||||
|
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