annotate Lib/IMPL/Serialization/XmlFormatter.pm @ 189:08015e2803f1

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