Mercurial > pub > Impl
view Lib/IMPL/Serialization/XmlFormatter.pm @ 245:7c517134c42f
Added Unsupported media type Web exception
corrected resourceLocation setting in the resource
Implemented localizable resources for text messages
fixed TT view scopings, INIT block in controls now sets globals correctly.
author | sergey |
---|---|
date | Mon, 29 Oct 2012 03:15:22 +0400 |
parents | 4267a2ac3d46 |
children | 4ddb27ff4a0b |
line wrap: on
line source
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;