Mercurial > pub > Impl
view Lib/IMPL/Serialization/XmlFormatter.pm @ 84:e568c7c8b743
Minor changes to the test infrastructure
author | wizard |
---|---|
date | Wed, 14 Apr 2010 17:38:11 +0400 |
parents | 16ada169ca75 |
children | dc1da0389db7 |
line wrap: on
line source
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;