New parser for traces

ACU/Grading.pm

@@ -111,7 +111,7 @@ sub insert ($$$)
     $self->{ids}{$_[0]} = $_[1];
 }
 
-sub fill ($$)
+sub fill
 {
     my $self = shift;
     my $ids = shift;

ACU/Trace.pm

@@ -9,16 +9,13 @@ use Carp;
 use utf8;
 use open qw(:encoding(UTF-8) :std);
 use XML::LibXML;
-use XML::SAX::ParserFactory;
 
 sub new
 {
     my $class = shift;
     my $self = {
-	ids => {},
 	infos => {},
-	comments => {},
+	groups => [],
-	who => {},
     };
 
     bless $self, $class;
@@ -33,10 +30,47 @@ sub _initialize ($$)
 {
     my $self = shift;
 
-    my $sax_handler = TraceHandler->new($self);
+    my $dom = XML::LibXML->load_xml(string => shift);
-    my $parser = XML::SAX::ParserFactory->parser( Handler => $sax_handler );
+    $self->{groups} = $self->parseTrace($dom->documentElement());
+    $self->{type} = $dom->documentElement()->getAttribute("type") // "mill";
+    $self->{version} = $dom->documentElement()->getAttribute("version") // 1;
+}
 
-    $parser->parse_file(shift);
+sub parseTrace($$)
+{
+    my $self = shift;
+    my $tree = shift;
+    my $ret = [];
+
+    foreach my $node ($tree->childNodes())
+    {
+	if ($node->nodeName eq "info")
+	{
+	    my $tmp = $node->textContent;
+	    chomp($tmp);
+	    $self->{infos}{ $node->getAttribute("name") } = $tmp;
+	}
+	elsif ($node->nodeName eq "group")
+	{
+	    my $g = Trace::Group->new(
+		$node->getAttribute("id"),
+		$node->getAttribute("name")
+	    );
+	    $g->append(@{ $self->parseTrace($node) });
+	    push @$ret, $g;
+	}
+	elsif ($node->nodeName eq "eval")
+	{
+	    my $e = Trace::Eval->new(
+		$node->getAttribute("id"),
+		$node->getAttribute("type"),
+		$node
+	    );
+	    push @$ret, $e;
+	}
+    }
+
+    return $ret;
 }
 
 sub getVersion ($)
@@ -63,64 +97,63 @@ sub getInfos ($)
     return $self->{infos};
 }
 
-sub getComment ($$)
+sub getIds
 {
     my $self = shift;
-    return $self->{comments}{$_[0]};
+    my $login = shift;
+
+    my %ids;
+    foreach my $group (@{ $self->{groups} })
+    {
+	my %tmp = $group->getIds($login);
+	while (my ($key, $value) = each %tmp)
+	{
+	    %ids{$key} = $value;
+	}
+    }
+    return %ids;
 }
 
-sub getComments ($)
+sub getValue
 {
     my $self = shift;
-    return $self->{comments};
+    my $id = shift;
+    my $login = shift;
+
+    my $value = 0;
+    foreach my $group (@{ $self->{groups} })
+    {
+	$value += $group->getValue($id, $login);
+    }
+    return $value;
 }
 
 sub getWho ($$)
 {
     my $self = shift;
-    return $self->{who}{$_[0]};
+    return $self->getWhos()->{$_[0]};
 }
 
 sub getFirstWho ($)
 {
     my $self = shift;
-
+    return $self->getWhos()->{def1_end_group};
-    return $self->{who}{def1_end_group};
 }
 
-sub getWhos ($)
+sub getWhos
 {
     my $self = shift;
-    return $self->{who};
+    my $ret = {};
-}
 
-sub getValue ($$)
+    foreach my $group (@{ $self->{groups} })
-{
+    {
-    my $self = shift;
+	my $whos = $group->getWhos();
-    return $self->{ids}{$_[0]};
+	foreach my $who (keys %{ $whos }) {
-}
+	    $ret->{ $who } = $whos->{$who};
+	}
+    }
 
-sub getIds ($)
+    return $ret;
-{
-    my $self = shift;
-    return $self->{ids};
-}
-
-sub addId($$;$)
-{
-    my $self = shift;
-    my $key = shift;
-    my $value = shift // 1;
-
-    $self->{ids}{$key} = $value;
-}
-
-sub delId($$)
-{
-    my $self = shift;
-    my $key = shift;
-
-    delete $self->{ids}{$key};
 }
 
 sub toString ($;$)
@@ -153,23 +186,20 @@ sub toString ($;$)
 }
 
 
