ACU/ACU/Trace.pm

#! /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 XML::SAX::ParserFactory;

sub new
{
    my $class = shift;
    my $self = {
	ids => {},
	infos => {},
	comments => {},
	who => {},
    };

    bless $self, $class;
    if ($#_ >= 0) {
	$self->_initialize(@_);
    }

    return $self;
}

sub _initialize ($$)
{
    my $self = shift;

    my $sax_handler = TraceHandler->new($self);
    my $parser = XML::SAX::ParserFactory->parser( Handler => $sax_handler );

    $parser->parse_file(shift);
}

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 getComment ($$)
{
    my $self = shift;
    return $self->{comments}{$_[0]};
}

sub getComments ($)
{
    my $self = shift;
    return $self->{comments};
}

sub getWho ($$)
{
    my $self = shift;
    return $self->{who}{$_[0]};
}

sub getFirstWho ($)
{
    my $self = shift;

    return $self->{who}{def1_end_group};
}

sub getWhos ($)
{
    my $self = shift;
    return $self->{who};
}

sub getValue ($$)
{
    my $self = shift;
    return $self->{ids}{$_[0]};
}

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 toString ($;$)
{
    my $self = shift;
    my $main_grp = shift // "bonus_malus";

    my $doc = XML::LibXML::Document->new('1.0');

    my $root = $doc->createElement("trace");

    my $group = $doc->createElement("group");
    $group->addChild( $doc->createAttribute("id", $main_grp) );

    for my $k (keys %{ $self->{ids} }) {
	my $e = $doc->createElement("eval");
	my $v = $doc->createElement("value");

	$e->addChild( $doc->createAttribute("id", $k) );
	$v->appendText( $self->{ids}{$k} );

	$e->appendChild( $v );
	$group->appendChild( $e );
    }

    $root->appendChild( $group );
    $doc->setDocumentElement( $root );

    return $doc->toString();
}


package TraceHandler;

use Carp;
use constant NO_ID_VALUE => "__#";

sub new ($$)
{
    my $class = shift;
    my $self = {
	groups => [],
	parsed => shift,
	inComment => "",
	inEval => "",
	inInfo => "",
	inValue => "",
	inWho => "",
	values => ""
    };

    bless $self, $class;

    return $self;
}

sub start_element
{
    my ($self, $element) = @_;

    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};
    }
}

sub characters
{
    my ($self, $characters) = @_;

    if ($self->{inValue} || $self->{inInfo} || $self->{inComment} || $self->{inWho}) {
	$self->{values} .= $characters->{Data};
    }
}

sub end_element
{
    my ($self, $element) = @_;

    if ($element->{Name} eq "value")
    {
	if ($self->{values} =~ /(-?[0-9]+(.[0-9]+)?)/)
	{
	    $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;
	    }
	}
	$self->{inValue} = "";
    }
    elsif ($element->{Name} eq "eval")
    {
	#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 ($element->{Name} eq "who")
    {
	if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) {
	    $self->{parsed}{who}{ $self->{inWho} } = $1;
	}
	$self->{inComment} = "";
    }
    elsif ($element->{Name} eq "info")
    {
	if ($self->{values} =~ /([^\s].*[^\s]|[^\s])/) {
	    $self->{parsed}{infos}{ $self->{inInfo} } = $1;
	}
	$self->{inInfo} = "";
    }
    elsif ($element->{Name} eq "group")
    {
	pop @{ $self->{groups} };
    }
}

1;