line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package XML::Filter::DetectWS; |
2
|
1
|
|
|
1
|
|
12512
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
55
|
|
3
|
1
|
|
|
1
|
|
1470
|
use XML::Filter::SAXT; |
|
1
|
|
|
|
|
2597
|
|
|
1
|
|
|
|
|
46
|
|
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
9
|
use vars qw($VERSION); |
|
1
|
|
|
|
|
10
|
|
|
1
|
|
|
|
|
4130
|
|
6
|
|
|
|
|
|
|
$VERSION = '0.01'; |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
#---------------------------------------------------------------------- |
9
|
|
|
|
|
|
|
# CONSTANT DEFINITIONS |
10
|
|
|
|
|
|
|
#---------------------------------------------------------------------- |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
# Locations of whitespace |
13
|
0
|
|
|
0
|
1
|
|
sub WS_START (%) { 1 } # just after |
14
|
0
|
|
|
0
|
1
|
|
sub WS_END (%) { 2 } # just before |
15
|
0
|
|
|
0
|
0
|
|
sub WS_INTER (%) { 0 } # not at the start or end (i.e. intermediate) |
16
|
0
|
|
|
0
|
0
|
|
sub WS_ONLY (%) { 3 } # both START and END, i.e. between and |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
# The states of the WhiteSpace detection code |
19
|
|
|
|
|
|
|
# for regular elements, i.e. elements that: |
20
|
|
|
|
|
|
|
# 1) don't have xml:space="preserve" |
21
|
|
|
|
|
|
|
# 2) have an ELEMENT model that allows text children (i.e. ANY or Mixed content) |
22
|
|
|
|
|
|
|
|
23
|
0
|
|
|
0
|
0
|
|
sub START (%) { 0 } # just saw |
24
|
0
|
|
|
0
|
0
|
|
sub ONLY_WS (%) { 1 } # saw followed by whitespace (only) |
25
|
0
|
|
|
0
|
0
|
|
sub ENDS_IN_WS (%) { 2 } # ends in whitespace (sofar) |
26
|
0
|
|
|
0
|
0
|
|
sub ENDS_IN_NON_WS (%) { 3 } # ends in non-ws text or non-text node (sofar) |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# NO_TEXT States: when model does not allow text |
29
|
|
|
|
|
|
|
# (we assume that all text children are whitespace) |
30
|
0
|
|
|
0
|
0
|
|
sub NO_TEXT_START (%) { 4 } # just saw |
31
|
0
|
|
|
0
|
0
|
|
sub NO_TEXT_ONLY_WS (%) { 5 } # saw followed by whitespace (only) |
32
|
0
|
|
|
0
|
0
|
|
sub NO_TEXT_ENDS_IN_WS (%) { 6 } # ends in whitespace (sofar) |
33
|
0
|
|
|
0
|
0
|
|
sub NO_TEXT_ENDS_IN_NON_WS (%) { 7 } # ends in non-text node (sofar) |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
# State for elements with xml:space="preserve" (all text is non-WS) |
36
|
0
|
|
|
0
|
0
|
|
sub PRESERVE_WS (%) { 8 } |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
#---------------------------------------------------------------------- |
39
|
|
|
|
|
|
|
# METHOD DEFINITIONS |
40
|
|
|
|
|
|
|
#---------------------------------------------------------------------- |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# Constructor options: |
43
|
|
|
|
|
|
|
# |
44
|
|
|
|
|
|
|
# SkipIgnorableWS 1 means: don't forward ignorable_whitespace events |
45
|
|
|
|
|
|
|
# Handler SAX Handler that will receive the resulting events |
46
|
|
|
|
|
|
|
# |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub new |
49
|
|
|
|
|
|
|
{ |
50
|
0
|
|
|
0
|
0
|
|
my ($class, %options) = @_; |
51
|
|
|
|
|
|
|
|
52
|
0
|
|
|
|
|
|
my $self = bless \%options, $class; |
53
|
|
|
|
|
|
|
|
54
|
0
|
|
|
|
|
|
$self->init_handlers; |
55
|
|
|
|
|
|
|
|
56
|
0
|
|
|
|
|
|
$self; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# Does nothing |
60
|
0
|
|
|
0
|
0
|
|
sub noop {} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub init_handlers |
63
|
|
|
|
|
|
|
{ |
64
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
65
|
0
|
|
|
|
|
|
my %handlers; |
66
|
|
|
|
|
|
|
|
67
|
0
|
|
|
|
|
|
my $handler = $self->{Handler}; |
68
|
|
|
|
|
|
|
|
69
|
0
|
|
|
|
|
|
for my $cb (map { @{$_} } values %XML::Filter::SAXT::SAX_HANDLERS) |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
{ |
71
|
0
|
0
|
|
|
|
|
if (UNIVERSAL::can ($handler, $cb)) |
72
|
|
|
|
|
|
|
{ |
73
|
0
|
|
|
|
|
|
$handlers{$cb} = eval "sub { \$handler->$cb (\@_) }"; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
else |
76
|
|
|
|
|
|
|
{ |
77
|
0
|
|
|
|
|
|
$handlers{$cb} = \&noop; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
0
|
0
|
|
|
|
|
if ($self->{SkipIgnorableWS}) |
|
|
0
|
|
|
|
|
|
82
|
|
|
|
|
|
|
{ |
83
|
0
|
|
|
|
|
|
delete $handlers{ignorable_whitespace}; # if it exists |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
elsif (UNIVERSAL::can ($handler, 'ignorable_whitespace')) |
86
|
|
|
|
|
|
|
{ |
87
|
|
|
|
|
|
|
# Support ignorable_whitespace callback if it exists |
88
|
|
|
|
|
|
|
# (if not, just use characters callback) |
89
|
|
|
|
|
|
|
$handlers{ignorable_whitespace} = |
90
|
0
|
|
|
0
|
|
|
sub { $handler->ignorable_whitespace (@_) }; |
|
0
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
else |
93
|
|
|
|
|
|
|
{ |
94
|
0
|
|
|
|
|
|
$handlers{ignorable_whitespace} = $handlers{characters}; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
0
|
|
|
|
|
|
$handlers{ws} = $handlers{characters}; |
98
|
|
|
|
|
|
|
#?? were should whitespace go? |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
# NOTE: 'cdata' is not a valid PerlSAX callback |
101
|
0
|
0
|
0
|
|
|
|
if (UNIVERSAL::can ($handler, 'start_cdata') && |
102
|
|
|
|
|
|
|
UNIVERSAL::can ($handler, 'end_cdata')) |
103
|
|
|
|
|
|
|
{ |
104
|
|
|
|
|
|
|
$handlers{cdata} = sub { |
105
|
0
|
|
|
0
|
|
|
$handler->start_cdata; |
106
|
0
|
|
|
|
|
|
$handler->characters (@_); |
107
|
0
|
|
|
|
|
|
$handler->end_cdata; |
108
|
|
|
|
|
|
|
} |
109
|
0
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
else # pass CDATA as regular characters |
111
|
|
|
|
|
|
|
{ |
112
|
0
|
|
|
|
|
|
$handlers{cdata} = $handlers{characters}; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
0
|
|
|
|
|
|
$self->{Callback} = \%handlers; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub start_cdata |
119
|
|
|
|
|
|
|
{ |
120
|
0
|
|
|
0
|
0
|
|
my ($self, $event) = @_; |
121
|
|
|
|
|
|
|
|
122
|
0
|
|
|
|
|
|
$self->{InCDATA} = 1; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
sub end_cdata |
126
|
|
|
|
|
|
|
{ |
127
|
0
|
|
|
0
|
0
|
|
my ($self, $event) = @_; |
128
|
|
|
|
|
|
|
|
129
|
0
|
|
|
|
|
|
$self->{InCDATA} = 0; |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
sub entity_reference |
133
|
|
|
|
|
|
|
{ |
134
|
0
|
|
|
0
|
0
|
|
my ($self, $event) = @_; |
135
|
|
|
|
|
|
|
|
136
|
0
|
|
|
|
|
|
$self->push_event ('entity_reference', $event); |
137
|
|
|
|
|
|
|
|
138
|
0
|
|
|
|
|
|
my $parent = $self->{ParentStack}->[-1]; |
139
|
0
|
0
|
|
|
|
|
$parent->{State} |= ENDS_IN_NON_WS unless $parent->{State} == PRESERVE_WS; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
sub comment |
143
|
|
|
|
|
|
|
{ |
144
|
0
|
|
|
0
|
1
|
|
my ($self, $event) = @_; |
145
|
|
|
|
|
|
|
|
146
|
0
|
|
|
|
|
|
$self->push_event ('comment', $event); |
147
|
|
|
|
|
|
|
|
148
|
0
|
|
|
|
|
|
my $parent = $self->{ParentStack}->[-1]; |
149
|
0
|
0
|
|
|
|
|
$parent->{State} |= ENDS_IN_NON_WS unless $parent->{State} == PRESERVE_WS; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub processing_instruction |
153
|
|
|
|
|
|
|
{ |
154
|
0
|
|
|
0
|
0
|
|
my ($self, $event) = @_; |
155
|
|
|
|
|
|
|
|
156
|
0
|
|
|
|
|
|
$self->push_event ('processing_instruction', $event); |
157
|
|
|
|
|
|
|
|
158
|
0
|
|
|
|
|
|
my $parent = $self->{ParentStack}->[-1]; |
159
|
0
|
0
|
|
|
|
|
$parent->{State} |= ENDS_IN_NON_WS unless $parent->{State} == PRESERVE_WS; |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
sub start_document |
163
|
|
|
|
|
|
|
{ |
164
|
0
|
|
|
0
|
0
|
|
my ($self, $event) = @_; |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
# Initialize initial state |
167
|
0
|
|
|
|
|
|
$self->{ParentStack} = []; |
168
|
0
|
|
|
|
|
|
$self->{EventQ} = []; |
169
|
0
|
|
|
|
|
|
$self->{InCDATA} = 0; |
170
|
|
|
|
|
|
|
|
171
|
0
|
|
|
|
|
|
$self->init_handlers; |
172
|
|
|
|
|
|
|
|
173
|
0
|
0
|
|
|
|
|
$event = {} unless defined $event; |
174
|
|
|
|
|
|
|
# Don't preserve WS by default (unless specified by the user) |
175
|
0
|
0
|
|
|
|
|
$event->{PreserveWS} = defined ($self->{PreserveWS}) ? |
176
|
|
|
|
|
|
|
$self->{PreserveWS} : 0; |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
# We don't need whitespace detection at the document level |
179
|
0
|
|
|
|
|
|
$event->{State} = PRESERVE_WS; |
180
|
|
|
|
|
|
|
|
181
|
0
|
|
|
|
|
|
$self->push_event ('start_document', $event); |
182
|
0
|
|
|
|
|
|
push @{ $self->{ParentStack} }, $event; |
|
0
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
sub end_document |
186
|
|
|
|
|
|
|
{ |
187
|
0
|
|
|
0
|
0
|
|
my ($self, $event) = @_; |
188
|
0
|
0
|
|
|
|
|
$event = {} unless defined $event; |
189
|
|
|
|
|
|
|
|
190
|
0
|
|
|
|
|
|
$self->push_event ('end_document', $event); |
191
|
|
|
|
|
|
|
|
192
|
0
|
|
|
|
|
|
$self->flush; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
sub start_element |
196
|
|
|
|
|
|
|
{ |
197
|
0
|
|
|
0
|
0
|
|
my ($self, $event) = @_; |
198
|
|
|
|
|
|
|
|
199
|
0
|
|
|
|
|
|
my $pres = $event->{Attributes}->{'xml:space'}; |
200
|
0
|
0
|
|
|
|
|
if (defined $pres) |
201
|
|
|
|
|
|
|
{ |
202
|
0
|
|
|
|
|
|
$event->{PreserveWS} = $pres eq "preserve"; |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
else |
205
|
|
|
|
|
|
|
{ |
206
|
0
|
|
|
|
|
|
$event->{PreserveWS} = $self->{ParentStack}->[-1]->{PreserveWS}; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
0
|
0
|
|
|
|
|
if ($self->{NoText}->{ $event->{Name} }) |
210
|
|
|
|
|
|
|
{ |
211
|
0
|
|
|
|
|
|
$event->{NoText} = 1; |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
|
214
|
0
|
|
|
|
|
|
$event->{State} = $self->get_init_state ($event); |
215
|
|
|
|
|
|
|
|
216
|
0
|
|
|
|
|
|
$self->push_event ('start_element', $event); |
217
|
0
|
|
|
|
|
|
push @{ $self->{ParentStack} }, $event; |
|
0
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
sub end_element |
221
|
|
|
|
|
|
|
{ |
222
|
0
|
|
|
0
|
0
|
|
my ($self, $event) = @_; |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
# Mark previous whitespace event as the last event (WS_END) |
225
|
|
|
|
|
|
|
# (if it's there) |
226
|
0
|
|
|
|
|
|
my $prev = $self->{EventQ}->[-1]; |
227
|
0
|
0
|
|
|
|
|
$prev->{Loc} |= WS_END if exists $prev->{Loc}; |
228
|
|
|
|
|
|
|
|
229
|
0
|
|
|
|
|
|
$self->push_event ('end_element', $event); |
230
|
|
|
|
|
|
|
|
231
|
0
|
|
|
|
|
|
my $elem = pop @{ $self->{ParentStack} }; |
|
0
|
|
|
|
|
|
|
232
|
0
|
|
|
|
|
|
delete $elem->{State}; |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
sub characters |
236
|
|
|
|
|
|
|
{ |
237
|
0
|
|
|
0
|
0
|
|
my ($self, $event) = @_; |
238
|
|
|
|
|
|
|
|
239
|
0
|
0
|
|
|
|
|
if ($self->{InCDATA}) |
240
|
|
|
|
|
|
|
{ |
241
|
|
|
|
|
|
|
# NOTE: 'cdata' is not a valid PerlSAX callback |
242
|
0
|
|
|
|
|
|
$self->push_event ('cdata', $event); |
243
|
|
|
|
|
|
|
|
244
|
0
|
|
|
|
|
|
my $parent = $self->{ParentStack}->[-1]; |
245
|
0
|
0
|
|
|
|
|
$parent->{State} |= ENDS_IN_NON_WS unless $parent->{State} == PRESERVE_WS; |
246
|
0
|
|
|
|
|
|
return; |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
0
|
|
|
|
|
|
my $text = $event->{Data}; |
250
|
0
|
0
|
|
|
|
|
return unless length ($text); |
251
|
|
|
|
|
|
|
|
252
|
0
|
|
|
|
|
|
my $state = $self->{ParentStack}->[-1]->{State}; |
253
|
0
|
0
|
|
|
|
|
if ($state == PRESERVE_WS) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
254
|
|
|
|
|
|
|
{ |
255
|
0
|
|
|
|
|
|
$self->push_event ('characters', $event); |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
elsif ($state == NO_TEXT_START) |
258
|
|
|
|
|
|
|
{ |
259
|
|
|
|
|
|
|
# ELEMENT model does not allow regular text. |
260
|
|
|
|
|
|
|
# All characters are whitespace. |
261
|
0
|
|
|
|
|
|
$self->push_event ('ignorable_whitespace', { Data => $text, Loc => WS_START }); |
262
|
0
|
|
|
|
|
|
$state = NO_TEXT_ONLY_WS; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
elsif ($state == NO_TEXT_ONLY_WS) |
265
|
|
|
|
|
|
|
{ |
266
|
0
|
|
|
|
|
|
$self->merge_text ($text, 'ignorable_whitespace', WS_START ); |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
elsif ($state == NO_TEXT_ENDS_IN_NON_WS) |
269
|
|
|
|
|
|
|
{ |
270
|
0
|
|
|
|
|
|
$self->push_event ('ignorable_whitespace', { Data => $text, Loc => WS_INTER }); |
271
|
0
|
|
|
|
|
|
$state = NO_TEXT_ENDS_IN_WS; |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
elsif ($state == NO_TEXT_ENDS_IN_WS) |
274
|
|
|
|
|
|
|
{ |
275
|
0
|
|
|
|
|
|
$self->merge_text ($text, 'ignorable_whitespace', WS_INTER ); |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
elsif ($state == START) |
278
|
|
|
|
|
|
|
{ |
279
|
|
|
|
|
|
|
#?? add support for full Unicode |
280
|
0
|
|
|
|
|
|
$text =~ /^(\s*)(\S(?:.*\S)?)?(\s*)$/; |
281
|
0
|
0
|
|
|
|
|
if (length $1) |
282
|
|
|
|
|
|
|
{ |
283
|
0
|
|
|
|
|
|
$self->push_event ('ws', { Data => $1, Loc => WS_START }); |
284
|
0
|
|
|
|
|
|
$state = ONLY_WS; |
285
|
|
|
|
|
|
|
} |
286
|
0
|
0
|
|
|
|
|
if (length $2) |
287
|
|
|
|
|
|
|
{ |
288
|
0
|
|
|
|
|
|
$self->push_event ('characters', { Data => $2 }); |
289
|
0
|
|
|
|
|
|
$state = ENDS_IN_NON_WS; |
290
|
|
|
|
|
|
|
} |
291
|
0
|
0
|
|
|
|
|
if (length $3) |
292
|
|
|
|
|
|
|
{ |
293
|
0
|
|
|
|
|
|
$self->push_event ('ws', { Data => $3, Loc => WS_INTER }); |
294
|
0
|
|
|
|
|
|
$state = ENDS_IN_WS; |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
elsif ($state == ONLY_WS) |
298
|
|
|
|
|
|
|
{ |
299
|
0
|
|
|
|
|
|
$text =~ /^(\s*)(\S(?:.*\S)?)?(\s*)$/; |
300
|
0
|
0
|
|
|
|
|
if (length $1) |
301
|
|
|
|
|
|
|
{ |
302
|
0
|
|
|
|
|
|
$self->merge_text ($1, 'ws', WS_START); |
303
|
|
|
|
|
|
|
} |
304
|
0
|
0
|
|
|
|
|
if (length $2) |
305
|
|
|
|
|
|
|
{ |
306
|
0
|
|
|
|
|
|
$self->push_event ('characters', { Data => $2 }); |
307
|
0
|
|
|
|
|
|
$state = ENDS_IN_NON_WS; |
308
|
|
|
|
|
|
|
} |
309
|
0
|
0
|
|
|
|
|
if (length $3) |
310
|
|
|
|
|
|
|
{ |
311
|
0
|
|
|
|
|
|
$self->push_event ('ws', { Data => $3, Loc => WS_INTER }); |
312
|
0
|
|
|
|
|
|
$state = ENDS_IN_WS; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
else # state == ENDS_IN_WS or ENDS_IN_NON_WS |
316
|
|
|
|
|
|
|
{ |
317
|
0
|
|
|
|
|
|
$text =~ /^(.*\S)?(\s*)$/; |
318
|
0
|
0
|
|
|
|
|
if (length $1) |
319
|
|
|
|
|
|
|
{ |
320
|
0
|
0
|
|
|
|
|
if ($state == ENDS_IN_NON_WS) |
321
|
|
|
|
|
|
|
{ |
322
|
0
|
|
|
|
|
|
$self->merge_text ($1, 'characters'); |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
else |
325
|
|
|
|
|
|
|
{ |
326
|
0
|
|
|
|
|
|
$self->push_event ('characters', { Data => $1 }); |
327
|
0
|
|
|
|
|
|
$state = ENDS_IN_NON_WS; |
328
|
|
|
|
|
|
|
} |
329
|
|
|
|
|
|
|
} |
330
|
0
|
0
|
|
|
|
|
if (length $2) |
331
|
|
|
|
|
|
|
{ |
332
|
0
|
0
|
|
|
|
|
if ($state == ENDS_IN_WS) |
333
|
|
|
|
|
|
|
{ |
334
|
0
|
|
|
|
|
|
$self->merge_text ($2, 'ws', WS_INTER); |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
else |
337
|
|
|
|
|
|
|
{ |
338
|
0
|
|
|
|
|
|
$self->push_event ('ws', { Data => $2, Loc => WS_INTER }); |
339
|
0
|
|
|
|
|
|
$state = ENDS_IN_WS; |
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
} |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
0
|
|
|
|
|
|
$self->{ParentStack}->[-1]->{State} = $state; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
sub element_decl |
348
|
|
|
|
|
|
|
{ |
349
|
0
|
|
|
0
|
0
|
|
my ($self, $event) = @_; |
350
|
0
|
|
|
|
|
|
my $tag = $event->{Name}; |
351
|
0
|
|
|
|
|
|
my $model = $event->{Model}; |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
# Check the model to see if the elements may contain regular text |
354
|
0
|
|
0
|
|
|
|
$self->{NoText}->{$tag} = ($model eq 'EMPTY' || $model !~ /\#PCDATA/); |
355
|
|
|
|
|
|
|
|
356
|
0
|
|
|
|
|
|
$self->push_event ('element_decl', $event); |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
sub attlist_decl |
360
|
|
|
|
|
|
|
{ |
361
|
0
|
|
|
0
|
0
|
|
my ($self, $event) = @_; |
362
|
|
|
|
|
|
|
|
363
|
0
|
|
|
|
|
|
my $prev = $self->{EventQ}->[-1]; |
364
|
0
|
0
|
0
|
|
|
|
if ($prev->{EventType} eq 'attlist_decl' && |
365
|
|
|
|
|
|
|
$prev->{ElementName} eq $event->{ElementName}) |
366
|
|
|
|
|
|
|
{ |
367
|
0
|
|
|
|
|
|
$prev->{MoreFollow} = 1; |
368
|
0
|
|
|
|
|
|
$event->{First} = 0; |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
else |
371
|
|
|
|
|
|
|
{ |
372
|
0
|
|
|
|
|
|
$event->{First} = 1; |
373
|
|
|
|
|
|
|
} |
374
|
|
|
|
|
|
|
|
375
|
0
|
|
|
|
|
|
$self->push_event ('attlist_decl', $event); |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
sub notation_decl |
379
|
|
|
|
|
|
|
{ |
380
|
0
|
|
|
0
|
0
|
|
my ($self, $event) = @_; |
381
|
0
|
|
|
|
|
|
$self->push_event ('notation_decl', $event); |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
sub unparsed_entity_decl |
385
|
|
|
|
|
|
|
{ |
386
|
0
|
|
|
0
|
0
|
|
my ($self, $event) = @_; |
387
|
0
|
|
|
|
|
|
$self->push_event ('unparsed_entity_decl', $event); |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
sub entity_decl |
391
|
|
|
|
|
|
|
{ |
392
|
0
|
|
|
0
|
0
|
|
my ($self, $event) = @_; |
393
|
0
|
|
|
|
|
|
$self->push_event ('entity_decl', $event); |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
sub doctype_decl |
397
|
|
|
|
|
|
|
{ |
398
|
0
|
|
|
0
|
0
|
|
my ($self, $event) = @_; |
399
|
0
|
|
|
|
|
|
$self->push_event ('doctype_decl', $event); |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
sub xml_decl |
403
|
|
|
|
|
|
|
{ |
404
|
0
|
|
|
0
|
0
|
|
my ($self, $event) = @_; |
405
|
0
|
|
|
|
|
|
$self->push_event ('xml_decl', $event); |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
#?? what about set_document_locator, resolve_entity |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
# |
411
|
|
|
|
|
|
|
# Determine the initial State for the current Element. |
412
|
|
|
|
|
|
|
# By default, we look at the PreserveWS property (i.e. value of xml:space.) |
413
|
|
|
|
|
|
|
# The user can override this to force xml:space="preserve" for a particular |
414
|
|
|
|
|
|
|
# element with e.g. |
415
|
|
|
|
|
|
|
# |
416
|
|
|
|
|
|
|
# sub get_init_state |
417
|
|
|
|
|
|
|
# { |
418
|
|
|
|
|
|
|
# my ($self, $event) = @_; |
419
|
|
|
|
|
|
|
# ($event->{Name} eq 'foo' || $event->{PreserveWS}) ? PRESERVE_WS : START; |
420
|
|
|
|
|
|
|
# } |
421
|
|
|
|
|
|
|
# |
422
|
|
|
|
|
|
|
sub get_init_state |
423
|
|
|
|
|
|
|
{ |
424
|
0
|
|
|
0
|
0
|
|
my ($self, $event) = @_; |
425
|
0
|
|
|
|
|
|
my $tag = $event->{Name}; |
426
|
|
|
|
|
|
|
|
427
|
0
|
0
|
|
|
|
|
if ($self->{NoText}->{$tag}) # ELEMENT model does not allow text |
428
|
|
|
|
|
|
|
{ |
429
|
0
|
|
|
|
|
|
return NO_TEXT_START; |
430
|
|
|
|
|
|
|
} |
431
|
0
|
0
|
|
|
|
|
$event->{PreserveWS} ? PRESERVE_WS : START; |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
sub push_event |
435
|
|
|
|
|
|
|
{ |
436
|
0
|
|
|
0
|
0
|
|
my ($self, $type, $event) = @_; |
437
|
|
|
|
|
|
|
|
438
|
0
|
|
|
|
|
|
$event->{EventType} = $type; |
439
|
|
|
|
|
|
|
|
440
|
0
|
|
|
|
|
|
$self->flush; |
441
|
0
|
|
|
|
|
|
push @{ $self->{EventQ} }, $event; |
|
0
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
} |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
# Merge text with previous event (if it has the same EventType) |
445
|
|
|
|
|
|
|
# or push a new text event |
446
|
|
|
|
|
|
|
sub merge_text |
447
|
|
|
|
|
|
|
{ |
448
|
0
|
|
|
0
|
0
|
|
my ($self, $str, $eventType, $wsLocation) = @_; |
449
|
0
|
|
|
|
|
|
my $q = $self->{EventQ}; |
450
|
|
|
|
|
|
|
|
451
|
0
|
|
|
|
|
|
my $prev = $q->[-1]; |
452
|
0
|
0
|
0
|
|
|
|
if (defined $prev && $prev->{EventType} eq $eventType) |
453
|
|
|
|
|
|
|
{ |
454
|
0
|
|
|
|
|
|
$prev->{Data} .= $str; |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
else |
457
|
|
|
|
|
|
|
{ |
458
|
0
|
|
|
|
|
|
my $event = { Data => $str }; |
459
|
0
|
0
|
|
|
|
|
$event->{Loc} = $wsLocation if defined $wsLocation; |
460
|
0
|
|
|
|
|
|
$self->push_event ($eventType, $event); |
461
|
|
|
|
|
|
|
} |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
# Forward all events on the EventQ |
465
|
|
|
|
|
|
|
sub flush |
466
|
|
|
|
|
|
|
{ |
467
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
468
|
|
|
|
|
|
|
|
469
|
0
|
|
|
|
|
|
my $q = $self->{EventQ}; |
470
|
0
|
|
|
|
|
|
while (@$q) |
471
|
|
|
|
|
|
|
{ |
472
|
0
|
|
|
|
|
|
my $event = shift @$q; |
473
|
0
|
|
|
|
|
|
my $type = $event->{EventType}; |
474
|
0
|
|
|
|
|
|
delete $event->{EventType}; |
475
|
|
|
|
|
|
|
|
476
|
0
|
|
|
|
|
|
$self->{Callback}->{$type}->($event); |
477
|
|
|
|
|
|
|
} |
478
|
|
|
|
|
|
|
} |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
1; # package return code |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
__END__ |