annotate lib/IMPL/Serialization/XmlFormatter.pm @ 418:3f38dabaf5cc ref20150831

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