#!/usr/bin/perl
use strict;
use warnings;
use XML::Parser;
use Data::Dumper;
use IO::File;

my $file='test.out.xml';

my $tree={
    type       => 'root',
    name       => 'root',
    values     =>{},
    line_start => 0,
    line_end   => 0,
    childs     => [],
};
my @deep=($tree);

my $xmlp = XML::Parser->new( Handlers =>
  {
    # Datei öffenen beim starten des Parsens
    Init  => sub{
      my $parser=shift;
      # den Dateinamen aus dem Parser-Objekt holen
      my $fh = IO::File->new($parser->{Base}, 'r') or die( "Error open $parser->{Base} ($!)\n" );
      # einen Eintrag im Parser für das Filehandle machen
      $parser->{__MY__FH__}={fh => $fh, lastline=>$fh->getline()};
    },

    # tag start
    Start => sub{
      my $parser=shift;
      my $name=shift;
      my %values=@_;
      my $line=test_line($parser->{__MY__FH__},"<$name");

      my $element={
          type       => 'tag',
          name       => $name,
          values     => \%values,
          line_start => $line,
          line_end   => $line,
          childs     => [],
        };
      push(@{$deep[-1]->{childs}},$element);
      push(@deep,$element);
    },

    # tag end
    End   => sub{
      my $parser=shift;
      my $name=shift;
      my $line=test_line($parser->{__MY__FH__},">");

      if(@deep > 1)
      {
        my $element=pop(@deep);
        $element->{line_end}=$line;
      }
    },

    # Strings zwischen tags
    Char  => sub{
      my $parser=shift;
      my $string=shift;

      # an vorhandenen String anhängen
      if(@{$deep[-1]->{childs}} && $deep[-1]->{childs}->[-1]->{type} eq 'char')
      {
        $deep[-1]->{childs}->[-1]->{childs}.=$string;
        return;
      }

      # ignoriere "\n" und leere Zeilen
      if($string=~/\s*/s)
      {
        if(@{$deep[-1]->{childs}} && $deep[-1]->{childs}->[-1]->{type} eq 'char')
        { $deep[-1]->{childs}->[-1]->{line_end}++ while($string=~/[\x0a\x0d]/gc); }
        return;
      }

      my $line=test_line($parser->{__MY__FH__},$string);
      my $element={
          type       => 'char',
          name       => '',
          values     =>{},
          line_start => $line,
          line_end   => $line,
          childs     => $string
        };
      push(@{$deep[-1]->{childs}},$element);
    },
  });

$xmlp->parsefile($file);

print Dumper($tree);

########################################################################

sub test_line
{
  my $fh=shift;
  my $string=shift;

  my $line=-1;

  # ist es in der letzten gelesenen Zeile?
  my $pos=index($fh->{lastline},$string);
  my $tell=$fh->{fh}->tell();
  if($pos >= 0)
  {
    # schon gefundenes löschen
    substr($fh->{lastline},0,$pos+length($string),'');
    #aktuelle Zeilennummer
    $line=$fh->{fh}->input_line_number();
  }
  else
  {
    # Datei weiter einlesen bis gefunden
    while($fh->{lastline}=$fh->{fh}->getline())
    {
      my $pos=index($fh->{lastline},$string);
      if($pos >= 0)
      {
        # schon gefundenes löschen
        substr($fh->{lastline},0,$pos+length($string),'');
        #aktuelle Zeilennummer
        $line=$fh->{fh}->input_line_number();
        last;
      }
    }
  }

  # zurück zu letzer position wenn nicht gefunden
  $fh->{fh}->seek($tell,0) if($line == -1);

  return $line;
}