521 lines
8.3 KiB
Perl
521 lines
8.3 KiB
Perl
#! /usr/bin/env perl
|
|
|
|
package Trace;
|
|
|
|
use v5.10.1;
|
|
use strict;
|
|
use warnings;
|
|
use Carp;
|
|
use utf8;
|
|
use open qw(:encoding(UTF-8) :std);
|
|
use XML::LibXML;
|
|
|
|
use ACU::Log;
|
|
|
|
sub new
|
|
{
|
|
my $class = shift;
|
|
my $self = {
|
|
infos => {},
|
|
groups => [],
|
|
};
|
|
|
|
bless $self, $class;
|
|
if ($#_ >= 0) {
|
|
$self->_initialize(@_);
|
|
}
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub _initialize ($$)
|
|
{
|
|
my $self = shift;
|
|
|
|
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;
|
|
}
|
|
|
|
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 ($)
|
|
{
|
|
my $self = shift;
|
|
return $self->{version};
|
|
}
|
|
|
|
sub getType ($)
|
|
{
|
|
my $self = shift;
|
|
return $self->{type};
|
|
}
|
|
|
|
sub getInfo ($$)
|
|
{
|
|
my $self = shift;
|
|
return $self->{infos}{$_[0]};
|
|
}
|
|
|
|
sub getInfos ($)
|
|
{
|
|
my $self = shift;
|
|
return $self->{infos};
|
|
}
|
|
|
|
sub addId
|
|
{
|
|
my $self = shift;
|
|
my $key = shift;
|
|
my $value = shift;
|
|
|
|
my $e = Trace::Eval->new($key);
|
|
$e->addValue(undef, $value);
|
|
push @{ $self->{groups} }, $e;
|
|
|
|
return $e;
|
|
}
|
|
|
|
sub delId
|
|
{
|
|
my $self = shift;
|
|
my $key = shift;
|
|
my $value = shift;
|
|
|
|
foreach my $group (@{ $self->{groups} })
|
|
{
|
|
if ($group->{id} eq $key)
|
|
{
|
|
if (!$value || $value == $group->getValue())
|
|
{
|
|
$self->{groups} = [ grep { $_->{id} ne $key } @{ $self->{groups} } ];
|
|
}
|
|
last;
|
|
}
|
|
|
|
$group->delId($key, $value);
|
|
}
|
|
}
|
|
|
|
sub getIds
|
|
{
|
|
my $self = shift;
|
|
my $login = shift;
|
|
my $onlyNonZero = shift // 0;
|
|
|
|
my %ids;
|
|
foreach my $group (@{ $self->{groups} })
|
|
{
|
|
my %tmp;
|
|
if ($self->{type} eq "defense")
|
|
{
|
|
# For a defense, we consider that this is a group grade, so don't consider login filtering
|
|
%tmp = $group->getIds();
|
|
} else {
|
|
%tmp = $group->getIds($login);
|
|
}
|
|
|
|
while (my ($key, $value) = each %tmp)
|
|
{
|
|
$ids{$key} = $value if !$onlyNonZero || $value;
|
|
}
|
|
}
|
|
return \%ids;
|
|
}
|
|
|
|
sub getNonZeroIds
|
|
{
|
|
return getIds($_[0], $_[1], 1);
|
|
}
|
|
|
|
sub getValue
|
|
{
|
|
my $self = shift;
|
|
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->getWhos()->{$_[0]};
|
|
}
|
|
|
|
sub getFirstWho ($)
|
|
{
|
|
my $self = shift;
|
|
return $self->getWhos()->{def1_end_group};
|
|
}
|
|
|
|
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;
|
|
}
|
|
|
|
sub toString ($)
|
|
{
|
|
my $self = shift;
|
|
|
|
my $doc = XML::LibXML::Document->new('1.0');
|
|
|
|
my $root = $doc->createElement("trace");
|
|
|
|
foreach my $group (@{ $self->{groups} })
|
|
{
|
|
$root->appendChild( $group->toString($doc) );
|
|
}
|
|
|
|
$doc->setDocumentElement( $root );
|
|
|
|
return $doc->toString();
|
|
}
|
|
|
|
|
|
package Trace::Group;
|
|
|
|
use v5.10.1;
|
|
use strict;
|
|
use warnings;
|
|
use Carp;
|
|
|
|
use ACU::Log;
|
|
|
|
sub new ($$)
|
|
{
|
|
my $class = shift;
|
|
my $self = {
|
|
id => shift,
|
|
name => shift,
|
|
groups => []
|
|
};
|
|
|
|
bless $self, $class;
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub append ($@)
|
|
{
|
|
my $self = shift;
|
|
|
|
push @{ $self->{groups} }, @_;
|
|
}
|
|
|
|
sub delId
|
|
{
|
|
my $self = shift;
|
|
my $key = shift;
|
|
my $value = shift;
|
|
|
|
foreach my $group (@{ $self->{groups} })
|
|
{
|
|
if ($group->{id} eq $key)
|
|
{
|
|
if (!$value || $value == $group->getValue())
|
|
{
|
|
$self->{groups} = \{ grep { $_->{id} ne $key } @{ $self->{groups} } };
|
|
}
|
|
last;
|
|
}
|
|
|
|
$group->delId($key, $value);
|
|
}
|
|
}
|
|
|
|
sub getIds
|
|
{
|
|
my $self = shift;
|
|
my $login = shift;
|
|
|
|
my %ids;
|
|
foreach my $group (@{ $self->{groups} })
|
|
{
|
|
my %tmp = $group->getIds($login);
|
|
while (my ($key, $value) = each %tmp)
|
|
{
|
|
$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;
|
|
}
|
|
|
|
sub toString($$)
|
|
{
|
|
my $self = shift;
|
|
my $doc = shift;
|
|
|
|
my $gr = $doc->createElement("group");
|
|
|
|
foreach my $item (@{ $self->{groups} })
|
|
{
|
|
$gr->appendChild( $item->toString() );
|
|
}
|
|
|
|
return $gr;
|
|
}
|
|
|
|
|
|
package Trace::Eval;
|
|
|
|
use v5.10.1;
|
|
use strict;
|
|
use warnings;
|
|
use Carp;
|
|
|
|
use ACU::Log;
|
|
|
|
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")
|
|
{
|
|
$self->addValue($node->getAttribute("id"),
|
|
$val);
|
|
}
|
|
elsif ($node->nodeName eq "name")
|
|
{
|
|
$self->{name} = $val;
|
|
}
|
|
elsif ($node->nodeName eq "status")
|
|
{
|
|
$self->{status} = $val;
|
|
}
|
|
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"
|
|
};
|
|
}
|
|
}
|
|
}
|
|
|
|
sub delId
|
|
{
|
|
# Do nothing here, just an abstract method
|
|
}
|
|
|
|
sub changeWho
|
|
{
|
|
my $self = shift;
|
|
|
|
$self->{who} = {
|
|
login => shift,
|
|
type => shift // "login"
|
|
};
|
|
}
|
|
|
|
sub getIds
|
|
{
|
|
my $self = shift;
|
|
my $login = shift;
|
|
|
|
my %ids;
|
|
if (!$login || !exists $self->{who} || $self->{who}{type} eq "group" || $self->{who}{login} eq $login)
|
|
{
|
|
while (my ($key, $value) = each %{ $self->{values} })
|
|
{
|
|
$ids{$key} = $value if ($key);
|
|
}
|
|
|
|
$ids{ $self->{id} } = $self->getValue($self->{id}, $login);
|
|
}
|
|
|
|
return %ids;
|
|
}
|
|
|
|
sub addValue
|
|
{
|
|
my $self = shift;
|
|
my $key = shift // "";
|
|
my $val = shift;
|
|
|
|
$self->{values}{ $key } = 0 if (!exists $self->{values}{ $key });
|
|
$self->{values}{ $key } += $val;
|
|
}
|
|
|
|
sub getValue
|
|
{
|
|
my $self = shift;
|
|
my $id = shift // $self->{id};
|
|
my $login = shift;
|
|
|
|
my $value = 0;
|
|
if (!$login || !exists $self->{who} || $self->{who}{type} eq "group" || $self->{who}{login} eq $login)
|
|
{
|
|
foreach my $key (keys %{ $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} };
|
|
}
|
|
|
|
sub toString($$)
|
|
{
|
|
my $self = shift;
|
|
my $doc = shift;
|
|
|
|
my $e = $doc->createElement("eval");
|
|
|
|
$e->setAttribute("id", $self->{id});
|
|
$e->setAttribute("type", $self->{type});
|
|
|
|
if (defined $self->{who})
|
|
{
|
|
my $w = $doc->createElement("who");
|
|
$w->setAttribute("type", $self->{who}{type}) if (defined $self->{who}{type});
|
|
$w->appendTextNode( $self->{who}{login} );
|
|
$e->appendChild( $w );
|
|
}
|
|
|
|
for my $k (keys %{ $self->{values} })
|
|
{
|
|
my $v = $doc->createElement("value");
|
|
$v->setAttribute("id", $k) if ($k);
|
|
$v->appendTextNode( $self->{values}{$k} );
|
|
$e->appendChild( $v );
|
|
}
|
|
|
|
return $e;
|
|
}
|
|
|
|
1;
|