annotate Lib/IMPL/Serialization/XmlFormatter.pm @ 59:0f3e369553bd

Rewritten property implementation (probably become slower but more flexible) Configuration infrastructure in progress (in the aspect of the lazy activation) Initial concept for the code generator
author wizard
date Tue, 09 Mar 2010 02:50:45 +0300
parents 16ada169ca75
children dc1da0389db7
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
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
4 use base qw(IMPL::Object);
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;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
128 use base qw(XML::Parser);
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;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
164 $_ = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
165 return 1 if $this->{'Non-Expat-Options'}->{'SkipWhitespace'} and /^\n*\s*\n*$/;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
166 $this->{'Non-Expat-Options'}->{'Handler'}->OnObjectData($_);
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;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
171 use base qw(IMPL::Object);
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;