-package TraceHandler;
+package Trace::Group;
 
+use v5.10.1;
+use strict;
+use warnings;
 use Carp;
-use constant NO_ID_VALUE => "__#";
 
 sub new ($$)
 {
     my $class = shift;
     my $self = {
-	groups => [],
+	id => shift,
-	parsed => shift,
+	name => shift,
-	inComment => "",
+	groups => []
-	inEval => "",
-	inInfo => "",
-	inValue => "",
-	inWho => "",
-	values => ""
     };
 
     bless $self, $class;
@@ -177,113 +207,188 @@ sub new ($$)
     return $self;
 }
 
-sub start_element
+sub append ($@)
 {
-    my ($self, $element) = @_;
+    my $self = shift;
 
-    if ($element->{Name} eq "trace") {
+    push @{ $self->{groups} }, @_;
-	$self->{parsed}{version} = $element->{Attributes}{"{}version"}{Value};
-	$self->{parsed}{type} = $element->{Attributes}{"{}type"}{Value};
-    }
-    elsif ($element->{Name} eq "info") {
-	$self->{inInfo} = $element->{Attributes}{"{}name"}{Value};
-	$self->{parsed}{infos}{ $self->{inInfo} } = 0;
-	$self->{values} = "";
-    }
-    elsif ($element->{Name} eq "eval") {
-        my $tmp = $element->{Attributes}{"{}id"}{Value};
-        if ($tmp) {
-            $self->{inEval} = $tmp;
-            $self->{parsed}{ids}{ $self->{inEval} } = 0;
-        }
-    }
-    elsif ($element->{Name} eq "comment" && $self->{inEval}) {
-	$self->{inComment} = $self->{inEval};
-	$self->{values} = "";
-    }
-    elsif ($element->{Name} eq "who" && $self->{inEval}) {
-	$self->{inWho} = $self->{inEval};
-	$self->{values} = "";
-    }
-    elsif ($element->{Name} eq "value") {
-	if ($element->{Attributes}{"{}id"}{Value}) {
-	    $self->{inValue} = $element->{Attributes}{"{}id"}{Value};
-	} else {
-	    $self->{inValue} = NO_ID_VALUE;
-	}
-
-	$self->{values} = "";
-    }
-    elsif ($element->{Name} eq "group")
-    {
-	push @{ $self->{groups} }, ($element->{Attributes}{"{}id"}{Value} // "");
-    }
-    elsif ($element->{Name} ne "name" && $element->{Name} ne "statut" && $element->{Name} ne "status" && $element->{Name} ne "log") {
-	croak "Not a valid trace XML: unknown tag ".$element->{Name};
-    }
 }
 
-sub characters
+sub getIds
 {
-    my ($self, $characters) = @_;
+    my $self = shift;
+    my $login = shift;
 
-    if ($self->{inValue} || $self->{inInfo} || $self->{inComment} || $self->{inWho}) {
+    my %ids;
-	$self->{values} .= $characters->{Data};
+    foreach my $group (@{ $self->{groups} })
-    }
-}
-
-sub end_element
-{
-    my ($self, $element) = @_;
-
-    if ($element->{Name} eq "value")
     {
-	if ($self->{values} =~ /([-+]?[0-9]+(.[0-9]+)?)/)
+	my %tmp = $group->getIds($login);
+	while (($key, $value) = each %tmp)
 	{
-	    $self->{parsed}{ids}{ $self->{inEval} } += $1;
+	    %ids{$key} = $value;
-	    if ($self->{inValue} ne NO_ID_VALUE and $1) {
+	}
-		$self->{parsed}{ids}{ $self->{inValue} } = $1;
+    }
-	    }
+
-	    if ($self->{groups}) {
+    %ids{ $self->{id} } = $self->getValue($self->{id}, $login);
-		my $key = @{ $self->{groups} }[$#{ $self->{groups} }];
+
-		$self->{parsed}{ids}{ $key } += $1;
+    return %ids;
+}
+
+sub getValue
+{
+    my $self = shift;
+    my $id = shift // $self->{id};
+    my $login = shift
+
+    if ($id eq $self->{id})
+    {
+	my $value = 0;
+	foreach my $group (@{ $self->{groups} })
+	{
+	    $value += $group->getValue(undef, $login);
+	}
+	return $value;
+    }
+    else
+    {
+	my $value = 0;
+	foreach my $group (@{ $self->{groups} })
+	{
+	    $value += $group->getValue($id, $login);
+	}
+	return $value;
+    }
+}
+
+sub getWhos
+{
+    my $self = shift;
+    my $ret = {};
+
+    foreach my $group (@{ $self->{groups} })
+    {
+	my $whos = $group->getWhos();
+	foreach my $who (keys %{ $whos }) {
+	    $ret->{ $who } = $whos->{$who};
+	}
+    }
+
+    return $ret;
+}
+
+
+package Trace::Eval;
+
+use v5.10.1;
+use strict;
+use warnings;
+use Carp;
+
+sub new ($$;$)
+{
+    my $class = shift;
+    my $self = {
+	id => shift,
+	type => shift // "test",
+	values => {},
+	logs => {},
+    };
+
+    bless $self, $class;
+    if ($#_ >= 0) {
+	$self->parseEval(@_);
+    }
+
+    return $self;
+}
+
+sub parseEval
+{
+    my $self = shift;
+    my $tree = shift;
+
+    foreach my $node ($tree->childNodes())
+    {
+	my $val = $node->textContent;
+	chomp($val);
+
+	if ($node->nodeName eq "value")
+	{
+	    my $key;
+	    if ($node->hasAttribute("id")) {
+		$key = $node->getAttribute("id");
+	    } else {
+		$key = "";
 	    }
+
+	    $self->{values}{ $key } = 0 if (!exists $self->{values}{ $key });
+	    $self->{values}{ $key } += $val;
 	}
-	$self->{inValue} = "";
+	elsif ($node->nodeName eq "name")
-    }
+	{
-    elsif ($element->{Name} eq "eval")
+	    $self->{name} = $val;
-    {
-	# Remove empty identifier
-	delete $self->{parsed}{ids}{ $self->{inEval} } if (!$self->{parsed}{ids}{ $self->{inEval} });
-	$self->{inEval} = "";
-    }
-    elsif ($element->{Name} eq "comment")
-    {
-	if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) {
-	    $self->{parsed}{comments}{ $self->{inComment} } = $1;
 	}
-	$self->{inComment} = "";
+	elsif ($node->nodeName eq "status")
-    }
+	{
-    elsif ($element->{Name} eq "who")
+	    $self->{status} = $val;
-    {
-	if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) {
-	    $self->{parsed}{who}{ $self->{inWho} } = $1;
 	}
-	$self->{inComment} = "";
+	elsif ($node->nodeName eq "log")
-    }
+	{
-    elsif ($element->{Name} eq "info")
+	    my $key = $node->getAttribute("type") // "stdout";
-    {
+
-	if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) {
+	    $self->{logs}{ $key } = $val;
-	    $self->{parsed}{infos}{ $self->{inInfo} } = $1;
+	}
+	elsif ($node->nodeName eq "who")
+	{
+	    $self->{who} = {
+		login => $val,
+		type  => $node->getAttribute("type") // "login"
+	    };
 	}
-	$self->{inInfo} = "";
     }
-    elsif ($element->{Name} eq "group")
+}
+
+sub getIds
+{
+    my $self = shift;
+    my $login = shift;
+
+    my %ids;
+    if (!$login || $self->{who}{type} eq "group" || $self->{who}{login} eq $login)
     {
-	my $key = pop @{ $self->{groups} };
+	while (my ($key, $value) = each %{ $self->{who}{values} })
-	# Remove empty identifier
+	{
-	delete $self->{parsed}{ids}{ $key } if ($key && !$self->{parsed}{ids}{ $key });
+	    %ids{$key} = $value if ($key);
+	}
     }
+
+    %ids{ $self->{id} } = $self->getValue($self->{id}, $login);
+
+    return %ids;
+}
+
+sub getValue
+{
+    my $self = shift;
+    my $id = shift // $self->{id};
+    my $login = shift;
+
+    my $value = 0;
+    if (!$login || $self->{who}{type} eq "group" || $self->{who}{login} eq $login)
+    {
+	foreach my $key (%{ $self->{values} })
+	{
+	    $value += $self->{values}{$key} if ($id eq $self->{id} || !$key || $key eq $id);
+	}
+    }
+    return $value;
+}
+
+sub getWhos
+{
+    my $self = shift;
+
+    return { $self->{id} => $self->{who} };
 }
 
 1;

process/files/intradata_get.pl

@@ -133,7 +133,7 @@ sub grades_generate
 
 	    if (-f "$basedir/$tr_file")
 	    {
-		open my $xmltrace, "<", "$basedir/$tr_file" or croak "$tr_file: $!";
+		open my $xmltrace, "<", "$basedir/$tr_file" or die "$tr_file: $!";
 		binmode $xmltrace;
 		my $trace = Trace->new($xmltrace);
 		close $xmltrace;