line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package XML::SAX::Writer; |
2
|
|
|
|
|
|
|
$XML::SAX::Writer::VERSION = '0.57'; |
3
|
3
|
|
|
3
|
|
43201
|
use strict; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
83
|
|
4
|
3
|
|
|
3
|
|
17
|
use warnings; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
86
|
|
5
|
3
|
|
|
3
|
|
13
|
use vars qw(%DEFAULT_ESCAPE %ATTRIBUTE_ESCAPE %COMMENT_ESCAPE); |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
173
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
# ABSTRACT: SAX2 XML Writer |
8
|
|
|
|
|
|
|
|
9
|
3
|
|
|
3
|
|
1365
|
use Encode qw(); |
|
3
|
|
|
|
|
24422
|
|
|
3
|
|
|
|
|
58
|
|
10
|
3
|
|
|
3
|
|
1709
|
use XML::SAX::Exception qw(); |
|
3
|
|
|
|
|
6363
|
|
|
3
|
|
|
|
|
52
|
|
11
|
3
|
|
|
3
|
|
1133
|
use XML::SAX::Writer::XML qw(); |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
56
|
|
12
|
3
|
|
|
3
|
|
1081
|
use XML::Filter::BufferText qw(); |
|
3
|
|
|
|
|
40704
|
|
|
3
|
|
|
|
|
4364
|
|
13
|
|
|
|
|
|
|
@XML::SAX::Writer::Exception::ISA = qw(XML::SAX::Exception); |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
%DEFAULT_ESCAPE = ( |
17
|
|
|
|
|
|
|
'&' => '&', |
18
|
|
|
|
|
|
|
'<' => '<', |
19
|
|
|
|
|
|
|
'>' => '>', |
20
|
|
|
|
|
|
|
'"' => '"', |
21
|
|
|
|
|
|
|
"'" => ''', |
22
|
|
|
|
|
|
|
); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
%ATTRIBUTE_ESCAPE = ( |
25
|
|
|
|
|
|
|
%DEFAULT_ESCAPE, |
26
|
|
|
|
|
|
|
"\t" => ' ', |
27
|
|
|
|
|
|
|
"\n" => '
', |
28
|
|
|
|
|
|
|
"\r" => '
', |
29
|
|
|
|
|
|
|
); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
%COMMENT_ESCAPE = ( |
32
|
|
|
|
|
|
|
'--' => '--', |
33
|
|
|
|
|
|
|
); |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
37
|
|
|
|
|
|
|
# new |
38
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
39
|
|
|
|
|
|
|
sub new { |
40
|
8
|
50
|
|
8
|
1
|
5640
|
my $class = ref($_[0]) ? ref(shift) : shift; |
41
|
8
|
100
|
|
|
|
23
|
my $opt = (@_ == 1) ? { %{shift()} } : {@_}; |
|
5
|
|
|
|
|
20
|
|
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# default the options |
44
|
8
|
|
50
|
|
|
50
|
$opt->{Writer} ||= 'XML::SAX::Writer::XML'; |
45
|
8
|
|
100
|
|
|
37
|
$opt->{Escape} ||= \%DEFAULT_ESCAPE; |
46
|
8
|
|
50
|
|
|
39
|
$opt->{AttributeEscape} ||= \%ATTRIBUTE_ESCAPE; |
47
|
8
|
|
50
|
|
|
35
|
$opt->{CommentEscape} ||= \%COMMENT_ESCAPE; |
48
|
8
|
100
|
|
|
|
23
|
$opt->{EncodeFrom} = exists $opt->{EncodeFrom} ? $opt->{EncodeFrom} : 'utf-8'; |
49
|
8
|
100
|
|
|
|
21
|
$opt->{EncodeTo} = exists $opt->{EncodeTo} ? $opt->{EncodeTo} : 'utf-8'; |
50
|
8
|
|
100
|
|
|
39
|
$opt->{Format} ||= {}; # needs options w/ defaults, we'll see later |
51
|
8
|
|
100
|
|
|
40
|
$opt->{Output} ||= *{STDOUT}{IO}; |
52
|
8
|
|
100
|
|
|
47
|
$opt->{QuoteCharacter} ||= q[']; |
53
|
|
|
|
|
|
|
|
54
|
3
|
|
|
3
|
|
19
|
eval "use $opt->{Writer};"; |
|
3
|
|
|
3
|
|
7
|
|
|
3
|
|
|
2
|
|
43
|
|
|
3
|
|
|
|
|
20
|
|
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
42
|
|
|
2
|
|
|
|
|
33
|
|
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
31
|
|
|
8
|
|
|
|
|
453
|
|
55
|
|
|
|
|
|
|
|
56
|
8
|
|
|
|
|
25
|
my $obj = bless $opt, $opt->{Writer}; |
57
|
8
|
|
|
|
|
30
|
$obj->init; |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# we need to buffer the text to escape it right |
60
|
8
|
|
|
|
|
43
|
my $bf = XML::Filter::BufferText->new( Handler => $obj ); |
61
|
|
|
|
|
|
|
|
62
|
8
|
|
|
|
|
385
|
return $bf; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
67
|
|
|
|
|
|
|
# init |
68
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
69
|
|
|
|
8
|
1
|
|
sub init {} # noop, for subclasses |
70
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
73
|
|
|
|
|
|
|
# setConverter |
74
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
75
|
|
|
|
|
|
|
sub setConverter { |
76
|
14
|
|
|
14
|
1
|
27
|
my $self = shift; |
77
|
|
|
|
|
|
|
|
78
|
14
|
100
|
|
|
|
65
|
if (lc($self->{EncodeFrom}) ne lc($self->{EncodeTo})) { |
79
|
10
|
|
|
|
|
58
|
$self->{Encoder} = XML::SAX::Writer::Encode->new($self->{EncodeFrom}, $self->{EncodeTo}); |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
else { |
82
|
4
|
|
|
|
|
22
|
$self->{Encoder} = XML::SAX::Writer::NullConverter->new; |
83
|
|
|
|
|
|
|
} |
84
|
14
|
|
|
|
|
39
|
return $self; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
89
|
|
|
|
|
|
|
# setConsumer |
90
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
91
|
|
|
|
|
|
|
sub setConsumer { |
92
|
14
|
|
|
14
|
1
|
26
|
my $self = shift; |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
# create the Consumer |
95
|
14
|
|
|
|
|
36
|
my $ref = ref $self->{Output}; |
96
|
14
|
100
|
66
|
|
|
148
|
if ($ref eq 'SCALAR') { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
97
|
4
|
|
|
|
|
22
|
$self->{Consumer} = XML::SAX::Writer::StringConsumer->new($self->{Output}); |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
elsif ($ref eq 'CODE') { |
100
|
1
|
|
|
|
|
5
|
$self->{Consumer} = XML::SAX::Writer::CodeConsumer->new($self->{Output}); |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
elsif ($ref eq 'ARRAY') { |
103
|
1
|
|
|
|
|
6
|
$self->{Consumer} = XML::SAX::Writer::ArrayConsumer->new($self->{Output}); |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
elsif ( |
106
|
|
|
|
|
|
|
$ref eq 'GLOB' or |
107
|
|
|
|
|
|
|
UNIVERSAL::isa(\$self->{Output}, 'GLOB') or |
108
|
|
|
|
|
|
|
UNIVERSAL::isa($self->{Output}, 'IO::Handle')) { |
109
|
4
|
|
|
|
|
16
|
$self->{Consumer} = XML::SAX::Writer::HandleConsumer->new($self->{Output}); |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
elsif (not $ref) { |
112
|
1
|
|
|
|
|
6
|
$self->{Consumer} = XML::SAX::Writer::FileConsumer->new($self->{Output}); |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
elsif (UNIVERSAL::can($self->{Output}, 'output')) { |
115
|
2
|
|
|
|
|
7
|
$self->{Consumer} = $self->{Output}; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
else { |
118
|
1
|
|
|
|
|
11
|
XML::SAX::Writer::Exception->throw( Message => 'Unknown option for Output' ); |
119
|
|
|
|
|
|
|
} |
120
|
13
|
|
|
|
|
64
|
return $self; |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
125
|
|
|
|
|
|
|
# setEscaperRegex |
126
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
127
|
|
|
|
|
|
|
sub setEscaperRegex { |
128
|
14
|
|
|
14
|
1
|
23
|
my $self = shift; |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
$self->{EscaperRegex} = eval 'qr/' . |
131
|
14
|
|
|
|
|
25
|
join( '|', map { $_ = "\Q$_\E" } keys %{$self->{Escape}}) . |
|
70
|
|
|
|
|
1085
|
|
|
14
|
|
|
|
|
51
|
|
132
|
|
|
|
|
|
|
'/;' ; |
133
|
14
|
|
|
|
|
68
|
return $self; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
138
|
|
|
|
|
|
|
# setAttributeEscaperRegex |
139
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
140
|
|
|
|
|
|
|
sub setAttributeEscaperRegex { |
141
|
14
|
|
|
14
|
0
|
23
|
my $self = shift; |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
$self->{AttributeEscaperRegex} = |
144
|
|
|
|
|
|
|
eval 'qr/' . |
145
|
14
|
|
|
|
|
25
|
join( '|', map { $_ = "\Q$_\E" } keys %{$self->{AttributeEscape}}) . |
|
112
|
|
|
|
|
1044
|
|
|
14
|
|
|
|
|
51
|
|
146
|
|
|
|
|
|
|
'/;' ; |
147
|
14
|
|
|
|
|
70
|
return $self; |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
152
|
|
|
|
|
|
|
# setCommentEscaperRegex |
153
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
154
|
|
|
|
|
|
|
sub setCommentEscaperRegex { |
155
|
14
|
|
|
14
|
1
|
25
|
my $self = shift; |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
$self->{CommentEscaperRegex} = |
158
|
|
|
|
|
|
|
eval 'qr/' . |
159
|
14
|
|
|
|
|
24
|
join( '|', map { $_ = "\Q$_\E" } keys %{$self->{CommentEscape}}) . |
|
14
|
|
|
|
|
647
|
|
|
14
|
|
|
|
|
41
|
|
160
|
|
|
|
|
|
|
'/;' ; |
161
|
14
|
|
|
|
|
59
|
return $self; |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
166
|
|
|
|
|
|
|
# escape |
167
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
168
|
|
|
|
|
|
|
sub escape { |
169
|
3
|
|
|
3
|
1
|
979
|
my $self = shift; |
170
|
3
|
|
|
|
|
5
|
my $str = shift; |
171
|
|
|
|
|
|
|
|
172
|
3
|
|
|
|
|
59
|
$str =~ s/($self->{EscaperRegex})/$self->{Escape}->{$1}/ge; |
|
5
|
|
|
|
|
18
|
|
173
|
3
|
|
|
|
|
12
|
return $str; |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
178
|
|
|
|
|
|
|
# escapeAttribute |
179
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
180
|
|
|
|
|
|
|
sub escapeAttribute { |
181
|
1
|
|
|
1
|
0
|
3
|
my $self = shift; |
182
|
1
|
|
|
|
|
2
|
my $str = shift; |
183
|
|
|
|
|
|
|
|
184
|
1
|
|
|
|
|
46
|
$str =~ s/($self->{AttributeEscaperRegex})/$self->{AttributeEscape}->{$1}/ge; |
|
3
|
|
|
|
|
22
|
|
185
|
1
|
|
|
|
|
10
|
return $str; |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
190
|
|
|
|
|
|
|
# escapeComment |
191
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
192
|
|
|
|
|
|
|
sub escapeComment { |
193
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
194
|
0
|
|
|
|
|
0
|
my $str = shift; |
195
|
|
|
|
|
|
|
|
196
|
0
|
|
|
|
|
0
|
$str =~ s/($self->{CommentEscaperRegex})/$self->{CommentEscape}->{$1}/ge; |
|
0
|
|
|
|
|
0
|
|
197
|
0
|
|
|
|
|
0
|
return $str; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
202
|
|
|
|
|
|
|
# convert and checking the return value |
203
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
204
|
|
|
|
|
|
|
sub safeConvert { |
205
|
9
|
|
|
9
|
0
|
16
|
my $self = shift; |
206
|
9
|
|
|
|
|
15
|
my $str = shift; |
207
|
|
|
|
|
|
|
|
208
|
9
|
|
|
|
|
33
|
my $out = $self->{Encoder}->convert($str); |
209
|
|
|
|
|
|
|
|
210
|
9
|
100
|
66
|
|
|
32
|
if (!defined $out && defined $str) { |
211
|
1
|
|
|
|
|
9
|
warn "Conversion error returned by Encoder [$self->{Encoder}], string: '$str'"; |
212
|
1
|
|
|
|
|
4
|
$out = '_LOST_DATA_'; |
213
|
|
|
|
|
|
|
} |
214
|
9
|
|
|
|
|
26
|
return $out; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
#,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,# |
220
|
|
|
|
|
|
|
#`,`, The Empty Consumer ,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,# |
221
|
|
|
|
|
|
|
#```````````````````````````````````````````````````````````````````# |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
# this package is only there to provide a smooth upgrade path in case |
224
|
|
|
|
|
|
|
# new methods are added to the interface |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
package XML::SAX::Writer::ConsumerInterface; |
227
|
|
|
|
|
|
|
$XML::SAX::Writer::ConsumerInterface::VERSION = '0.57'; |
228
|
|
|
|
|
|
|
sub new { |
229
|
16
|
|
|
16
|
|
2016
|
my $class = shift; |
230
|
16
|
|
|
|
|
25
|
my $ref = shift; |
231
|
|
|
|
|
|
|
## $self is a reference to the reference that we will send output |
232
|
|
|
|
|
|
|
## to. This allows us to bless $self without blessing $$self. |
233
|
16
|
|
33
|
|
|
94
|
return bless \$ref, ref $class || $class; |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
0
|
|
|
sub output {} |
237
|
|
|
|
1
|
|
|
sub finalize {} |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
#,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,# |
241
|
|
|
|
|
|
|
#`,`, The String Consumer `,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,# |
242
|
|
|
|
|
|
|
#```````````````````````````````````````````````````````````````````# |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
package XML::SAX::Writer::StringConsumer; |
245
|
|
|
|
|
|
|
$XML::SAX::Writer::StringConsumer::VERSION = '0.57'; |
246
|
|
|
|
|
|
|
@XML::SAX::Writer::StringConsumer::ISA = qw(XML::SAX::Writer::ConsumerInterface); |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
249
|
|
|
|
|
|
|
# new |
250
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
251
|
|
|
|
|
|
|
sub new { |
252
|
5
|
|
|
5
|
|
69
|
my $self = shift->SUPER::new( @_ ); |
253
|
5
|
|
|
|
|
12
|
${${$self}} = ''; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
19
|
|
254
|
5
|
|
|
|
|
21
|
return $self; |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
259
|
|
|
|
|
|
|
# output |
260
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
261
|
8
|
|
|
8
|
|
697
|
sub output { ${${$_[0]}} .= $_[1] } |
|
8
|
|
|
|
|
13
|
|
|
8
|
|
|
|
|
42
|
|
262
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
265
|
|
|
|
|
|
|
# finalize |
266
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
267
|
4
|
|
|
4
|
|
11
|
sub finalize { ${$_[0]} } |
|
4
|
|
|
|
|
10
|
|
268
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
#,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,# |
271
|
|
|
|
|
|
|
#`,`, The Code Consumer `,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,# |
272
|
|
|
|
|
|
|
#```````````````````````````````````````````````````````````````````# |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
package XML::SAX::Writer::CodeConsumer; |
275
|
|
|
|
|
|
|
$XML::SAX::Writer::CodeConsumer::VERSION = '0.57'; |
276
|
|
|
|
|
|
|
@XML::SAX::Writer::CodeConsumer::ISA = qw(XML::SAX::Writer::ConsumerInterface ); |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
279
|
|
|
|
|
|
|
# new |
280
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
281
|
|
|
|
|
|
|
sub new { |
282
|
1
|
|
|
1
|
|
6
|
my $self = shift->SUPER::new( @_ ); |
283
|
1
|
|
|
|
|
5
|
$$self->( 'start_document', '' ); |
284
|
1
|
|
|
|
|
6
|
return $self; |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
289
|
|
|
|
|
|
|
# output |
290
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
291
|
1
|
|
|
1
|
|
2
|
sub output { ${$_[0]}->('data', pop) } ## Avoid an extra copy |
|
1
|
|
|
|
|
3
|
|
292
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
295
|
|
|
|
|
|
|
# finalize |
296
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
297
|
1
|
|
|
1
|
|
2
|
sub finalize { ${$_[0]}->('end_document', '') } |
|
1
|
|
|
|
|
3
|
|
298
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
#,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,# |
302
|
|
|
|
|
|
|
#`,`, The Array Consumer ,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,# |
303
|
|
|
|
|
|
|
#```````````````````````````````````````````````````````````````````# |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
package XML::SAX::Writer::ArrayConsumer; |
306
|
|
|
|
|
|
|
$XML::SAX::Writer::ArrayConsumer::VERSION = '0.57'; |
307
|
|
|
|
|
|
|
@XML::SAX::Writer::ArrayConsumer::ISA = qw(XML::SAX::Writer::ConsumerInterface); |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
310
|
|
|
|
|
|
|
# new |
311
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
312
|
|
|
|
|
|
|
sub new { |
313
|
2
|
|
|
2
|
|
418
|
my $self = shift->SUPER::new( @_ ); |
314
|
2
|
|
|
|
|
10
|
@$$self = (); |
315
|
2
|
|
|
|
|
5
|
return $self; |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
320
|
|
|
|
|
|
|
# output |
321
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
322
|
2
|
|
|
2
|
|
439
|
sub output { push @${$_[0]}, pop } |
|
2
|
|
|
|
|
6
|
|
323
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
326
|
|
|
|
|
|
|
# finalize |
327
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
328
|
1
|
|
|
1
|
|
5
|
sub finalize { return ${$_[0]} } |
|
1
|
|
|
|
|
3
|
|
329
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
#,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,# |
333
|
|
|
|
|
|
|
#`,`, The Handle Consumer `,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,# |
334
|
|
|
|
|
|
|
#```````````````````````````````````````````````````````````````````# |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
package XML::SAX::Writer::HandleConsumer; |
337
|
|
|
|
|
|
|
$XML::SAX::Writer::HandleConsumer::VERSION = '0.57'; |
338
|
|
|
|
|
|
|
@XML::SAX::Writer::HandleConsumer::ISA = qw(XML::SAX::Writer::ConsumerInterface); |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
341
|
|
|
|
|
|
|
# output |
342
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
343
|
|
|
|
|
|
|
sub output { |
344
|
4
|
|
|
4
|
|
919
|
my $fh = ${$_[0]}; |
|
4
|
|
|
|
|
9
|
|
345
|
4
|
50
|
|
|
|
26
|
print $fh pop or XML::SAX::Exception->throw( |
346
|
|
|
|
|
|
|
Message => "Could not write to handle: $fh ($!)" |
347
|
|
|
|
|
|
|
); |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
352
|
|
|
|
|
|
|
# finalize |
353
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
354
|
0
|
|
|
0
|
|
0
|
sub finalize { return 0 } |
355
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
#,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,# |
359
|
|
|
|
|
|
|
#`,`, The File Consumer `,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,# |
360
|
|
|
|
|
|
|
#```````````````````````````````````````````````````````````````````# |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
package XML::SAX::Writer::FileConsumer; |
363
|
|
|
|
|
|
|
$XML::SAX::Writer::FileConsumer::VERSION = '0.57'; |
364
|
|
|
|
|
|
|
@XML::SAX::Writer::FileConsumer::ISA = qw(XML::SAX::Writer::HandleConsumer); |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
367
|
|
|
|
|
|
|
# new |
368
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
369
|
|
|
|
|
|
|
sub new { |
370
|
3
|
|
|
3
|
|
832
|
my ( $proto, $file, $opt ) = @_; |
371
|
|
|
|
|
|
|
my $enc_to = (defined $opt and ref $opt eq 'HASH' |
372
|
|
|
|
|
|
|
and defined $opt->{EncodeTo}) ? $opt->{EncodeTo} |
373
|
3
|
50
|
33
|
|
|
17
|
: 'utf-8'; |
374
|
|
|
|
|
|
|
|
375
|
3
|
50
|
0
|
|
|
8
|
XML::SAX::Writer::Exception->throw( |
376
|
|
|
|
|
|
|
Message => "No filename provided to " . ref( $proto || $proto ) |
377
|
|
|
|
|
|
|
) unless defined $file; |
378
|
|
|
|
|
|
|
|
379
|
3
|
|
|
|
|
8
|
local *XFH; |
380
|
|
|
|
|
|
|
|
381
|
2
|
50
|
|
2
|
|
12
|
open XFH, ">:encoding($enc_to)", $file |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
112
|
|
382
|
|
|
|
|
|
|
or XML::SAX::Writer::Exception->throw( |
383
|
|
|
|
|
|
|
Message => "Error opening file $file: $!" |
384
|
|
|
|
|
|
|
); |
385
|
|
|
|
|
|
|
|
386
|
3
|
|
|
|
|
2040
|
return $proto->SUPER::new( *{XFH}{IO}, @_ ); |
387
|
|
|
|
|
|
|
} |
388
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
391
|
|
|
|
|
|
|
# finalize |
392
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
393
|
|
|
|
|
|
|
sub finalize { |
394
|
2
|
|
|
2
|
|
8
|
close ${$_[0]}; |
|
2
|
|
|
|
|
77
|
|
395
|
2
|
|
|
|
|
7
|
return 0; |
396
|
|
|
|
|
|
|
} |
397
|
|
|
|
|
|
|
#-------------------------------------------------------------------# |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
#,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,# |
401
|
|
|
|
|
|
|
#`,`, Noop Converter ,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,# |
402
|
|
|
|
|
|
|
#```````````````````````````````````````````````````````````````````# |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
package XML::SAX::Writer::NullConverter; |
405
|
|
|
|
|
|
|
$XML::SAX::Writer::NullConverter::VERSION = '0.57'; |
406
|
5
|
|
|
5
|
|
510
|
sub new { return bless [], __PACKAGE__ } |
407
|
4
|
|
|
4
|
|
13
|
sub convert { $_[1] } |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
#,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,# |
411
|
|
|
|
|
|
|
#`,`, Encode Converter ,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,`,# |
412
|
|
|
|
|
|
|
#```````````````````````````````````````````````````````````````````# |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
package XML::SAX::Writer::Encode; |
415
|
|
|
|
|
|
|
$XML::SAX::Writer::Encode::VERSION = '0.57'; |
416
|
|
|
|
|
|
|
sub new { |
417
|
11
|
|
|
11
|
|
511
|
my ($class, $from, $to) = @_; |
418
|
11
|
|
|
|
|
35
|
my $self = { |
419
|
|
|
|
|
|
|
from_enc => $from, |
420
|
|
|
|
|
|
|
to_enc => $to, |
421
|
|
|
|
|
|
|
}; |
422
|
11
|
|
|
|
|
33
|
return bless $self, $class; |
423
|
|
|
|
|
|
|
} |
424
|
|
|
|
|
|
|
sub convert { |
425
|
7
|
|
|
7
|
|
20
|
my ($self, $data) = @_; |
426
|
7
|
|
|
|
|
12
|
eval { |
427
|
7
|
50
|
|
|
|
41
|
$data = Encode::decode($self->{from_enc}, $data) if $self->{from_enc}; |
428
|
7
|
50
|
|
|
|
536
|
$data = Encode::encode($self->{to_enc}, $data, Encode::FB_CROAK) if $self->{to_enc}; |
429
|
|
|
|
|
|
|
}; |
430
|
7
|
100
|
|
|
|
248
|
if ($@) { |
431
|
1
|
|
|
|
|
10
|
warn $@; |
432
|
1
|
|
|
|
|
6
|
return; |
433
|
|
|
|
|
|
|
} |
434
|
6
|
|
|
|
|
22
|
return $data; |
435
|
|
|
|
|
|
|
}; |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
1; |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
=pod |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
=encoding UTF-8 |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
=head1 NAME |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
XML::SAX::Writer - SAX2 XML Writer |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
=head1 VERSION |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
version 0.57 |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
=head1 SYNOPSIS |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
use XML::SAX::Writer; |
455
|
|
|
|
|
|
|
use XML::SAX::SomeDriver; |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
my $w = XML::SAX::Writer->new; |
458
|
|
|
|
|
|
|
my $d = XML::SAX::SomeDriver->new(Handler => $w); |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
$d->parse('some options...'); |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
=head1 DESCRIPTION |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
=head2 Why yet another XML Writer ? |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
A new XML Writer was needed to match the SAX2 effort because quite |
467
|
|
|
|
|
|
|
naturally no existing writer understood SAX2. My first intention had |
468
|
|
|
|
|
|
|
been to start patching XML::Handler::YAWriter as it had previously |
469
|
|
|
|
|
|
|
been my favourite writer in the SAX1 world. |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
However the more I patched it the more I realised that what I thought |
472
|
|
|
|
|
|
|
was going to be a simple patch (mostly adding a few event handlers and |
473
|
|
|
|
|
|
|
changing the attribute syntax) was turning out to be a rewrite due to |
474
|
|
|
|
|
|
|
various ideas I'd been collecting along the way. Besides, I couldn't |
475
|
|
|
|
|
|
|
find a way to elegantly make it work with SAX2 without breaking the |
476
|
|
|
|
|
|
|
SAX1 compatibility which people are probably still using. There are of |
477
|
|
|
|
|
|
|
course ways to do that, but most require user interaction which is |
478
|
|
|
|
|
|
|
something I wanted to avoid. |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
So in the end there was a new writer. I think it's in fact better this |
481
|
|
|
|
|
|
|
way as it helps keep SAX1 and SAX2 separated. |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
=head1 METHODS |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
=over 4 |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
=item * new(%hash) |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
This is the constructor for this object. It takes a number of |
490
|
|
|
|
|
|
|
parameters, all of which are optional. |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
=item * Output |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
This parameter can be one of several things. If it is a simple |
495
|
|
|
|
|
|
|
scalar, it is interpreted as a filename which will be opened for |
496
|
|
|
|
|
|
|
writing. If it is a scalar reference, output will be appended to this |
497
|
|
|
|
|
|
|
scalar. If it is an array reference, output will be pushed onto this |
498
|
|
|
|
|
|
|
array as it is generated. If it is a filehandle, then output will be |
499
|
|
|
|
|
|
|
sent to this filehandle. |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
Finally, it is possible to pass an object for this parameter, in which |
502
|
|
|
|
|
|
|
case it is assumed to be an object that implements the consumer |
503
|
|
|
|
|
|
|
interface L
|
504
|
|
|
|
|
|
|
INTERFACE>. |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
If this parameter is not provided, then output is sent to STDOUT. |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
Note that there is no means to set an encoding layer on filehandles |
509
|
|
|
|
|
|
|
created by this module; if this is necessary, the calling code should |
510
|
|
|
|
|
|
|
first open a filehandle with the appropriate encoding set, and pass |
511
|
|
|
|
|
|
|
that filehandle to this module. |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
=item * Escape |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
This should be a hash reference where the keys are characters |
516
|
|
|
|
|
|
|
sequences that should be escaped and the values are the escaped form |
517
|
|
|
|
|
|
|
of the sequence. By default, this module will escape the ampersand |
518
|
|
|
|
|
|
|
(&), less than (<), greater than (>), double quote ("), and apostrophe |
519
|
|
|
|
|
|
|
('). Note that some browsers don't support the ' escape used for |
520
|
|
|
|
|
|
|
apostrophes so that you should be careful when outputting XHTML. |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
If you only want to add entries to the Escape hash, you can first |
523
|
|
|
|
|
|
|
copy the contents of %XML::SAX::Writer::DEFAULT_ESCAPE. |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
=item * CommentEscape |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
Comment content often needs to be escaped differently from other |
528
|
|
|
|
|
|
|
content. This option works exactly as the previous one except that |
529
|
|
|
|
|
|
|
by default it only escapes the double dash (--) and that the contents |
530
|
|
|
|
|
|
|
can be copied from %XML::SAX::Writer::COMMENT_ESCAPE. |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
=item * EncodeFrom |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
The character set encoding in which incoming data will be provided. |
535
|
|
|
|
|
|
|
This defaults to UTF-8, which works for US-ASCII as well. |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
Set this to C if you do not wish to decode your data. |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
=item * EncodeTo |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
The character set encoding in which output should be encoded. Again, |
542
|
|
|
|
|
|
|
this defaults to UTF-8. |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
Set this to C if you do not with to encode your data. |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
=item * QuoteCharacter |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
Set the character used to quote attributes. This defaults to single quotes (') |
549
|
|
|
|
|
|
|
for backwards compatibility. |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
=back |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
=head1 THE CONSUMER INTERFACE |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
XML::SAX::Writer can receive pluggable consumer objects that will be |
556
|
|
|
|
|
|
|
in charge of writing out what is formatted by this module. Setting a |
557
|
|
|
|
|
|
|
Consumer is done by setting the Output option to the object of your |
558
|
|
|
|
|
|
|
choice instead of to an array, scalar, or file handle as is more |
559
|
|
|
|
|
|
|
commonly done (internally those in fact map to Consumer classes and |
560
|
|
|
|
|
|
|
and simply available as options for your convenience). |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
If you don't understand this, don't worry. You don't need it most of |
563
|
|
|
|
|
|
|
the time. |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
That object can be from any class, but must have two methods in its |
566
|
|
|
|
|
|
|
API. It is also strongly recommended that it inherits from |
567
|
|
|
|
|
|
|
XML::SAX::Writer::ConsumerInterface so that it will not break if that |
568
|
|
|
|
|
|
|
interface evolves over time. There are examples at the end of |
569
|
|
|
|
|
|
|
XML::SAX::Writer's code. |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
The two methods that it needs to implement are: |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
=over 4 |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
=item * output STRING |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
(Required) |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
This is called whenever the Writer wants to output a string formatted |
580
|
|
|
|
|
|
|
in XML. Encoding conversion, character escaping, and formatting have |
581
|
|
|
|
|
|
|
already taken place. It's up to the consumer to do whatever it wants |
582
|
|
|
|
|
|
|
with the string. |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
=item * finalize() |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
(Optional) |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
This is called once the document has been output in its entirety, |
589
|
|
|
|
|
|
|
during the end_document event. end_document will in fact return |
590
|
|
|
|
|
|
|
whatever finalize() returns, and that in turn should be returned |
591
|
|
|
|
|
|
|
by parse() for whatever parser was invoked. It might be useful if |
592
|
|
|
|
|
|
|
you need to provide feedback of some sort. |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
=back |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
Here's an example of a custom consumer. Note the extra C<$> signs in |
597
|
|
|
|
|
|
|
front of $self; the base class is optimized for the overwhelmingly |
598
|
|
|
|
|
|
|
common case where only one data member is required and $self is a |
599
|
|
|
|
|
|
|
reference to that data member. |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
package MyConsumer; |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
@ISA = qw( XML::SAX::Writer::ConsumerInterface ); |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
use strict; |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
sub new { |
608
|
|
|
|
|
|
|
my $self = shift->SUPER::new( my $output ); |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
$$self = ''; # Note the extra '$' |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
return $self; |
613
|
|
|
|
|
|
|
} |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
sub output { |
616
|
|
|
|
|
|
|
my $self = shift; |
617
|
|
|
|
|
|
|
$$self .= uc shift; |
618
|
|
|
|
|
|
|
} |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
sub get_output { |
621
|
|
|
|
|
|
|
my $self = shift; |
622
|
|
|
|
|
|
|
return $$self; |
623
|
|
|
|
|
|
|
} |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
And here is one way to use it: |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
my $c = MyConsumer->new; |
628
|
|
|
|
|
|
|
my $w = XML::SAX::Writer->new( Output => $c ); |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
## ... send events to $w ... |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
print $c->get_output; |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
If you need to store more that one data member, pass in an array or hash |
635
|
|
|
|
|
|
|
reference: |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
my $self = shift->SUPER::new( {} ); |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
and access it like: |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
sub output { |
642
|
|
|
|
|
|
|
my $self = shift; |
643
|
|
|
|
|
|
|
$$self->{Output} .= uc shift; |
644
|
|
|
|
|
|
|
} |
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
=head1 THE ENCODER INTERFACE |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
Encoders can be plugged in to allow one to use one's favourite encoder |
649
|
|
|
|
|
|
|
object. Presently there are two encoders: Encode and NullEncoder. They |
650
|
|
|
|
|
|
|
need to implement two methods, and may inherit from |
651
|
|
|
|
|
|
|
XML::SAX::Writer::NullConverter if they wish to |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
=over 4 |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
=item new FROM_ENCODING, TO_ENCODING |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
Creates a new Encoder. The arguments are the chosen encodings. |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
=item convert STRING |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
Converts that string and returns it. |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
=back |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
Note that the return value of the convert method is B checked. Output may |
666
|
|
|
|
|
|
|
be truncated if a character couldn't be converted correctly. To avoid problems |
667
|
|
|
|
|
|
|
the encoder should take care encoding errors itself, for example by raising an |
668
|
|
|
|
|
|
|
exception. |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
=head1 CUSTOM OUTPUT |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
This module is generally used to write XML -- which it does most of the |
673
|
|
|
|
|
|
|
time -- but just like the rest of SAX it can be used as a generic |
674
|
|
|
|
|
|
|
framework to output data, the opposite of a non-XML SAX parser. |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
Of course there's only so much that one can abstract, so depending on |
677
|
|
|
|
|
|
|
your format this may or may not be useful. If it is, you'll need to |
678
|
|
|
|
|
|
|
know the following API (and probably to have a look inside |
679
|
|
|
|
|
|
|
C, the default Writer). |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
=over |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
=item init |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
Called before the writing starts, it's a chance for the subclass to do |
686
|
|
|
|
|
|
|
some initialisation if it needs it. |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
=item setConverter |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
This is used to set the proper converter for character encodings. The |
691
|
|
|
|
|
|
|
default implementation should suffice but you can override it. It must |
692
|
|
|
|
|
|
|
set C<< $self->{Encoder} >> to an Encoder object. Subclasses *should* call |
693
|
|
|
|
|
|
|
it. |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
=item setConsumer |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
Same as above, except that it is for the Consumer object, and that it |
698
|
|
|
|
|
|
|
must set C<< $self->{Consumer} >>. |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
=item setEscaperRegex |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
Will initialise the escaping regex C<< $self->{EscaperRegex} >> based on |
703
|
|
|
|
|
|
|
what is needed. |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
=item escape STRING |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
Takes a string and escapes it properly. |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
=item setCommentEscaperRegex and escapeComment STRING |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
These work exactly the same as the two above, except that they are meant |
712
|
|
|
|
|
|
|
to operate on comment contents, which often have different escaping rules |
713
|
|
|
|
|
|
|
than those that apply to regular content. |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
=back |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
=head1 TODO |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
- proper UTF-16 handling |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
- the formatting options need to be developed. |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
- test, test, test (and then some tests) |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
- doc, doc, doc (actually this part is in better shape) |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
- remove the xml_decl and replace it with intelligent logic, as |
728
|
|
|
|
|
|
|
discussed on perl-xml |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
- make a the Consumer selecting code available in the API, to avoid |
731
|
|
|
|
|
|
|
duplicating |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
- add an Apache output Consumer, triggered by passing $r as Output |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
=head1 CREDITS |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
Michael Koehne (XML::Handler::YAWriter) for much inspiration and Barrie |
738
|
|
|
|
|
|
|
Slaymaker for the Consumer pattern idea, the coderef output option and |
739
|
|
|
|
|
|
|
miscellaneous bugfixes and performance tweaks. Of course the usual |
740
|
|
|
|
|
|
|
suspects (Kip Hampton and Matt Sergeant) helped in the usual ways. |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
=head1 SEE ALSO |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
XML::SAX::* |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
=head1 AUTHORS |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
=over 4 |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
=item * |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
Robin Berjon |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
=item * |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
Chris Prather |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
=back |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
This software is copyright (c) 2014 by Robin Berjon. |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
765
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
=cut |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
__END__ |