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


package TraceHandler;

use constant NO_ID_VALUE => "__#";

sub new ($$)
{
    my $class = shift;
    my $self = {
	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} = "";
    }
}

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) {
		$self->{parsed}{ids}{ $self->{inValue} } = $1;
	    }
	}
	$self->{inValue} = "";
    }
    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} = "";
    }
}

1;