package IMPL::Serialization::XmlObjectWriter;
use strict;

use parent qw(IMPL::Object);
use IMPL::Class::Property;
use IMPL::Class::Property::Direct;

use IMPL::Serialization;
use XML::Writer;
use IMPL::Exception;

sub CONTAINER_EMPTY () { 1 }
sub CONTAINER_NORMAL () { 2 }

BEGIN {
  public _direct property Encoding => prop_all;
  public _direct property hOutput => prop_all;
  public _direct property IdentOutput => prop_all;
  
  private _direct property CurrentObject => prop_all;
  private _direct property ObjectPath => prop_all;
  private _direct property XmlWriter => prop_all;
  private _direct property IdentLevel => prop_all;
  private _direct property IdentNextTag => prop_all;
}

sub new {
  my $class = shift;
  my $self = bless {}, ref($class) || $class;
  $self->CTOR(@_);
  return $self;
}

sub CTOR {
  my $this = shift;
  my %args = @_;
  $this->{$hOutput} = $args{'hOutput'};
  $this->{$Encoding} = $args{'Encoding'};
  $this->{$CurrentObject} = undef;
  $this->{$IdentOutput} = $args{'IdentOutput'};
  $this->{$IdentLevel} = 0;
  $this->{$IdentNextTag} = 0;
  #$this->{$ObjectPath} = [];
  return 1;
}

sub BeginObject {
  my $this = shift;
  my %args = @_;
  
  if (not $this->{$CurrentObject}) {
    my $xmlWriter = new XML::Writer(OUTPUT => $this->{$hOutput}, ENCODING => $this->{$Encoding});
    $this->{$XmlWriter} = $xmlWriter;
    $xmlWriter->xmlDecl();
  }
  
  push @{$this->{$ObjectPath}},$this->{$CurrentObject} if $this->{$CurrentObject};
  
  my %ObjectProperties = %args;
  delete $ObjectProperties{'name'};
  delete $args{'container_type'};

  $this->{$CurrentObject} = \%ObjectProperties;

  my $tagname;  
  if (_CheckName($args{'name'})) {
    $tagname = $args{'name'};
  } else {
    $tagname = 'element';
    $ObjectProperties{'extname'} = $args{'name'};
  }
  
  if ($args{'refid'}) {
    $this->{$XmlWriter}->characters("\n" . ('  ' x $$this{$IdentLevel}) ) if $$this{$IdentNextTag};
    $this->{$XmlWriter}->emptyTag($tagname,%ObjectProperties);
    $ObjectProperties{'container_type'} = CONTAINER_EMPTY;
  } else {
    $this->{$XmlWriter}->characters("\n" . ('  ' x $$this{$IdentLevel}) ) if $$this{$IdentNextTag};
    $this->{$XmlWriter}->startTag($tagname,%ObjectProperties);
    $ObjectProperties{'container_type'} = CONTAINER_NORMAL;
  }
  
  $this->{$IdentLevel} ++;
  $this->{$IdentNextTag} = $this->{$IdentOutput};
  
  return 1;
}

sub EndObject {
  my $this = shift;
  
  my $hCurrentObject = $this->{$CurrentObject} or return 0;
  
  $this->{$IdentLevel} --;
    
  if ( $hCurrentObject->{'container_type'} != CONTAINER_EMPTY ) {
    $this->{$XmlWriter}->characters("\n" . ('  ' x $$this{$IdentLevel}) ) if $$this{$IdentNextTag};
    $this->{$XmlWriter}->endTag();
  }
  
  $this->{$IdentNextTag} = $this->{$IdentOutput};
  
  $this->{$CurrentObject} = pop @{$this->{$ObjectPath}} if exists $this->{$ObjectPath};
  $this->{$XmlWriter} = undef if (not $this->{$CurrentObject});
  
  return 1;
}

sub SetData {
  my $this = shift;
  #my $hCurrentObject = $this->{$CurrentObject} or return 0;
  
  if ($this->{$CurrentObject}->{'container_type'} == CONTAINER_NORMAL) {
    $this->{$XmlWriter}->characters($_[0]) if defined $_[0];
    $this->{$IdentNextTag} = 0;
    return 1;
  } else {
    return 0;
  }
}

sub _CheckName {
  return 0 if not $_[0];
  return $_[0] =~ /^(_|\w|\d)+$/;
}

package IMPL::Serialization::XmlObjectReader;
use parent qw(XML::Parser);

sub new {
  my $class = shift;
  my %args = @_;
  die new Exception("Handler parameter is reqired") if not $args{'Handler'};
  die new Exception("Handler parameter must be a reference") if not ref $args{'Handler'};
  
  #my $this = $class->SUPER::new(Style => 'Stream', Pkg => 'Serialization::XmlObjectReader', 'Non-Expat-Options' => {hInput => $args{'hInput'} , Handler => $args{'Handler'}, SkipWhitespace => $args{'SkipWhitespace'} } );
  my $this = $class->SUPER::new(Handlers => { Start => \&StartTag, End => \&EndTag, Char => \&Text} , 'Non-Expat-Options' => {hInput => $args{'hInput'} , Handler => $args{'Handler'}, SkipWhitespace => $args{'SkipWhitespace'} } );
  return $this;
}

sub Parse {
  my $this = shift;
  $this->parse($this->{'Non-Expat-Options'}->{'hInput'});
  return 1;
}

sub StartTag {
  my $this = shift;
  my $name = shift;
  my %Attr = @_;
  $name = $Attr{'extname'} if defined $Attr{'extname'};
  $this->{'Non-Expat-Options'}->{'Handler'}->OnObjectBegin($name,\%Attr);
  return 1;
}

sub EndTag {
  my ($this,$name) = @_;
  $this->{'Non-Expat-Options'}->{'Handler'}->OnObjectEnd($name);
  return 1;
}

sub Text {
  my ($this) = shift;
  my $text = shift;
  return 1 if $this->{'Non-Expat-Options'}->{'SkipWhitespace'} and $text =~ /^\n*\s*\n*$/;
  $this->{'Non-Expat-Options'}->{'Handler'}->OnObjectData($text);
  return 1;
}

package IMPL::Serialization::XmlFormatter;
use parent qw(IMPL::Object);

use IMPL::Class::Property;
use IMPL::Class::Property::Direct;

BEGIN {
  public _direct property Encoding => prop_all;
  public _direct property SkipWhitespace => prop_all;
  public _direct property IdentOutput => prop_all;
}

sub CTOR {
  my ($this,%args) = @_;
  
  $this->Encoding($args{'Encoding'} || 'utf-8');
  $this->SkipWhitespace($args{'SkipWhitespace'});
  $this->IdentOutput($args{'IdentOutput'});
  
  return 1;
}

sub CreateWriter {
  my ($this,$hStream) = @_;
  return new IMPL::Serialization::XmlObjectWriter(Encoding =>$this->Encoding() , hOutput => $hStream, IdentOutput => $this->IdentOutput());
}

sub CreateReader {
  my ($this,$hStream,$refHandler) = @_;
  return new IMPL::Serialization::XmlObjectReader(hInput => $hStream, Handler => $refHandler, SkipWhitespace => $this->SkipWhitespace());
}

1;