--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Serialization/XmlFormatter.pm	Tue Jul 14 12:54:37 2009 +0400
@@ -0,0 +1,202 @@
+package IMPL::Serialization::XmlObjectWriter;
+use strict;
+
+use base 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 base 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;
+  $_ = shift;
+  return 1 if $this->{'Non-Expat-Options'}->{'SkipWhitespace'} and /^\n*\s*\n*$/;
+  $this->{'Non-Expat-Options'}->{'Handler'}->OnObjectData($_);
+  return 1;
+}
+
+package IMPL::Serialization::XmlFormatter;
+use base 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;
\ No newline at end of file