Mercurial > pub > Impl

comparison Lib/IMPL/Serialization/XmlFormatter.pm @ 0:03e58a454b20

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