Defense XML parser

ACU/Defense.pm

@@ -0,0 +1,118 @@
+#! /usr/bin/env perl
+
+package Defense;
+
+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;
+
+use ACU::Log;
+
+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 = DefenseHandler->new($self);
+    my $parser = XML::SAX::ParserFactory->parser( Handler => $sax_handler );
+
+    $parser->parse_file(shift);
+}
+
+sub getVersion ($)
+{
+    my $self = shift;
+    return $self->{version};
+}
+
+sub getIds ($)
+{
+    my $self = shift;
+    return $self->{ids};
+}
+
+
+package DefenseHandler;
+
+use Carp;
+use constant NO_ID_VALUE => "__#";
+
+use ACU::Log;
+
+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 "defense") {
+	$self->{parsed}{version} = $element->{Attributes}{"{}version"}{Value};
+	$self->{parsed}{duration} = $element->{Attributes}{"{}duration"}{Value};
+    }
+    elsif ($element->{Name} eq "question") {
+	if ($element->{Attributes}{"{}id"}{Value}) {
+	    $self->{parsed}{ids}{ $element->{Attributes}{"{}id"}{Value} } = 0;
+	}
+	else {
+	    log WARN, "Question without ID!";
+	}
+    }
+    elsif ($element->{Name} eq "answer") {
+	if ($element->{Attributes}{"{}id"}{Value}) {
+	    $self->{parsed}{ids}{ $element->{Attributes}{"{}id"}{Value} } = $element->{Attributes}{"{}value"}{Value} // $element->{Attributes}{"{}mark"}{Value} // 0;
+	}
+	else {
+	    log WARN, "Answer without ID!";
+	}
+    }
+    elsif ($element->{Name} ne "group" && $element->{Name} ne "ask" && $element->{Name} ne "answer" && $element->{Name} ne "explanation") {
+	croak "Not a valid defense XML: unknown tag ".$element->{Name};
+    }
+}
+
+sub characters
+{
+    my ($self, $characters) = @_;
+
+    if ($self->{inValue} || $self->{inInfo} || $self->{inComment} || $self->{inWho}) {
+	$self->{values} .= $characters->{Data};
+    }
+}
+
+1;