package Test::Valgrind::Parser::XML::Twig;

use strict;
use warnings;

our $VERSION = '1.02';

use Scalar::Util ();

use base qw/XML::Twig Test::Valgrind::Carp/;

BEGIN { XML::Twig->add_options('Stash'); }

my %handlers = (
 '/valgrindoutput/error' => \&handle_error,
);

sub new {
 my $class = shift;
 $class = ref($class) || $class;

 my %args = @_;
 my $stash = delete $args{stash} || { };

 my $tool = delete $args{tool};
 $class->_croak('Invalid tool') unless Scalar::Util::blessed($tool)
                                         and $tool->isa('Test::Valgrind::Tool');
 $stash->{tool} = $tool;

 bless $class->XML::Twig::new(
  elt_class     => __PACKAGE__ . '::Elt',
  stash         => $stash,
  twig_roots    => { map { $_ => 1             } keys %handlers },
  twig_handlers => { map { $_ => $handlers{$_} } keys %handlers },
 ), $class;
}

sub stash { shift->{Stash} }

sub handle_error {
 my ($twig, $node) = @_;

 my $id   = $node->kid('unique')->text;
 my $kind = $node->kid('kind')->text;

 my $data;

 $data->{what}  = $node->kid('what')->text;
 $data->{stack} = [ map $_->listify_frame,
                                       $node->kid('stack')->children('frame') ];

 for (qw/leakedbytes leakedblocks/) {
  my $kid = $node->first_child($_);
  next unless $kid;
  $data->{$_} = int $kid->text;
 }

 if (my $auxwhat = $node->first_child('auxwhat')) {
  if (my $stack = $auxwhat->next_sibling('stack')) {
   $data->{auxstack} = [ map $_->listify_frame, $stack->children('frame') ];
  }
  $data->{auxwhat} = $auxwhat->text;
 }

 if (my $origin = $node->first_child('origin')) {
  $data->{origwhat}  = $origin->kid('what')->text;
  $data->{origstack} = [ map $_->listify_frame,
                                     $origin->kid('stack')->children('frame') ];
 }

 my $tool = $twig->stash->{tool};
 my $sess = $tool->_session;

 $sess->report($tool->report_class($sess)->new(
  kind => $kind,
  id   => $id,
  data => $data,
 ));

 $twig->purge;
}

# End of Test::Valgrind::Parser::XML::Twig

package Test::Valgrind::Parser::XML::Twig::Elt;

our $VERSION = '1.02';

BEGIN { require XML::Twig; }

use base qw/XML::Twig::Elt Test::Valgrind::Carp/;

sub kid {
 my ($self, $what) = @_;
 my $node = $self->first_child($what);
 $self->_croak("Couldn't get first $what child node") unless $node;
 return $node;
}

sub listify_frame {
 my ($frame) = @_;

 return unless $frame->tag eq 'frame';

 return [
  map {
   my $x = $frame->first_child($_);
   $x ? $x->text : undef
  } qw/ip obj fn dir file line/
 ];
}

1; # End of Test::Valgrind::Parser::XML::Twig::Elt
