annotate Lib/IMPL/Serialization/XmlFormatter.pm @ 288:3a9cfea098dd

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