Mercurial > pub > Impl

comparison lib/IMPL/Serialization/XmlFormatter.pm @ 407:c6e90e02dd17 ref20150831

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
renamed Lib->lib
author cin
date Fri, 04 Sep 2015 19:40:23 +0300
parents
children
comparison
equal deleted inserted replaced
406:f23fcb19d3c1 407:c6e90e02dd17
1 package IMPL::Serialization::XmlObjectWriter;
2 use strict;
3
4 use parent qw(IMPL::Object);
5 use IMPL::Class::Property;
6
7 use IMPL::Serialization;
8 use XML::Writer;
9 use IMPL::Exception;
10
11 sub CONTAINER_EMPTY () { 1 }
12 sub CONTAINER_NORMAL () { 2 }
13
14 BEGIN {
15 public _direct property Encoding => prop_all;
16 public _direct property hOutput => prop_all;
17 public _direct property IdentOutput => prop_all;
18
19 private _direct property CurrentObject => prop_all;
20 private _direct property ObjectPath => prop_all;
21 private _direct property XmlWriter => prop_all;
22 private _direct property IdentLevel => prop_all;
23 private _direct property IdentNextTag => prop_all;
24 }
25
26 sub new {
27 my $class = shift;
28 my $self = bless {}, ref($class) || $class;
29 $self->CTOR(@_);
30 return $self;
31 }
32
33 sub CTOR {
34 my $this = shift;
35 my %args = @_;
36 $this->{$hOutput} = $args{'hOutput'};
37 $this->{$Encoding} = $args{'Encoding'};
38 $this->{$CurrentObject} = undef;
39 $this->{$IdentOutput} = $args{'IdentOutput'};
40 $this->{$IdentLevel} = 0;
41 $this->{$IdentNextTag} = 0;
42 #$this->{$ObjectPath} = [];
43 return 1;
44 }
45
46 sub BeginObject {
47 my $this = shift;
48 my %args = @_;
49
50 if (not $this->{$CurrentObject}) {
51 my $xmlWriter = new XML::Writer(OUTPUT => $this->{$hOutput}, ENCODING => $this->{$Encoding});
52 $this->{$XmlWriter} = $xmlWriter;
53 $xmlWriter->xmlDecl();
54 }
55
56 push @{$this->{$ObjectPath}},$this->{$CurrentObject} if $this->{$CurrentObject};
57
58 my %ObjectProperties = %args;
59 delete $ObjectProperties{'name'};
60 delete $args{'container_type'};
61
62 $this->{$CurrentObject} = \%ObjectProperties;
63
64 my $tagname;
65 if (_CheckName($args{'name'})) {
66 $tagname = $args{'name'};
67 } else {
68 $tagname = 'element';
69 $ObjectProperties{'extname'} = $args{'name'};
70 }
71
72 if ($args{'refid'}) {
73 $this->{$XmlWriter}->characters("\n" . (' ' x $$this{$IdentLevel}) ) if $$this{$IdentNextTag};
74 $this->{$XmlWriter}->emptyTag($tagname,%ObjectProperties);
75 $ObjectProperties{'container_type'} = CONTAINER_EMPTY;
76 } else {
77 $this->{$XmlWriter}->characters("\n" . (' ' x $$this{$IdentLevel}) ) if $$this{$IdentNextTag};
78 $this->{$XmlWriter}->startTag($tagname,%ObjectProperties);
79 $ObjectProperties{'container_type'} = CONTAINER_NORMAL;
80 }
81
82 $this->{$IdentLevel} ++;
83 $this->{$IdentNextTag} = $this->{$IdentOutput};
84
85 return 1;
86 }
87
88 sub EndObject {
89 my $this = shift;
90
91 my $hCurrentObject = $this->{$CurrentObject} or return 0;
92
93 $this->{$IdentLevel} --;
94
95 if ( $hCurrentObject->{'container_type'} != CONTAINER_EMPTY ) {
96 $this->{$XmlWriter}->characters("\n" . (' ' x $$this{$IdentLevel}) ) if $$this{$IdentNextTag};
97 $this->{$XmlWriter}->endTag();
98 }
99
100 $this->{$IdentNextTag} = $this->{$IdentOutput};
101
102 $this->{$CurrentObject} = pop @{$this->{$ObjectPath}} if exists $this->{$ObjectPath};
103 $this->{$XmlWriter} = undef if (not $this->{$CurrentObject});
104
105 return 1;
106 }
107
108 sub SetData {
109 my $this = shift;
110 #my $hCurrentObject = $this->{$CurrentObject} or return 0;
111
112 if ($this->{$CurrentObject}->{'container_type'} == CONTAINER_NORMAL) {
113 $this->{$XmlWriter}->characters($_[0]) if defined $_[0];
114 $this->{$IdentNextTag} = 0;
115 return 1;
116 } else {
117 return 0;
118 }
119 }
120
121 sub _CheckName {
122 return 0 if not $_[0];
123 return $_[0] =~ /^(_|\w|\d)+$/;
124 }
125
126 package IMPL::Serialization::XmlObjectReader;
127 use parent qw(XML::Parser);
128
129 sub new {
130 my $class = shift;
131 my %args = @_;
132 die new Exception("Handler parameter is reqired") if not $args{'Handler'};
133 die new Exception("Handler parameter must be a reference") if not ref $args{'Handler'};
134
135 #my $this = $class->SUPER::new(Style => 'Stream', Pkg => 'Serialization::XmlObjectReader', 'Non-Expat-Options' => {hInput => $args{'hInput'} , Handler => $args{'Handler'}, SkipWhitespace => $args{'SkipWhitespace'} } );
136 my $this = $class->SUPER::new(Handlers => { Start => \&StartTag, End => \&EndTag, Char => \&Text} , 'Non-Expat-Options' => {hInput => $args{'hInput'} , Handler => $args{'Handler'}, SkipWhitespace => $args{'SkipWhitespace'} } );
137 return $this;
138 }
139
140 sub Parse {
141 my $this = shift;
142 $this->parse($this->{'Non-Expat-Options'}->{'hInput'});
143 return 1;
144 }
145
146 sub StartTag {
147 my $this = shift;
148 my $name = shift;
149 my %Attr = @_;
150 $name = $Attr{'extname'} if defined $Attr{'extname'};
151 $this->{'Non-Expat-Options'}->{'Handler'}->OnObjectBegin($name,\%Attr);
152 return 1;
153 }
154
155 sub EndTag {
156 my ($this,$name) = @_;
157 $this->{'Non-Expat-Options'}->{'Handler'}->OnObjectEnd($name);
158 return 1;
159 }
160
161 sub Text {
162 my ($this) = shift;
163 my $text = shift;
164 return 1 if $this->{'Non-Expat-Options'}->{'SkipWhitespace'} and $text =~ /^\n*\s*\n*$/;
165 $this->{'Non-Expat-Options'}->{'Handler'}->OnObjectData($text);
166 return 1;
167 }
168
169 package IMPL::Serialization::XmlFormatter;
170 use parent qw(IMPL::Object);
171
172 use IMPL::Class::Property;
173
174 BEGIN {
175 public _direct property Encoding => prop_all;
176 public _direct property SkipWhitespace => prop_all;
177 public _direct property IdentOutput => prop_all;
178 }
179
180 sub CTOR {
181 my ($this,%args) = @_;
182
183 $this->Encoding($args{'Encoding'} || 'utf-8');
184 $this->SkipWhitespace($args{'SkipWhitespace'});
185 $this->IdentOutput($args{'IdentOutput'});
186
187 return 1;
188 }
189
190 sub CreateWriter {
191 my ($this,$hStream) = @_;
192 return new IMPL::Serialization::XmlObjectWriter(Encoding =>$this->Encoding() , hOutput => $hStream, IdentOutput => $this->IdentOutput());
193 }
194
195 sub CreateReader {
196 my ($this,$hStream,$refHandler) = @_;
197 return new IMPL::Serialization::XmlObjectReader(hInput => $hStream, Handler => $refHandler, SkipWhitespace => $this->SkipWhitespace());
198 }
199
200 1;