diff --git a/ACU/Grading.pm b/ACU/Grading.pm index b01693c..7db43cb 100644 --- a/ACU/Grading.pm +++ b/ACU/Grading.pm @@ -111,7 +111,7 @@ sub insert ($$$) $self->{ids}{$_[0]} = $_[1]; } -sub fill ($$) +sub fill { my $self = shift; my $ids = shift; diff --git a/ACU/Trace.pm b/ACU/Trace.pm index fba6621..e4ae66e 100644 --- a/ACU/Trace.pm +++ b/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 => {}, - who => {}, + groups => [], }; bless $self, $class; @@ -33,10 +30,47 @@ sub _initialize ($$) { my $self = shift; - my $sax_handler = TraceHandler->new($self); - my $parser = XML::SAX::ParserFactory->parser( Handler => $sax_handler ); + my $dom = XML::LibXML->load_xml(string => shift); + $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->{who}{def1_end_group}; + return $self->getWhos()->{def1_end_group}; } -sub getWhos ($) +sub getWhos { my $self = shift; - return $self->{who}; -} + my $ret = {}; -sub getValue ($$) -{ - my $self = shift; - return $self->{ids}{$_[0]}; -} + foreach my $group (@{ $self->{groups} }) + { + my $whos = $group->getWhos(); + foreach my $who (keys %{ $whos }) { + $ret->{ $who } = $whos->{$who}; + } + } -sub getIds ($) -{ - 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}; + return $ret; } 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 => [], - parsed => shift, - inComment => "", - inEval => "", - inInfo => "", - inValue => "", - inWho => "", - values => "" + id => shift, + name => shift, + groups => [] }; 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") { - $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}; - } + push @{ $self->{groups} }, @_; } -sub characters +sub getIds { - my ($self, $characters) = @_; + my $self = shift; + my $login = shift; - if ($self->{inValue} || $self->{inInfo} || $self->{inComment} || $self->{inWho}) { - $self->{values} .= $characters->{Data}; - } -} - -sub end_element -{ - my ($self, $element) = @_; - - if ($element->{Name} eq "value") + my %ids; + foreach my $group (@{ $self->{groups} }) { - if ($self->{values} =~ /([-+]?[0-9]+(.[0-9]+)?)/) + my %tmp = $group->getIds($login); + while (($key, $value) = each %tmp) { - $self->{parsed}{ids}{ $self->{inEval} } += $1; - if ($self->{inValue} ne NO_ID_VALUE and $1) { - $self->{parsed}{ids}{ $self->{inValue} } = $1; - } - if ($self->{groups}) { - my $key = @{ $self->{groups} }[$#{ $self->{groups} }]; - $self->{parsed}{ids}{ $key } += $1; + %ids{$key} = $value; + } + } + + %ids{ $self->{id} } = $self->getValue($self->{id}, $login); + + 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 ($element->{Name} eq "eval") - { - # 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; + elsif ($node->nodeName eq "name") + { + $self->{name} = $val; } - $self->{inComment} = ""; - } - elsif ($element->{Name} eq "who") - { - if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) { - $self->{parsed}{who}{ $self->{inWho} } = $1; + elsif ($node->nodeName eq "status") + { + $self->{status} = $val; } - $self->{inComment} = ""; - } - elsif ($element->{Name} eq "info") - { - if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) { - $self->{parsed}{infos}{ $self->{inInfo} } = $1; + elsif ($node->nodeName eq "log") + { + my $key = $node->getAttribute("type") // "stdout"; + + $self->{logs}{ $key } = $val; + } + 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} }; - # Remove empty identifier - delete $self->{parsed}{ids}{ $key } if ($key && !$self->{parsed}{ids}{ $key }); + while (my ($key, $value) = each %{ $self->{who}{values} }) + { + %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; diff --git a/process/files/intradata_get.pl b/process/files/intradata_get.pl index c1f58e0..bbf7d1c 100644 --- a/process/files/intradata_get.pl +++ b/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;