Grades: can generate XML final grades

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;
 }
 

grades/gen_grading.pl

@@ -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();

grades/generate.pl

@@ -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);
+}