Archived
1
0

Grades: can generate XML final grades

This commit is contained in:
Mercier Pierre-Olivier 2013-09-09 13:42:44 +02:00
parent 37a7bd4b3f
commit b0b438098c
3 changed files with 122 additions and 81 deletions

View File

@ -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;
@ -105,7 +89,7 @@ sub parseGrade ($$)
push @$ret, $n; push @$ret, $n;
} }
} }
return $ret; return $ret;
} }
@ -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;
} }

View File

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

View File

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