New script for generating grading file
This commit is contained in:
parent
1d29046348
commit
d32df3b25d
@ -14,12 +14,14 @@ sub new
|
||||
operators => {
|
||||
'add' => '$a+$b'
|
||||
},
|
||||
tree => undef,
|
||||
tree => [],
|
||||
ids => {}
|
||||
};
|
||||
|
||||
bless $self, $class;
|
||||
if ($#_ >= 0) {
|
||||
$self->_initialize(@_);
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
@ -32,28 +34,68 @@ sub _initialize
|
||||
$self->{tree} = $self->parseGrade($dom->documentElement());
|
||||
}
|
||||
|
||||
sub create_from_trace ($$)
|
||||
{
|
||||
my $self = shift;
|
||||
my $trace_id = shift;
|
||||
my $trace_name = shift;
|
||||
my $trace = shift;
|
||||
|
||||
my $g = Grade->new($trace_id, $trace_name);
|
||||
|
||||
for my $id (keys %{ $trace->{ids} })
|
||||
{
|
||||
my $p = Point->new(0, $id, 0, 0);
|
||||
push @{ $g->{tree} }, $p;
|
||||
}
|
||||
|
||||
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;
|
||||
my $ret = [];
|
||||
my $node = shift;
|
||||
|
||||
foreach my $grade ($node->childNodes()) {
|
||||
if ($grade->nodeName eq "operator") {
|
||||
foreach my $grade ($node->childNodes())
|
||||
{
|
||||
if ($grade->nodeName eq "operator")
|
||||
{
|
||||
my $tmp = $grade->textContent;
|
||||
chomp($tmp);
|
||||
$self->{operators}{ $grade->getAttribute("name") } = $tmp;
|
||||
}
|
||||
elsif ($grade->nodeName eq "grade") {
|
||||
elsif ($grade->nodeName eq "grade")
|
||||
{
|
||||
my $g = Grade->new(
|
||||
$grade->getAttribute("id"),
|
||||
$grade->getAttribute("title"),
|
||||
$grade->getAttribute("operator"),
|
||||
$grade->getAttribute("factor")
|
||||
);
|
||||
$g->append(@{ $self->parseGrade($grade) });
|
||||
push @$ret, $g;
|
||||
}
|
||||
elsif ($grade->nodeName eq "point") {
|
||||
elsif ($grade->nodeName eq "point")
|
||||
{
|
||||
my $n = Point->new(
|
||||
$grade->textContent,
|
||||
$grade->getAttribute("ref"),
|
||||
@ -129,12 +171,14 @@ use warnings;
|
||||
use Carp;
|
||||
use Safe;
|
||||
use List::Util "reduce";
|
||||
use XML::LibXML;
|
||||
|
||||
sub new ($$;$$)
|
||||
sub new ($$$;$$)
|
||||
{
|
||||
my $class = shift;
|
||||
my $self = {
|
||||
id => shift,
|
||||
title => shift,
|
||||
operator => shift // "add",
|
||||
factor => shift // 1,
|
||||
tree => []
|
||||
@ -143,6 +187,24 @@ sub new ($$;$$)
|
||||
return bless $self;
|
||||
}
|
||||
|
||||
sub to_string ($$$)
|
||||
{
|
||||
my $self = shift;
|
||||
my $doc = shift;
|
||||
my $parent = shift;
|
||||
|
||||
my $grade = $doc->createElement("grade");
|
||||
$grade->addChild( $doc->createAttribute("id", $self->{id}) );
|
||||
$grade->addChild( $doc->createAttribute("title", $self->{title}) );
|
||||
$grade->addChild( $doc->createAttribute("operator", $self->{operator}) ) if ($self->{operator} ne "add");
|
||||
$grade->addChild( $doc->createAttribute("factor", $self->{factor}) ) if ($self->{factor} != 1);
|
||||
$parent->appendChild($grade);
|
||||
|
||||
for my $item (@{ $self->{tree} }) {
|
||||
$item->to_string($doc, $grade);
|
||||
}
|
||||
}
|
||||
|
||||
sub append ($@)
|
||||
{
|
||||
my $self = shift;
|
||||
@ -205,6 +267,20 @@ sub new ($$$$$)
|
||||
return bless $self;
|
||||
}
|
||||
|
||||
sub to_string ($$$)
|
||||
{
|
||||
my $self = shift;
|
||||
my $doc = shift;
|
||||
my $parent = shift;
|
||||
|
||||
my $point = $doc->createElement("point");
|
||||
$point->addChild( $doc->createAttribute("ref", $self->{ref}) ) if ($self->{ref} ne "");
|
||||
$point->addChild( $doc->createAttribute("qversion", $self->{qversion}) ) if ($self->{qversion} != 0);
|
||||
$point->addChild( $doc->createAttribute("not", $self->{not}) ) if ($self->{not} != 0);
|
||||
$point->appendText($self->{value});
|
||||
$parent->appendChild($point);
|
||||
}
|
||||
|
||||
sub getValue ($$)
|
||||
{
|
||||
my $self = shift;
|
||||
|
24
grades/gen_grading.pl
Normal file
24
grades/gen_grading.pl
Normal file
@ -0,0 +1,24 @@
|
||||
#! /usr/bin/env perl
|
||||
|
||||
use v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Getopt::Long;
|
||||
use Pod::Usage;
|
||||
|
||||
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();
|
||||
$grade->create_from_trace("rendu_1", "rendu-1", $trace);
|
||||
|
||||
say $grade->to_string();
|
||||
} while ($#ARGV >= 0);
|
Reference in New Issue
Block a user