1 # |
|
2 # |
|
3 # TO DO |
|
4 # - update docs regarding PerlSAX interface |
|
5 # - add current node to error context when checking DOM subtrees |
|
6 # - add parsed Entity to test XML files |
|
7 # - free circular references |
|
8 # - Implied handler? |
|
9 # - Notation, Entity, Unparsed checks, Default handler? |
|
10 # - check no root element (it's checked by expat) ? |
|
11 |
|
12 package XML::Checker::Term; |
|
13 use strict; |
|
14 |
|
15 sub new |
|
16 { |
|
17 my ($class, %h) = @_; |
|
18 bless \%h, $class; |
|
19 } |
|
20 |
|
21 sub str |
|
22 { |
|
23 '<' . $_[0]->{C} . $_[0]->{N} . '>' |
|
24 } |
|
25 |
|
26 sub re |
|
27 { |
|
28 $_[0]->{S} |
|
29 } |
|
30 |
|
31 sub rel |
|
32 { |
|
33 my $self = shift; |
|
34 defined $self->{SL} ? @{ $self->{SL} } : ( $self->{S} ); |
|
35 } |
|
36 |
|
37 sub debug |
|
38 { |
|
39 my $t = shift; |
|
40 my ($c, $n, $s) = ($t->{C}, $t->{N}, $t->{S}); |
|
41 my @sl = $t->rel; |
|
42 "{C=$c N=$n S=$s SL=@sl}"; |
|
43 } |
|
44 |
|
45 #------------------------------------------------------------------------- |
|
46 |
|
47 package XML::Checker::Context; |
|
48 |
|
49 sub new |
|
50 { |
|
51 my ($class) = @_; |
|
52 my $scalar; |
|
53 bless \$scalar, $class; |
|
54 } |
|
55 |
|
56 sub Start {} |
|
57 sub End {} |
|
58 sub Char {} |
|
59 |
|
60 # |
|
61 # The initial Context when checking an entire XML Document |
|
62 # |
|
63 package XML::Checker::DocContext; |
|
64 use vars qw( @ISA ); |
|
65 @ISA = qw( XML::Checker::Context ); |
|
66 |
|
67 sub new |
|
68 { |
|
69 #??checker not used |
|
70 my ($class, $checker) = @_; |
|
71 bless { }, $class; |
|
72 } |
|
73 |
|
74 sub setRootElement |
|
75 { |
|
76 $_[0]->{RootElement} = $_[1]; |
|
77 } |
|
78 |
|
79 sub Start |
|
80 { |
|
81 my ($self, $checker, $tag) = @_; |
|
82 if (exists $self->{Elem}) |
|
83 { |
|
84 my $tags = join (", ", @{$self->{Elem}}); |
|
85 $checker->fail (155, "more than one root Element [$tags]"); |
|
86 push @{$self->{Elem}}, $tag; |
|
87 } |
|
88 else |
|
89 { |
|
90 $self->{Elem} = [ $tag ]; |
|
91 } |
|
92 |
|
93 my $exp_root = $self->{RootElement}; |
|
94 $checker->fail (156, "unexpected root Element [$tag], expected [$exp_root]") |
|
95 if defined ($exp_root) and $tag ne $exp_root; |
|
96 } |
|
97 |
|
98 sub debug |
|
99 { |
|
100 my $self = shift; |
|
101 "DocContext[Count=" . $self->{Count} . ",Root=" . |
|
102 $self->{RootElement} . "]"; |
|
103 } |
|
104 |
|
105 package XML::Checker::Context::ANY; |
|
106 use vars qw( @ISA ); |
|
107 @ISA = qw( XML::Checker::Context ); |
|
108 |
|
109 # No overrides, because everything is accepted |
|
110 |
|
111 sub debug { "XML::Checker::Context::ANY" } |
|
112 |
|
113 package XML::Checker::Context::EMPTY; |
|
114 use vars qw( @ISA $ALLOW_WHITE_SPACE ); |
|
115 @ISA = qw( XML::Checker::Context ); |
|
116 |
|
117 $ALLOW_WHITE_SPACE = 0; |
|
118 |
|
119 sub debug { "XML::Checker::Context::EMPTY" } |
|
120 |
|
121 sub Start |
|
122 { |
|
123 my ($self, $checker, $tag) = @_; |
|
124 $checker->fail (152, "Element should be EMPTY, found Element [$tag]"); |
|
125 } |
|
126 |
|
127 sub Char |
|
128 { |
|
129 my ($self, $checker, $str) = @_; |
|
130 $checker->fail (153, "Element should be EMPTY, found text [$str]") |
|
131 unless ($ALLOW_WHITE_SPACE and $checker->isWS ($str)); |
|
132 |
|
133 # NOTE: if $ALLOW_WHITE_SPACE = 1, the isWS call does not only check |
|
134 # whether it is whitespace, but it also informs the checker that this |
|
135 # might be insignificant whitespace |
|
136 } |
|
137 |
|
138 #?? what about Comments |
|
139 |
|
140 package XML::Checker::Context::Children; |
|
141 use vars qw( @ISA ); |
|
142 @ISA = qw( XML::Checker::Context ); |
|
143 |
|
144 sub new |
|
145 { |
|
146 my ($class, $rule) = @_; |
|
147 bless { Name => $rule->{Name}, RE => $rule->{RE}, Buf => "", N => 0 }, $class; |
|
148 } |
|
149 |
|
150 sub phash |
|
151 { |
|
152 my $href = shift; |
|
153 my $str = ""; |
|
154 for (keys %$href) |
|
155 { |
|
156 $str .= ' ' if $str; |
|
157 $str .= $_ . '=' . $href->{$_}; |
|
158 } |
|
159 $str; |
|
160 } |
|
161 |
|
162 sub debug |
|
163 { |
|
164 my $self = shift; |
|
165 "Context::Children[Name=(" . phash ($self->{Name}) . ",N=" . $self->{N} . |
|
166 ",RE=" . $self->{RE} . ",Buf=[" . $self->{Buf} . "]"; |
|
167 } |
|
168 |
|
169 sub Start |
|
170 { |
|
171 my ($self, $checker, $tag) = @_; |
|
172 |
|
173 #print "Children.Start tag=$tag rule=$checker drule=" . $checker->debug . "\n"; |
|
174 |
|
175 if (exists $self->{Name}->{$tag}) |
|
176 { |
|
177 #print "Buf=[".$self->{Buf}. "] tag=[" . $self->{Name}->{$tag}->{S} . "]\n"; |
|
178 $self->{Buf} .= $self->{Name}->{$tag}->{S}; |
|
179 } |
|
180 else |
|
181 { |
|
182 $checker->fail (157, "unexpected Element [$tag]", |
|
183 ChildElementIndex => $self->{N}) |
|
184 } |
|
185 $self->{N}++; |
|
186 } |
|
187 |
|
188 sub decode |
|
189 { |
|
190 my ($self) = @_; |
|
191 my $re = $self->{RE}; |
|
192 my $name = $self->{Name}; |
|
193 my $buf = $self->{Buf}; |
|
194 |
|
195 my %s = (); |
|
196 while (my ($key, $val) = each %$name) |
|
197 { |
|
198 $s{$val->{S}} = $key; |
|
199 } |
|
200 |
|
201 my ($len) = scalar (keys %$name); |
|
202 $len = length $len; |
|
203 my $dots = "[^()*+?]" x $len; |
|
204 |
|
205 $buf =~ s/($dots)/$s{$1} . ","/ge; |
|
206 chop $buf; |
|
207 |
|
208 $re =~ s/($dots)/"(" . $s{$1} . ")"/ge; |
|
209 |
|
210 "Found=[$buf] RE=[$re]" |
|
211 } |
|
212 |
|
213 sub End |
|
214 { |
|
215 my ($self, $checker) = @_; |
|
216 my $re = $self->{RE}; |
|
217 |
|
218 #print "End " . $self->debug . "\n"; |
|
219 $checker->fail (154, "bad order of Elements " . $self->decode) |
|
220 unless $self->{Buf} =~ /^$re$/; |
|
221 } |
|
222 |
|
223 sub Char |
|
224 { |
|
225 my ($self, $checker, $str) = @_; |
|
226 |
|
227 # Inform the checker that this might be insignificant whitespace |
|
228 $checker->isWS ($str); |
|
229 } |
|
230 |
|
231 package XML::Checker::Context::Mixed; |
|
232 use vars qw( @ISA ); |
|
233 @ISA = qw( XML::Checker::Context ); |
|
234 |
|
235 sub new |
|
236 { |
|
237 my ($class, $rule) = @_; |
|
238 bless { Name => $rule->{Name}, N => 0 }, $class; |
|
239 } |
|
240 |
|
241 sub debug |
|
242 { |
|
243 my $self = shift; |
|
244 "Context::Mixed[Name=" . $self->{Name} . ",N=" , $self->{N} . "]"; |
|
245 } |
|
246 |
|
247 sub Start |
|
248 { |
|
249 my ($self, $checker, $tag) = @_; |
|
250 |
|
251 $checker->fail (157, "unexpected Element [$tag]", |
|
252 ChildElementIndex => $self->{N}) |
|
253 unless exists $self->{Name}->{$tag}; |
|
254 $self->{N}++; |
|
255 } |
|
256 |
|
257 package XML::Checker::ERule; |
|
258 |
|
259 package XML::Checker::ERule::EMPTY; |
|
260 use vars qw( @ISA ); |
|
261 @ISA = qw( XML::Checker::ERule ); |
|
262 |
|
263 sub new |
|
264 { |
|
265 my ($class) = @_; |
|
266 bless {}, $class; |
|
267 } |
|
268 |
|
269 my $context = new XML::Checker::Context::EMPTY; |
|
270 sub context { $context } # share the context |
|
271 |
|
272 sub debug { "EMPTY" } |
|
273 |
|
274 package XML::Checker::ERule::ANY; |
|
275 use vars qw( @ISA ); |
|
276 @ISA = qw( XML::Checker::ERule ); |
|
277 |
|
278 sub new |
|
279 { |
|
280 my ($class) = @_; |
|
281 bless {}, $class; |
|
282 } |
|
283 |
|
284 my $any_context = new XML::Checker::Context::ANY; |
|
285 sub context { $any_context } # share the context |
|
286 |
|
287 sub debug { "ANY" } |
|
288 |
|
289 package XML::Checker::ERule::Mixed; |
|
290 use vars qw( @ISA ); |
|
291 @ISA = qw( XML::Checker::ERule ); |
|
292 |
|
293 sub new |
|
294 { |
|
295 my ($class) = @_; |
|
296 bless { Name => {} }, $class; |
|
297 } |
|
298 |
|
299 sub context |
|
300 { |
|
301 my ($self) = @_; |
|
302 new XML::Checker::Context::Mixed ($self); |
|
303 } |
|
304 |
|
305 sub setModel |
|
306 { |
|
307 my ($self, $model) = @_; |
|
308 my $rule = $model; |
|
309 |
|
310 # Mixed := '(' '#PCDATA' ')' '*'? |
|
311 if ($rule =~ /^\(\s*#PCDATA\s*\)(\*)?$/) |
|
312 { |
|
313 #? how do we interpret the '*' ?? |
|
314 return 1; |
|
315 } |
|
316 else # Mixed := '(' '#PCDATA' ('|' Name)* ')*' |
|
317 { |
|
318 return 0 unless $rule =~ s/^\(\s*#PCDATA\s*//; |
|
319 return 0 unless $rule =~ s/\s*\)\*$//; |
|
320 |
|
321 my %names = (); |
|
322 while ($rule =~ s/^\s*\|\s*($XML::RegExp::Name)//) |
|
323 { |
|
324 $names{$1} = 1; |
|
325 } |
|
326 if ($rule eq "") |
|
327 { |
|
328 $self->{Name} = \%names; |
|
329 return 1; |
|
330 } |
|
331 } |
|
332 return 0; |
|
333 } |
|
334 |
|
335 sub debug |
|
336 { |
|
337 my ($self) = @_; |
|
338 "Mixed[Names=" . join("|", keys %{$self->{Name}}) . "]"; |
|
339 } |
|
340 |
|
341 package XML::Checker::ERule::Children; |
|
342 use vars qw( @ISA %_name %_map $_n ); |
|
343 @ISA = qw( XML::Checker::ERule ); |
|
344 |
|
345 sub new |
|
346 { |
|
347 my ($class) = @_; |
|
348 bless {}, $class; |
|
349 } |
|
350 |
|
351 sub context |
|
352 { |
|
353 my ($self) = @_; |
|
354 new XML::Checker::Context::Children ($self); |
|
355 } |
|
356 |
|
357 sub _add # static |
|
358 { |
|
359 my $exp = new XML::Checker::Term (@_); |
|
360 $_map{$exp->{N}} = $exp; |
|
361 $exp->str; |
|
362 } |
|
363 |
|
364 my $IDS = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"; |
|
365 |
|
366 sub _tokenize |
|
367 { |
|
368 my ($self, $rule) = @_; |
|
369 |
|
370 # Replace names with Terms of the form "<n#>", e.g. "<n2>". |
|
371 # Lookup already used names and store new names in %_name. |
|
372 # |
|
373 $$rule =~ s/($XML::RegExp::Name)(?!>)/ |
|
374 if (exists $_name{$1}) # name already used? |
|
375 { |
|
376 $_name{$1}->str; |
|
377 } |
|
378 else |
|
379 { |
|
380 my $exp = new XML::Checker::Term (C => 'n', N => $_n++, |
|
381 Name => $1); |
|
382 $_name{$1} = $_map{$exp->{N}} = $exp; |
|
383 $exp->str; |
|
384 } |
|
385 /eg; |
|
386 |
|
387 if ($_n < length $IDS) |
|
388 { |
|
389 # Generate regular expression for the name Term, i.e. |
|
390 # a single character from $IDS |
|
391 my $i = 0; |
|
392 for (values %_name) |
|
393 { |
|
394 $_->{S} = substr ($IDS, $i++, 1); |
|
395 #print "tokenized " . $_->{Name} . " num=" . $_->{N} . " to " . $_->{S} . "\n"; |
|
396 } |
|
397 } |
|
398 else |
|
399 { |
|
400 # Generate RE, convert Term->{N} to hex string a la "(#)", |
|
401 # e.g. "(03d)". Calculate needed length of hex string first. |
|
402 my $len = 1; |
|
403 for (my $n = $_n - 1; ($n >> 4) > 0; $len++) {} |
|
404 |
|
405 my $i = 0; |
|
406 for (values %_name) |
|
407 { |
|
408 $_->{S} = sprintf ("(0${len}lx)", $i++); |
|
409 #print "tokenized " . $_->{Name} . " num=" . $_->{N} . " to " . $_->{S} . "\n"; |
|
410 } |
|
411 } |
|
412 } |
|
413 |
|
414 sub setModel |
|
415 { |
|
416 my ($self, $rule) = @_; |
|
417 |
|
418 local $_n = 0; |
|
419 local %_map = (); |
|
420 local %_name = (); |
|
421 |
|
422 $self->_tokenize (\$rule); |
|
423 |
|
424 #?? check for single name - die "!ELEMENT contents can't be just a NAME" if $rule =~ /^$XML::RegExp::Name$/; |
|
425 |
|
426 for ($rule) |
|
427 { |
|
428 my $n = 1; |
|
429 while ($n) |
|
430 { |
|
431 $n = 0; |
|
432 |
|
433 # cp := ( name | choice | seq ) ('?' | '*' | '+')? |
|
434 $n++ while s/<[ncs](\d+)>([?*+]?)/_add |
|
435 (C => 'a', N => $_n++, |
|
436 S => ($_map{$1}->re . $2))/eg; |
|
437 |
|
438 # choice := '(' ch_l ')' |
|
439 $n++ while s/\(\s*<[ad](\d+)>\s*\)/_add |
|
440 (C => 'c', N => $_n++, |
|
441 S => "(" . join ("|", $_map{$1}->rel) . ")")/eg; |
|
442 |
|
443 # ch_l := ( cp | ch_l ) '|' ( cp | ch_l ) |
|
444 $n++ while s/<[ad](\d+)>\s*\|\s*<[ad](\d+)>/_add |
|
445 (C => 'd', N => $_n++, |
|
446 SL => [ $_map{$1}->rel, $_map{$2}->rel ])/eg; |
|
447 |
|
448 # seq := '(' (seq_l ')' |
|
449 $n++ while s/\(\s*<[at](\d+)>\s*\)/_add |
|
450 (C => 's', N => $_n++, |
|
451 S => "(".join("", $_map{$1}->rel).")")/eg; |
|
452 |
|
453 # seq_l := ( cp | seq_l ) ',' ( cp | seq_l ) |
|
454 $n++ while s/<[at](\d+)>\s*,\s*<[at](\d+)>/_add |
|
455 (C => 't', N => $_n++, |
|
456 SL => [ $_map{$1}->rel, $_map{$2}->rel ])/eg; |
|
457 } |
|
458 } |
|
459 |
|
460 return 0 if ($rule !~ /^<a(\d+)>$/); |
|
461 |
|
462 $self->{Name} = \%_name; |
|
463 $self->{RE} = $_map{$1}->re; |
|
464 |
|
465 return 1; |
|
466 } |
|
467 |
|
468 sub debug |
|
469 { |
|
470 my ($self) = @_; |
|
471 "Children[RE=" . $self->{RE} . "]"; |
|
472 } |
|
473 |
|
474 |
|
475 package XML::Checker::ARule; |
|
476 use XML::RegExp; |
|
477 |
|
478 sub new |
|
479 { |
|
480 my ($class, $elem, $checker) = @_; |
|
481 bless { Elem => $elem, Checker => $checker, Required => {} }, $class; |
|
482 } |
|
483 |
|
484 sub Attlist |
|
485 { |
|
486 my ($self, $attr, $type, $default, $fixed, $checker) = @_; |
|
487 my ($c1, $c2); |
|
488 |
|
489 if ($self->{Defined}->{$attr}) |
|
490 { |
|
491 my $tag = $self->{Elem}; |
|
492 $self->fail ($attr, 110, "attribute [$attr] of element [$tag] already defined"); |
|
493 } |
|
494 else |
|
495 { |
|
496 $self->{Defined}->{$attr} = 1; |
|
497 } |
|
498 |
|
499 if ($default =~ /^\#(REQUIRED|IMPLIED)$/) |
|
500 { |
|
501 $c1 = $1; |
|
502 |
|
503 # Keep list of all required attributes |
|
504 if ($default eq '#REQUIRED') |
|
505 { |
|
506 $self->{Required}->{$attr} = 1; |
|
507 } |
|
508 } |
|
509 else |
|
510 { |
|
511 $self->fail ($attr, 122, "invalid default attribute value [$default]") |
|
512 unless $default =~ /^$XML::RegExp::AttValue$/; |
|
513 |
|
514 $default = substr ($default, 1, length($default)-2); |
|
515 $self->{Default}->{$attr} = $default; |
|
516 $c1 = 'FIXED' if $fixed; |
|
517 } |
|
518 |
|
519 if ($type eq 'ID') |
|
520 { |
|
521 $self->fail ($attr, 123, "invalid default ID [$default], must be #REQUIRED or #IMPLIED") |
|
522 unless $default =~ /^#(REQUIRED|IMPLIED)$/; |
|
523 |
|
524 if (exists ($self->{ID}) && $self->{ID} ne $attr) |
|
525 { |
|
526 $self->fail ($attr, 151, "only one ID allowed per ELEMENT " . |
|
527 "first=[" . $self->{ID} . "]"); |
|
528 } |
|
529 else |
|
530 { |
|
531 $self->{ID} = $attr; |
|
532 } |
|
533 $c2 = 'ID'; |
|
534 } |
|
535 elsif ($type =~ /^(IDREF|IDREFS|ENTITY|ENTITIES|NMTOKEN|NMTOKENS)$/) |
|
536 { |
|
537 my $def = $self->{Default}->{$attr}; |
|
538 if (defined $def) |
|
539 { |
|
540 my $re = ($type =~ /^[IE]/) ? $XML::RegExp::Name : $XML::RegExp::NmToken; |
|
541 if ($type =~ /S$/) |
|
542 { |
|
543 for (split (/\s+/, $def)) |
|
544 { |
|
545 $self->fail ($attr, 121, |
|
546 "invalid default [$_] in $type [$def]") |
|
547 unless $_ =~ /^$re$/; |
|
548 } |
|
549 } |
|
550 else # singular |
|
551 { |
|
552 $self->fail ($attr, 120, "invalid default $type [$def]") |
|
553 unless $def =~ /^$re$/; |
|
554 } |
|
555 } |
|
556 $c2 = $type; |
|
557 } |
|
558 elsif ($type ne 'CDATA') # Enumerated := NotationType | Enumeration |
|
559 { |
|
560 if ($type =~ /^\s*NOTATION\s*\(\s*($XML::RegExp::Name(\s*\|\s*$XML::RegExp::Name)*)\s*\)\s*$/) |
|
561 { |
|
562 $self->fail ($attr, 135, "empty NOTATION list in ATTLIST") |
|
563 unless defined $1; |
|
564 |
|
565 my @tok = split (/\s*\|\s*/, $1); |
|
566 for (@tok) |
|
567 { |
|
568 $self->fail ($attr, 100, "undefined NOTATION [$_] in ATTLIST") |
|
569 unless exists $checker->{NOTATION}->{$_}; |
|
570 } |
|
571 |
|
572 my $re = join ("|", @tok); |
|
573 $self->{NotationRE} = "^($re)\$"; |
|
574 $c2 = 'NotationType'; |
|
575 } |
|
576 elsif ($type =~ /^\s*\(\s*($XML::RegExp::NmToken(\s*\|\s*$XML::RegExp::NmToken)*)\s*\)\s*$/) |
|
577 { |
|
578 # Enumeration |
|
579 |
|
580 $self->fail ($attr, 136, "empty Enumeration list in ATTLIST") |
|
581 unless defined $1; |
|
582 |
|
583 my @tok = split (/\s*\|\s*/, $1); |
|
584 for (@tok) |
|
585 { |
|
586 $self->fail ($attr, 134, |
|
587 "invalid Enumeration value [$_] in ATTLIST") |
|
588 unless $_ =~ /^$XML::RegExp::NmToken$/; |
|
589 } |
|
590 $self->{EnumRE}->{$attr} = '^(' . join ("|", @tok) . ')$'; #'; |
|
591 $c2 = 'Enumeration'; |
|
592 } |
|
593 else |
|
594 { |
|
595 $self->fail ($attr, 137, "invalid ATTLIST type [$type]"); |
|
596 } |
|
597 } |
|
598 |
|
599 $self->{Check1}->{$attr} = $c1 if $c1; |
|
600 $self->{Check2}->{$attr} = $c2 if $c2; |
|
601 } |
|
602 |
|
603 sub fail |
|
604 { |
|
605 my $self = shift; |
|
606 my $attr = shift; |
|
607 $self->{Checker}->fail (@_, Element => $self->{Elem}, Attr => $attr); |
|
608 } |
|
609 |
|
610 sub check |
|
611 { |
|
612 my ($self, $attr) = @_; |
|
613 my $func1 = $self->{Check1}->{$attr}; |
|
614 my $func2 = $self->{Check2}->{$attr}; |
|
615 # print "check func1=$func1 func2=$func2 @_\n"; |
|
616 |
|
617 if (exists $self->{ReqNotSeen}->{$attr}) |
|
618 { |
|
619 delete $self->{ReqNotSeen}->{$attr}; |
|
620 } |
|
621 no strict; |
|
622 |
|
623 &$func1 (@_) if defined $func1; |
|
624 &$func2 (@_) if defined $func2; |
|
625 } |
|
626 |
|
627 # Copies the list of all required attributes from $self->{Required} to |
|
628 # $self->{ReqNotSeen}. |
|
629 # When check() encounters a required attribute, it is removed from ReqNotSeen. |
|
630 # In EndAttr we look at which attribute names are still in ReqNotSeen - those |
|
631 # are the ones that were not specified and are, therefore, in error. |
|
632 sub StartAttr |
|
633 { |
|
634 my $self = shift; |
|
635 my %not_seen = %{ $self->{Required} }; |
|
636 $self->{ReqNotSeen} = \%not_seen; |
|
637 } |
|
638 |
|
639 # Checks which of the #REQUIRED attributes were not specified |
|
640 sub EndAttr |
|
641 { |
|
642 my $self = shift; |
|
643 |
|
644 for my $attr (keys %{ $self->{ReqNotSeen} }) |
|
645 { |
|
646 $self->fail ($attr, 159, |
|
647 "unspecified value for \#REQUIRED attribute [$attr]"); |
|
648 } |
|
649 } |
|
650 |
|
651 sub FIXED |
|
652 { |
|
653 my ($self, $attr, $val, $specified) = @_; |
|
654 |
|
655 my $default = $self->{Default}->{$attr}; |
|
656 $self->fail ($attr, 150, |
|
657 "bad \#FIXED attribute value [$val], it should be [$default]") |
|
658 unless ($val eq $default); |
|
659 } |
|
660 |
|
661 sub IMPLIED |
|
662 { |
|
663 my ($self, $attr, $val, $specified) = @_; |
|
664 |
|
665 #?? should #IMPLIED be specified? |
|
666 $self->fail ($attr, 158, |
|
667 "unspecified value for \#IMPLIED attribute [$attr]") |
|
668 unless $specified; |
|
669 |
|
670 #?? Implied handler ? |
|
671 } |
|
672 |
|
673 # This is called when an attribute is passed to the check() method by |
|
674 # XML::Checker::Attr(), i.e. when the attribute was specified explicitly |
|
675 # or defaulted by the parser (which should never happen), *NOT* when the |
|
676 # attribute was omitted. (The latter is checked by StartAttr/EndAttr) |
|
677 sub REQUIRED |
|
678 { |
|
679 my ($self, $attr, $val, $specified) = @_; |
|
680 # print "REQUIRED attr=$attr val=$val spec=$specified\n"; |
|
681 |
|
682 $self->fail ($attr, 159, |
|
683 "unspecified value for \#REQUIRED attribute [$attr]") |
|
684 unless $specified; |
|
685 } |
|
686 |
|
687 sub ID # must be #IMPLIED or #REQUIRED |
|
688 { |
|
689 my ($self, $attr, $val, $specified) = @_; |
|
690 |
|
691 $self->fail ($attr, 131, "invalid ID [$val]") |
|
692 unless $val =~ /^$XML::RegExp::Name$/; |
|
693 |
|
694 $self->fail ($attr, 111, "ID [$val] already defined") |
|
695 if $self->{Checker}->{ID}->{$val}++; |
|
696 } |
|
697 |
|
698 sub IDREF |
|
699 { |
|
700 my ($self, $attr, $val, $specified) = @_; |
|
701 |
|
702 $self->fail ($attr, 132, "invalid IDREF [$val]") |
|
703 unless $val =~ /^$XML::RegExp::Name$/; |
|
704 |
|
705 $self->{Checker}->{IDREF}->{$val}++; |
|
706 } |
|
707 |
|
708 sub IDREFS |
|
709 { |
|
710 my ($self, $attr, $val, $specified) = @_; |
|
711 for (split /\s+/, $val) |
|
712 { |
|
713 $self->IDREF ($attr, $_); |
|
714 } |
|
715 } |
|
716 |
|
717 sub ENTITY |
|
718 { |
|
719 my ($self, $attr, $val, $specified) = @_; |
|
720 #?? should it be specified? |
|
721 |
|
722 $self->fail ($attr, 133, "invalid ENTITY name [$val]") |
|
723 unless $val =~ /^$XML::RegExp::Name$/; |
|
724 |
|
725 $self->fail ($attr, 102, "undefined unparsed ENTITY [$val]") |
|
726 unless exists $self->{Checker}->{Unparsed}->{$val}; |
|
727 } |
|
728 |
|
729 sub ENTITIES |
|
730 { |
|
731 my ($self, $attr, $val, $specified) = @_; |
|
732 for (split /\s+/, $val) |
|
733 { |
|
734 $self->ENTITY ($attr, $_); |
|
735 } |
|
736 } |
|
737 |
|
738 sub NMTOKEN |
|
739 { |
|
740 my ($self, $attr, $val, $specified) = @_; |
|
741 $self->fail ($attr, 130, "invalid NMTOKEN [$val]") |
|
742 unless $val =~ /^$XML::RegExp::NmToken$/; |
|
743 } |
|
744 |
|
745 sub NMTOKENS |
|
746 { |
|
747 my ($self, $attr, $val, $specified) = @_; |
|
748 for (split /\s+/, $val) |
|
749 { |
|
750 $self->NMTOKEN ($attr, $_, $specified); |
|
751 } |
|
752 } |
|
753 |
|
754 sub Enumeration |
|
755 { |
|
756 my ($self, $attr, $val, $specified) = @_; |
|
757 my $re = $self->{EnumRE}->{$attr}; |
|
758 |
|
759 $self->fail ($attr, 160, "invalid Enumeration value [$val]") |
|
760 unless $val =~ /$re/; |
|
761 } |
|
762 |
|
763 sub NotationType |
|
764 { |
|
765 my ($self, $attr, $val, $specified) = @_; |
|
766 my $re = $self->{NotationRE}; |
|
767 |
|
768 $self->fail ($attr, 161, "invalid NOTATION value [$val]") |
|
769 unless $val =~ /$re/; |
|
770 |
|
771 $self->fail ($attr, 162, "undefined NOTATION [$val]") |
|
772 unless exists $self->{Checker}->{NOTATION}->{$val}; |
|
773 } |
|
774 |
|
775 package XML::Checker; |
|
776 use vars qw ( $VERSION $FAIL $INSIGNIF_WS ); |
|
777 |
|
778 BEGIN |
|
779 { |
|
780 $VERSION = '0.09'; |
|
781 } |
|
782 |
|
783 $FAIL = \&print_error; |
|
784 |
|
785 # Whether the last seen Char data was insignicant whitespace |
|
786 $INSIGNIF_WS = 0; |
|
787 |
|
788 sub new |
|
789 { |
|
790 my ($class, %args) = @_; |
|
791 |
|
792 $args{ERule} = {}; |
|
793 $args{ARule} = {}; |
|
794 $args{InCDATA} = 0; |
|
795 |
|
796 # $args{Debug} = 1; |
|
797 bless \%args, $class; |
|
798 } |
|
799 |
|
800 # PerlSAX API |
|
801 sub element_decl |
|
802 { |
|
803 my ($self, $hash) = @_; |
|
804 $self->Element ($hash->{Name}, $hash->{Model}); |
|
805 } |
|
806 |
|
807 # Same parameter order as the Element handler in XML::Parser module |
|
808 sub Element |
|
809 { |
|
810 my ($self, $name, $model) = @_; |
|
811 |
|
812 if (defined $self->{ERule}->{$name}) |
|
813 { |
|
814 $self->fail (115, "ELEMENT [$name] already defined", |
|
815 Element => $name); |
|
816 } |
|
817 |
|
818 if ($model eq "EMPTY") |
|
819 { |
|
820 $self->{ERule}->{$name} = new XML::Checker::ERule::EMPTY; |
|
821 } |
|
822 elsif ($model eq "ANY") |
|
823 { |
|
824 $self->{ERule}->{$name} = new XML::Checker::ERule::ANY; |
|
825 } |
|
826 elsif ($model =~ /#PCDATA/) |
|
827 { |
|
828 my $rule = new XML::Checker::ERule::Mixed; |
|
829 if ($rule->setModel ($model)) |
|
830 { |
|
831 $self->{ERule}->{$name} = $rule; |
|
832 } |
|
833 else |
|
834 { |
|
835 $self->fail (124, "bad model [$model] for ELEMENT [$name]", |
|
836 Element => $name); |
|
837 } |
|
838 } |
|
839 else |
|
840 { |
|
841 my $rule = new XML::Checker::ERule::Children; |
|
842 if ($rule->setModel ($model)) |
|
843 { |
|
844 $self->{ERule}->{$name} = $rule; |
|
845 } |
|
846 else |
|
847 { |
|
848 $self->fail (124, "bad model [$model] for ELEMENT [$name]", |
|
849 Element => $name); |
|
850 } |
|
851 } |
|
852 my $rule = $self->{ERule}->{$name}; |
|
853 print "added ELEMENT model for $name: " . $rule->debug . "\n" |
|
854 if $rule and $self->{Debug}; |
|
855 } |
|
856 |
|
857 # PerlSAX API |
|
858 sub attlist_decl |
|
859 { |
|
860 my ($self, $hash) = @_; |
|
861 $self->Attlist ($hash->{ElementName}, $hash->{AttributeName}, |
|
862 $hash->{Type}, $hash->{Default}, $hash->{Fixed}); |
|
863 } |
|
864 |
|
865 sub Attlist |
|
866 { |
|
867 my ($self, $tag, $attrName, $type, $default, $fixed) = @_; |
|
868 my $arule = $self->{ARule}->{$tag} ||= |
|
869 new XML::Checker::ARule ($tag, $self); |
|
870 |
|
871 $arule->Attlist ($attrName, $type, $default, $fixed, $self); |
|
872 } |
|
873 |
|
874 # Initializes the context stack to check an XML::DOM::Element |
|
875 sub InitDomElem |
|
876 { |
|
877 my $self = shift; |
|
878 |
|
879 # initialize Context stack |
|
880 $self->{Context} = [ new XML::Checker::Context::ANY ($self) ]; |
|
881 $self->{InCDATA} = 0; |
|
882 } |
|
883 |
|
884 # Clears the context stack after checking an XML::DOM::Element |
|
885 sub FinalDomElem |
|
886 { |
|
887 my $self = shift; |
|
888 delete $self->{Context}; |
|
889 } |
|
890 |
|
891 # PerlSAX API |
|
892 sub start_document |
|
893 { |
|
894 shift->Init; |
|
895 } |
|
896 |
|
897 sub Init |
|
898 { |
|
899 my $self = shift; |
|
900 |
|
901 # initialize Context stack |
|
902 $self->{Context} = [ new XML::Checker::DocContext ($self) ]; |
|
903 $self->{InCDATA} = 0; |
|
904 } |
|
905 |
|
906 # PerlSAX API |
|
907 sub end_document |
|
908 { |
|
909 shift->Final; |
|
910 } |
|
911 |
|
912 sub Final |
|
913 { |
|
914 my $self = shift; |
|
915 #?? could add more statistics: unreferenced Unparsed, ID |
|
916 |
|
917 for (keys %{ $self->{IDREF} }) |
|
918 { |
|
919 my $n = $self->{IDREF}->{$_}; |
|
920 $self->fail (200, "undefined ID [$_] was referenced [$n] times") |
|
921 unless defined $self->{ID}->{$_}; |
|
922 } |
|
923 |
|
924 for (keys %{ $self->{ID} }) |
|
925 { |
|
926 my $n = $self->{IDREF}->{$_} || 0; |
|
927 $self->fail (300, "[$n] references to ID [$_]"); |
|
928 } |
|
929 |
|
930 delete $self->{Context}; |
|
931 } |
|
932 |
|
933 sub getRootElement |
|
934 { |
|
935 my $self = shift; |
|
936 # print "getRoot $self " . $self->{RootElement} . "\n"; |
|
937 $_[0]->{RootElement}; |
|
938 } |
|
939 |
|
940 # PerlSAX API |
|
941 sub doctype_decl |
|
942 { |
|
943 my ($self, $hash) = @_; |
|
944 $self->Doctype ($hash->{Name}, $hash->{SystemId}, |
|
945 $hash->{PublicId}, $hash->{Internal}); |
|
946 } |
|
947 |
|
948 sub Doctype |
|
949 { |
|
950 my ($self, $name, $sysid, $pubid, $internal) = @_; |
|
951 $self->{RootElement} = $name; |
|
952 |
|
953 my $context = $self->{Context}->[0]; |
|
954 $context->setRootElement ($name); |
|
955 |
|
956 #?? what else |
|
957 } |
|
958 |
|
959 sub Attr |
|
960 { |
|
961 my ($self, $tag, $attr, $val, $specified) = @_; |
|
962 |
|
963 #print "Attr for tag=$tag attr=$attr val=$val spec=$specified\n"; |
|
964 |
|
965 my $arule = $self->{ARule}->{$tag}; |
|
966 if (defined $arule && $arule->{Defined}->{$attr}) |
|
967 { |
|
968 $arule->check ($attr, $val, $specified); |
|
969 } |
|
970 else |
|
971 { |
|
972 $self->fail (103, "undefined attribute [$attr]", Element => $tag); |
|
973 } |
|
974 } |
|
975 |
|
976 sub EndAttr |
|
977 { |
|
978 my $self = shift; |
|
979 |
|
980 my $arule = $self->{CurrARule}; |
|
981 if (defined $arule) |
|
982 { |
|
983 $arule->EndAttr; |
|
984 } |
|
985 } |
|
986 |
|
987 # PerlSAX API |
|
988 sub start_element |
|
989 { |
|
990 my ($self, $hash) = @_; |
|
991 my $tag = $hash->{Name}; |
|
992 my $attr = $hash->{Attributes}; |
|
993 |
|
994 $self->Start ($tag); |
|
995 |
|
996 if (exists $hash->{AttributeOrder}) |
|
997 { |
|
998 my $defaulted = $hash->{Defaulted}; |
|
999 my @order = @{ $hash->{AttributeOrder} }; |
|
1000 |
|
1001 # Specified attributes |
|
1002 for (my $i = 0; $i < $defaulted; $i++) |
|
1003 { |
|
1004 my $a = $order[$i]; |
|
1005 $self->Attr ($tag, $a, $attr->{$a}, 1); |
|
1006 } |
|
1007 |
|
1008 # Defaulted attributes |
|
1009 for (my $i = $defaulted; $i < @order; $i++) |
|
1010 { |
|
1011 my $attr = $order[$i]; |
|
1012 $self->Attr ($tag, $a, $attr->{$a}, 0); |
|
1013 } |
|
1014 } |
|
1015 else |
|
1016 { |
|
1017 # Assume all attributes were specified |
|
1018 my @attr = %$attr; |
|
1019 my ($key, $val); |
|
1020 while ($key = shift @attr) |
|
1021 { |
|
1022 $val = shift @attr; |
|
1023 |
|
1024 $self->Attr ($tag, $key, $val, 1); |
|
1025 } |
|
1026 } |
|
1027 $self->EndAttr; |
|
1028 } |
|
1029 |
|
1030 sub Start |
|
1031 { |
|
1032 my ($self, $tag) = @_; |
|
1033 #?? if first tag, check with root element - or does expat check this already? |
|
1034 |
|
1035 my $context = $self->{Context}; |
|
1036 $context->[0]->Start ($self, $tag); |
|
1037 |
|
1038 my $erule = $self->{ERule}->{$tag}; |
|
1039 if (defined $erule) |
|
1040 { |
|
1041 unshift @$context, $erule->context; |
|
1042 } |
|
1043 else |
|
1044 { |
|
1045 # It's not a real error according to the XML Spec. |
|
1046 $self->fail (101, "undefined ELEMENT [$tag]"); |
|
1047 unshift @$context, new XML::Checker::Context::ANY; |
|
1048 } |
|
1049 |
|
1050 #?? what about ARule ?? |
|
1051 my $arule = $self->{ARule}->{$tag}; |
|
1052 if (defined $arule) |
|
1053 { |
|
1054 $self->{CurrARule} = $arule; |
|
1055 $arule->StartAttr; |
|
1056 } |
|
1057 } |
|
1058 |
|
1059 # PerlSAX API |
|
1060 sub end_element |
|
1061 { |
|
1062 shift->End; |
|
1063 } |
|
1064 |
|
1065 sub End |
|
1066 { |
|
1067 my ($self) = @_; |
|
1068 my $context = $self->{Context}; |
|
1069 |
|
1070 $context->[0]->End ($self); |
|
1071 shift @$context; |
|
1072 } |
|
1073 |
|
1074 # PerlSAX API |
|
1075 sub characters |
|
1076 { |
|
1077 my ($self, $hash) = @_; |
|
1078 my $data = $hash->{Data}; |
|
1079 |
|
1080 if ($self->{InCDATA}) |
|
1081 { |
|
1082 $self->CData ($data); |
|
1083 } |
|
1084 else |
|
1085 { |
|
1086 $self->Char ($data); |
|
1087 } |
|
1088 } |
|
1089 |
|
1090 # PerlSAX API |
|
1091 sub start_cdata |
|
1092 { |
|
1093 $_[0]->{InCDATA} = 1; |
|
1094 } |
|
1095 |
|
1096 # PerlSAX API |
|
1097 sub end_cdata |
|
1098 { |
|
1099 $_[0]->{InCDATA} = 0; |
|
1100 } |
|
1101 |
|
1102 sub Char |
|
1103 { |
|
1104 my ($self, $text) = @_; |
|
1105 my $context = $self->{Context}; |
|
1106 |
|
1107 # NOTE: calls to isWS may set this to 1. |
|
1108 $INSIGNIF_WS = 0; |
|
1109 |
|
1110 $context->[0]->Char ($self, $text); |
|
1111 } |
|
1112 |
|
1113 # Treat CDATASection same as Char (Text) |
|
1114 sub CData |
|
1115 { |
|
1116 my ($self, $cdata) = @_; |
|
1117 my $context = $self->{Context}; |
|
1118 |
|
1119 $context->[0]->Char ($self, $cdata); |
|
1120 |
|
1121 # CDATASection can never be insignificant whitespace |
|
1122 $INSIGNIF_WS = 0; |
|
1123 #?? I'm not sure if this assumption is correct |
|
1124 } |
|
1125 |
|
1126 # PerlSAX API |
|
1127 sub comment |
|
1128 { |
|
1129 my ($self, $hash) = @_; |
|
1130 $self->Comment ($hash->{Data}); |
|
1131 } |
|
1132 |
|
1133 sub Comment |
|
1134 { |
|
1135 # ?? what can be checked here? |
|
1136 } |
|
1137 |
|
1138 # PerlSAX API |
|
1139 sub entity_reference |
|
1140 { |
|
1141 my ($self, $hash) = @_; |
|
1142 $self->EntityRef ($hash->{Name}, 0); |
|
1143 #?? parameter entities (like %par;) are NOT supported! |
|
1144 # PerlSAX::handle_default should be fixed! |
|
1145 } |
|
1146 |
|
1147 sub EntityRef |
|
1148 { |
|
1149 my ($self, $ref, $isParam) = @_; |
|
1150 |
|
1151 if ($isParam) |
|
1152 { |
|
1153 # expand to "%name;" |
|
1154 print STDERR "XML::Checker::Entity - parameter Entity (%ent;) not implemented\n"; |
|
1155 } |
|
1156 else |
|
1157 { |
|
1158 # Treat same as Char - for now |
|
1159 my $context = $self->{Context}; |
|
1160 $context->[0]->Char ($self, "&$ref;"); |
|
1161 $INSIGNIF_WS = 0; |
|
1162 #?? I could count the number of times each Entity is referenced |
|
1163 } |
|
1164 } |
|
1165 |
|
1166 # PerlSAX API |
|
1167 sub unparsed_entity_decl |
|
1168 { |
|
1169 my ($self, $hash) = @_; |
|
1170 $self->Unparsed ($hash->{Name}); |
|
1171 #?? what about Base, SytemId, PublicId ? |
|
1172 } |
|
1173 |
|
1174 sub Unparsed |
|
1175 { |
|
1176 my ($self, $entity) = @_; |
|
1177 # print "ARule::Unparsed $entity\n"; |
|
1178 if ($self->{Unparsed}->{$entity}) |
|
1179 { |
|
1180 $self->fail (112, "unparsed ENTITY [$entity] already defined"); |
|
1181 } |
|
1182 else |
|
1183 { |
|
1184 $self->{Unparsed}->{$entity} = 1; |
|
1185 } |
|
1186 } |
|
1187 |
|
1188 # PerlSAX API |
|
1189 sub notation_decl |
|
1190 { |
|
1191 my ($self, $hash) = @_; |
|
1192 $self->Notation ($hash->{Name}); |
|
1193 #?? what about Base, SytemId, PublicId ? |
|
1194 } |
|
1195 |
|
1196 sub Notation |
|
1197 { |
|
1198 my ($self, $notation) = @_; |
|
1199 if ($self->{NOTATION}->{$notation}) |
|
1200 { |
|
1201 $self->fail (113, "NOTATION [$notation] already defined"); |
|
1202 } |
|
1203 else |
|
1204 { |
|
1205 $self->{NOTATION}->{$notation} = 1; |
|
1206 } |
|
1207 } |
|
1208 |
|
1209 # PerlSAX API |
|
1210 sub entity_decl |
|
1211 { |
|
1212 my ($self, $hash) = @_; |
|
1213 |
|
1214 $self->Entity ($hash->{Name}, $hash->{Value}, $hash->{SystemId}, |
|
1215 $hash->{PublicId}, $hash->{'Notation'}); |
|
1216 } |
|
1217 |
|
1218 sub Entity |
|
1219 { |
|
1220 my ($self, $name, $val, $sysId, $pubId, $ndata) = @_; |
|
1221 |
|
1222 if (exists $self->{ENTITY}->{$name}) |
|
1223 { |
|
1224 $self->fail (114, "ENTITY [$name] already defined"); |
|
1225 } |
|
1226 else |
|
1227 { |
|
1228 $self->{ENTITY}->{$name} = $val; |
|
1229 } |
|
1230 } |
|
1231 |
|
1232 # PerlSAX API |
|
1233 #sub xml_decl {} $hash=> Version, Encoding, Standalone |
|
1234 # Don't implement resolve_entity() which is called by ExternEnt! |
|
1235 #sub processing_instruction {} $hash=> Target, Data |
|
1236 |
|
1237 # Returns whether the Char data is whitespace and also updates the |
|
1238 # $INSIGNIF_WS variable to indicate whether it is insignificant whitespace. |
|
1239 # Note that this method is only called in places where potential whitespace |
|
1240 # can be insignificant (i.e. when the ERule is Children or EMPTY) |
|
1241 sub isWS |
|
1242 { |
|
1243 $INSIGNIF_WS = ($_[1] =~ /^\s*$/); |
|
1244 } |
|
1245 |
|
1246 sub isInsignifWS |
|
1247 { |
|
1248 $INSIGNIF_WS; |
|
1249 } |
|
1250 |
|
1251 sub fail |
|
1252 { |
|
1253 my $self = shift; |
|
1254 &$FAIL (@_); |
|
1255 } |
|
1256 |
|
1257 sub print_error # static |
|
1258 { |
|
1259 my $str = error_string (@_); |
|
1260 print STDERR $str; |
|
1261 } |
|
1262 |
|
1263 sub error_string # static |
|
1264 { |
|
1265 my $code = shift; |
|
1266 my $msg = shift; |
|
1267 |
|
1268 my @a = (); |
|
1269 my ($key, $val); |
|
1270 while ($key = shift) |
|
1271 { |
|
1272 $val = shift; |
|
1273 push @a, ("$key " . (defined $val ? $val : "(undef)")); |
|
1274 } |
|
1275 |
|
1276 my $cat = $code >= 200 ? ($code >= 300 ? "INFO" : "WARNING") : "ERROR"; |
|
1277 my $str = join (", ", @a); |
|
1278 $str = length($str) ? "\tContext: $str\n" : ""; |
|
1279 |
|
1280 "XML::Checker $cat-$code: $msg\n$str"; |
|
1281 } |
|
1282 |
|
1283 sub debug |
|
1284 { |
|
1285 my ($self) = @_; |
|
1286 my $context = $self->{Context}->[0]; |
|
1287 my $c = $context ? $context->debug : "no context"; |
|
1288 my $root = $self->{RootElement}; |
|
1289 |
|
1290 "Checker[$c,RootElement=$root]"; |
|
1291 } |
|
1292 |
|
1293 1; # package return code |
|
1294 |
|
1295 __END__ |
|
1296 |
|
1297 =head1 NAME |
|
1298 |
|
1299 XML::Checker - A perl module for validating XML |
|
1300 |
|
1301 =head1 SYNOPSIS |
|
1302 |
|
1303 L<XML::Checker::Parser> - an L<XML::Parser> that validates at parse time |
|
1304 |
|
1305 L<XML::DOM::ValParser> - an L<XML::DOM::Parser> that validates at parse time |
|
1306 |
|
1307 (Some of the package names may change! This is only an alpha release...) |
|
1308 |
|
1309 =head1 DESCRIPTION |
|
1310 |
|
1311 XML::Checker can be used in different ways to validate XML. See the manual |
|
1312 pages of L<XML::Checker::Parser> and L<XML::DOM::ValParser> |
|
1313 for more information. |
|
1314 |
|
1315 This document only describes common topics like error handling |
|
1316 and the XML::Checker class itself. |
|
1317 |
|
1318 WARNING: Not all errors are currently checked. Almost everything is subject to |
|
1319 change. Some reported errors may not be real errors. |
|
1320 |
|
1321 =head1 ERROR HANDLING |
|
1322 |
|
1323 Whenever XML::Checker (or one of the packages that uses XML::Checker) detects a |
|
1324 potential error, the 'fail handler' is called. It is currently also called |
|
1325 to report information, like how many times an Entity was referenced. |
|
1326 (The whole error handling mechanism is subject to change, I'm afraid...) |
|
1327 |
|
1328 The default fail handler is XML::Checker::print_error(), which prints an error |
|
1329 message to STDERR. It does not stop the XML::Checker, so it will continue |
|
1330 looking for other errors. |
|
1331 The error message is created with XML::Checker::error_string(). |
|
1332 |
|
1333 You can define your |
|
1334 own fail handler in two ways, locally and globally. Use a local variable to |
|
1335 temporarily override the fail handler. This way the default fail handler is restored |
|
1336 when the local variable goes out of scope, esp. when exceptions are thrown e.g. |
|
1337 |
|
1338 # Using a local variable to temporarily override the fail handler (preferred) |
|
1339 { # new block - start of local scope |
|
1340 local $XML::Checker::FAIL = \&my_fail; |
|
1341 ... your code here ... |
|
1342 } # end of block - the previous fail handler is restored |
|
1343 |
|
1344 You can also set the error handler globally, risking that your code may not |
|
1345 be reusable or may clash with other modules that use XML::Checker. |
|
1346 |
|
1347 # Globally setting the fail handler (not recommended) |
|
1348 $XML::Checker::FAIL = \&my_fail; |
|
1349 ... rest of your code ... |
|
1350 |
|
1351 The fail handler is called with the following parameters ($code, $msg, @context), |
|
1352 where $code is the error code, $msg is the error description and |
|
1353 @context contains information on where the error occurred. The @context is |
|
1354 a (ordered) list of (key,value) pairs and can easily be turned into a hash. |
|
1355 It contains the following information: |
|
1356 |
|
1357 Element - tag name of Element node (if applicable) |
|
1358 Attr - attribute name (if applicable) |
|
1359 ChildElementIndex - if applicable (see error 157) |
|
1360 line - only when parsing |
|
1361 column - only when parsing |
|
1362 byte - only when parsing (-1 means: end of file) |
|
1363 |
|
1364 Some examples of fail handlers: |
|
1365 |
|
1366 # Don't print info messages |
|
1367 sub my_fail |
|
1368 { |
|
1369 my $code = shift; |
|
1370 print STDERR XML::Checker::error_message ($code, @_) |
|
1371 if $code < 300; |
|
1372 } |
|
1373 |
|
1374 # Die when the first error is encountered - this will stop |
|
1375 # the parsing process. Ignore information messages. |
|
1376 sub my_fail |
|
1377 { |
|
1378 my $code = shift; |
|
1379 die XML::Checker::error_message ($code, @_) if $code < 300; |
|
1380 } |
|
1381 |
|
1382 # Count the number of undefined NOTATION references |
|
1383 # and print the error as usual |
|
1384 sub my_fail |
|
1385 { |
|
1386 my $code = shift; |
|
1387 $count_undef_notations++ if $code == 100; |
|
1388 XML::Checker::print_error ($code, @_); |
|
1389 } |
|
1390 |
|
1391 # Die when an error is encountered. |
|
1392 # Don't die if a warning or info message is encountered, just print a message. |
|
1393 sub my_fail { |
|
1394 my $code = shift; |
|
1395 die XML::Checker::error_string ($code, @_) if $code < 200; |
|
1396 XML::Checker::print_error ($code, @_); |
|
1397 } |
|
1398 |
|
1399 =head1 INSIGNIFICANT WHITESPACE |
|
1400 |
|
1401 XML::Checker keeps track of whether whitespace found in character data |
|
1402 is significant or not. It is considered insignicant if it is found inside |
|
1403 an element that has a ELEMENT rule that is not of type Mixed or of type ANY. |
|
1404 (A Mixed ELEMENT rule does contains the #PCDATA keyword. |
|
1405 An ANY rule contains the ANY keyword. See the XML spec for more info.) |
|
1406 |
|
1407 XML::Checker can not determine whether whitespace is insignificant in those two |
|
1408 cases, because they both allow regular character data to appear within |
|
1409 XML elements and XML::Checker can therefore not deduce whether whitespace |
|
1410 is part of the actual data or was just added for readability of the XML file. |
|
1411 |
|
1412 XML::Checker::Parser and XML::DOM::ValParser both have the option to skip |
|
1413 insignificant whitespace when setting B<SkipInsignifWS> to 1 in their constructor. |
|
1414 If set, they will not call the Char handler when insignificant whitespace is |
|
1415 encountered. This means that in XML::DOM::ValParser no Text nodes are created |
|
1416 for insignificant whitespace. |
|
1417 |
|
1418 Regardless of whether the SkipInsignifWS options is set, XML::Checker always |
|
1419 keeps track of whether whitespace is insignificant. After making a call to |
|
1420 XML::Checker's Char handler, you can find out if it was insignificant whitespace |
|
1421 by calling the isInsignifWS method. |
|
1422 |
|
1423 When using multiple (nested) XML::Checker instances or when using XML::Checker |
|
1424 without using XML::Checker::Parser or XML::DOM::ValParser (which hardly anybody |
|
1425 probably will), make sure to set a local variable in the scope of your checking |
|
1426 code, e.g. |
|
1427 |
|
1428 { # new block - start of local scope |
|
1429 local $XML::Checker::INSIGNIF_WS = 0; |
|
1430 ... insert your code here ... |
|
1431 } # end of scope |
|
1432 |
|
1433 =head1 ERROR CODES |
|
1434 |
|
1435 There are 3 categories, errors, warnings and info messages. |
|
1436 (The codes are still subject to change, as well the error descriptions.) |
|
1437 |
|
1438 Most errors have a link to the appropriate Validaty Constraint (B<VC>) |
|
1439 or other section in the XML specification. |
|
1440 |
|
1441 =head2 ERROR Messages |
|
1442 |
|
1443 =head2 100 - 109 |
|
1444 |
|
1445 =over 4 |
|
1446 |
|
1447 =item * |
|
1448 |
|
1449 B<100> - undefined NOTATION [$notation] in ATTLIST |
|
1450 |
|
1451 The ATTLIST contained a Notation reference that was not defined in a |
|
1452 NOTATION definition. |
|
1453 B<VC:> L<Notation Attributes|http://www.w3.org/TR/REC-xml#notatn> |
|
1454 |
|
1455 |
|
1456 =item * |
|
1457 |
|
1458 B<101> - undefined ELEMENT [$tagName] |
|
1459 |
|
1460 The specified Element was never defined in an ELEMENT definition. |
|
1461 This is not an error according to the XML spec. |
|
1462 See L<Element Type Declarations|http://www.w3.org/TR/REC-xml#elemdecls> |
|
1463 |
|
1464 |
|
1465 =item * |
|
1466 |
|
1467 B<102> - undefined unparsed ENTITY [$entity] |
|
1468 |
|
1469 The attribute value referenced an undefined unparsed entity. |
|
1470 B<VC:> L<Entity Name|http://www.w3.org/TR/REC-xml#entname> |
|
1471 |
|
1472 |
|
1473 =item * |
|
1474 |
|
1475 B<103> - undefined attribute [$attrName] |
|
1476 |
|
1477 The specified attribute was not defined in an ATTLIST for that Element. |
|
1478 B<VC:> L<Attribute Value Type|http://www.w3.org/TR/REC-xml#ValueType> |
|
1479 |
|
1480 |
|
1481 =back |
|
1482 |
|
1483 =head2 110 - 119 |
|
1484 |
|
1485 =over 4 |
|
1486 |
|
1487 =item * |
|
1488 |
|
1489 B<110> - attribute [$attrName] of element [$tagName] already defined |
|
1490 |
|
1491 The specified attribute was already defined in this ATTLIST definition or |
|
1492 in a previous one. |
|
1493 This is not an error according to the XML spec. |
|
1494 See L<Attribute-List Declarations|http://www.w3.org/TR/REC-xml#attdecls> |
|
1495 |
|
1496 |
|
1497 =item * |
|
1498 |
|
1499 B<111> - ID [$value] already defined |
|
1500 |
|
1501 An ID with the specified value was already defined in an attribute |
|
1502 within the same document. |
|
1503 B<VC:> L<ID|http://www.w3.org/TR/REC-xml#id> |
|
1504 |
|
1505 |
|
1506 =item * |
|
1507 |
|
1508 B<112> - unparsed ENTITY [$entity] already defined |
|
1509 |
|
1510 This is not an error according to the XML spec. |
|
1511 See L<Entity Declarations|http://www.w3.org/TR/REC-xml#sec-entity-decl> |
|
1512 |
|
1513 |
|
1514 =item * |
|
1515 |
|
1516 B<113> - NOTATION [$notation] already defined |
|
1517 |
|
1518 |
|
1519 =item * |
|
1520 |
|
1521 B<114> - ENTITY [$entity] already defined |
|
1522 |
|
1523 This is not an error according to the XML spec. |
|
1524 See L<Entity Declarations|http://www.w3.org/TR/REC-xml#sec-entity-decl> |
|
1525 |
|
1526 |
|
1527 =item * |
|
1528 |
|
1529 B<115> - ELEMENT [$name] already defined |
|
1530 B<VC:> L<Unique Element Type Declaration|http://www.w3.org/TR/REC-xml#EDUnique> |
|
1531 |
|
1532 |
|
1533 =back |
|
1534 |
|
1535 =head2 120 - 129 |
|
1536 |
|
1537 =over 4 |
|
1538 |
|
1539 =item * |
|
1540 |
|
1541 B<120> - invalid default ENTITY [$default] |
|
1542 |
|
1543 (Or IDREF or NMTOKEN instead of ENTITY.) |
|
1544 The ENTITY, IDREF or NMTOKEN reference in the default attribute |
|
1545 value for an attribute with types ENTITY, IDREF or NMTOKEN was not |
|
1546 valid. |
|
1547 B<VC:> L<Attribute Default Legal|http://www.w3.org/TR/REC-xml#defattrvalid> |
|
1548 |
|
1549 |
|
1550 =item * |
|
1551 |
|
1552 B<121> - invalid default [$token] in ENTITIES [$default] |
|
1553 |
|
1554 (Or IDREFS or NMTOKENS instead of ENTITIES) |
|
1555 One of the ENTITY, IDREF or NMTOKEN references in the default attribute |
|
1556 value for an attribute with types ENTITIES, IDREFS or NMTOKENS was not |
|
1557 valid. |
|
1558 B<VC:> L<Attribute Default Legal|http://www.w3.org/TR/REC-xml#defattrvalid> |
|
1559 |
|
1560 |
|
1561 =item * |
|
1562 |
|
1563 B<122> - invalid default attribute value [$default] |
|
1564 |
|
1565 The specified default attribute value is not a valid attribute value. |
|
1566 B<VC:> L<Attribute Default Legal|http://www.w3.org/TR/REC-xml#defattrvalid> |
|
1567 |
|
1568 |
|
1569 =item * |
|
1570 |
|
1571 B<123> - invalid default ID [$default], must be #REQUIRED or #IMPLIED |
|
1572 |
|
1573 The default attribute value for an attribute of type ID has to be |
|
1574 #REQUIRED or #IMPLIED. |
|
1575 B<VC:> L<ID Attribute Default|http://www.w3.org/TR/REC-xml#id-default> |
|
1576 |
|
1577 |
|
1578 =item * |
|
1579 |
|
1580 B<124> - bad model [$model] for ELEMENT [$name] |
|
1581 |
|
1582 The model in the ELEMENT definition did not conform to the XML syntax |
|
1583 for Mixed models. |
|
1584 See L<Mixed Content|http://www.w3.org/TR/REC-xml#sec-mixed-content> |
|
1585 |
|
1586 |
|
1587 =back |
|
1588 |
|
1589 =head2 130 - 139 |
|
1590 |
|
1591 =over 4 |
|
1592 |
|
1593 =item * |
|
1594 |
|
1595 B<130> - invalid NMTOKEN [$attrValue] |
|
1596 |
|
1597 The attribute value is not a valid NmToken token. |
|
1598 B<VC:> L<Enumeration|http://www.w3.org/TR/REC-xml#enum> |
|
1599 |
|
1600 |
|
1601 =item * |
|
1602 |
|
1603 B<131> - invalid ID [$attrValue] |
|
1604 |
|
1605 The specified attribute value is not a valid Name token. |
|
1606 B<VC:> L<ID|http://www.w3.org/TR/REC-xml#id> |
|
1607 |
|
1608 |
|
1609 =item * |
|
1610 |
|
1611 B<132> - invalid IDREF [$value] |
|
1612 |
|
1613 The specified attribute value is not a valid Name token. |
|
1614 B<VC:> L<IDREF|http://www.w3.org/TR/REC-xml#idref> |
|
1615 |
|
1616 |
|
1617 =item * |
|
1618 |
|
1619 B<133> - invalid ENTITY name [$name] |
|
1620 |
|
1621 The specified attribute value is not a valid Name token. |
|
1622 B<VC:> L<Entity Name|http://www.w3.org/TR/REC-xml#entname> |
|
1623 |
|
1624 |
|
1625 =item * |
|
1626 |
|
1627 B<134> - invalid Enumeration value [$value] in ATTLIST |
|
1628 |
|
1629 The specified value is not a valid NmToken (see XML spec for def.) |
|
1630 See definition of L<NmToken|http://www.w3.org/TR/REC-xml#NT-Nmtoken> |
|
1631 |
|
1632 |
|
1633 =item * |
|
1634 |
|
1635 B<135> - empty NOTATION list in ATTLIST |
|
1636 |
|
1637 The NOTATION list of the ATTLIST definition did not contain any NOTATION |
|
1638 references. |
|
1639 See definition of L<NotationType|http://www.w3.org/TR/REC-xml#NT-NotationType> |
|
1640 |
|
1641 |
|
1642 =item * |
|
1643 |
|
1644 B<136> - empty Enumeration list in ATTLIST |
|
1645 |
|
1646 The ATTLIST definition of the attribute of type Enumeration did not |
|
1647 contain any values. |
|
1648 See definition of L<Enumeration|http://www.w3.org/TR/REC-xml#NT-Enumeration> |
|
1649 |
|
1650 |
|
1651 =item * |
|
1652 |
|
1653 B<137> - invalid ATTLIST type [$type] |
|
1654 |
|
1655 The attribute type has to be one of: ID, IDREF, IDREFS, ENTITY, ENTITIES, |
|
1656 NMTOKEN, NMTOKENS, CDATA, NOTATION or an Enumeration. |
|
1657 See definition of L<AttType|http://www.w3.org/TR/REC-xml#NT-AttType> |
|
1658 |
|
1659 |
|
1660 =back |
|
1661 |
|
1662 =head2 150 - 159 |
|
1663 |
|
1664 =over 4 |
|
1665 |
|
1666 =item * |
|
1667 |
|
1668 B<150> - bad #FIXED attribute value [$value], it should be [$default] |
|
1669 |
|
1670 The specified attribute was defined as #FIXED in the ATTLIST definition |
|
1671 and the found attribute $value differs from the specified $default value. |
|
1672 B<VC:> L<Fixed Attribute Default|http://www.w3.org/TR/REC-xml#FixedAttr> |
|
1673 |
|
1674 |
|
1675 =item * |
|
1676 |
|
1677 B<151> - only one ID allowed in ATTLIST per element first=[$attrName] |
|
1678 |
|
1679 The ATTLIST definitions for an Element may contain only one attribute |
|
1680 with the type ID. The specified $attrName is the one that was found first. |
|
1681 B<VC:> L<One ID per Element Type|http://www.w3.org/TR/REC-xml#one-id-per-el> |
|
1682 |
|
1683 |
|
1684 =item * |
|
1685 |
|
1686 B<152> - Element should be EMPTY, found Element [$tagName] |
|
1687 |
|
1688 The ELEMENT definition for the specified Element said it should be |
|
1689 EMPTY, but a child Element was found. |
|
1690 B<VC:> L<Element Valid (sub1)|http://www.w3.org/TR/REC-xml#elementvalid> |
|
1691 |
|
1692 |
|
1693 =item * |
|
1694 |
|
1695 B<153> - Element should be EMPTY, found text [$text] |
|
1696 |
|
1697 The ELEMENT definition for the specified Element said it should be |
|
1698 EMPTY, but text was found. Currently, whitespace is not allowed between the |
|
1699 open and close tag. (This may be wrong, please give feedback.) |
|
1700 To allow whitespace (subject to change), set: |
|
1701 |
|
1702 $XML::Checker::Context::EMPTY::ALLOW_WHITE_SPACE = 1; |
|
1703 |
|
1704 B<VC:> L<Element Valid (sub1)|http://www.w3.org/TR/REC-xml#elementvalid> |
|
1705 |
|
1706 |
|
1707 =item * |
|
1708 |
|
1709 B<154> - bad order of Elements Found=[$found] RE=[$re] |
|
1710 |
|
1711 The child elements of the specified Element did not match the |
|
1712 regular expression found in the ELEMENT definition. $found contains |
|
1713 a comma separated list of all the child element tag names that were found. |
|
1714 $re contains the (decoded) regular expression that was used internally. |
|
1715 B<VC:> L<Element Valid|http://www.w3.org/TR/REC-xml#elementvalid> |
|
1716 |
|
1717 |
|
1718 =item * |
|
1719 |
|
1720 B<155> - more than one root Element [$tags] |
|
1721 |
|
1722 An XML Document may only contain one Element. |
|
1723 $tags is a comma separated list of element tag names encountered sofar. |
|
1724 L<XML::Parser> (expat) throws 'no element found' exception. |
|
1725 See two_roots.xml for an example. |
|
1726 See definition of L<document|http://www.w3.org/TR/REC-xml#dt-root> |
|
1727 |
|
1728 |
|
1729 =item * |
|
1730 |
|
1731 B<156> - unexpected root Element [$tagName], expected [$rootTagName] |
|
1732 |
|
1733 The tag name of the root Element of the XML Document differs from the name |
|
1734 specified in the DOCTYPE section. |
|
1735 L<XML::Parser> (expat) throws 'not well-formed' exception. |
|
1736 See bad_root.xml for an example. |
|
1737 B<VC:> L<Root Element Type|http://www.w3.org/TR/REC-xml#vc-roottype> |
|
1738 |
|
1739 |
|
1740 =item * |
|
1741 |
|
1742 B<157> - unexpected Element [$tagName] |
|
1743 |
|
1744 The ELEMENT definition for the specified Element does not allow child |
|
1745 Elements with the specified $tagName. |
|
1746 B<VC:> L<Element Valid|http://www.w3.org/TR/REC-xml#elementvalid> |
|
1747 |
|
1748 The error context contains ChildElementIndex which is the index within |
|
1749 its parent Element (counting only Element nodes.) |
|
1750 |
|
1751 |
|
1752 =item * |
|
1753 |
|
1754 B<158> - unspecified value for #IMPLIED attribute [$attrName] |
|
1755 |
|
1756 The ATTLIST for the specified attribute said the attribute was #IMPLIED, |
|
1757 which means the user application should supply a value, but the attribute |
|
1758 value was not specified. (User applications should pass a value and set |
|
1759 $specified to 1 in the Attr handler.) |
|
1760 |
|
1761 |
|
1762 =item * |
|
1763 |
|
1764 B<159> - unspecified value for #REQUIRED attribute [$attrName] |
|
1765 |
|
1766 The ATTLIST for the specified attribute said the attribute was #REQUIRED, |
|
1767 which means that a value should have been specified. |
|
1768 B<VC:> L<Required Attribute|http://www.w3.org/TR/REC-xml#RequiredAttr> |
|
1769 |
|
1770 |
|
1771 =back |
|
1772 |
|
1773 =head2 160 - 169 |
|
1774 |
|
1775 =over 4 |
|
1776 |
|
1777 =item * |
|
1778 |
|
1779 B<160> - invalid Enumeration value [$attrValue] |
|
1780 |
|
1781 The specified attribute value does not match one of the Enumeration values |
|
1782 in the ATTLIST. |
|
1783 B<VC:> L<Enumeration|http://www.w3.org/TR/REC-xml#enum> |
|
1784 |
|
1785 |
|
1786 =item * |
|
1787 |
|
1788 B<161> - invalid NOTATION value [$attrValue] |
|
1789 |
|
1790 The specifed attribute value was not found in the list of possible NOTATION |
|
1791 references as found in the ATTLIST definition. |
|
1792 B<VC:> L<Notation Attributes|http://www.w3.org/TR/REC-xml#notatn> |
|
1793 |
|
1794 |
|
1795 =item * |
|
1796 |
|
1797 B<162> - undefined NOTATION [$attrValue] |
|
1798 |
|
1799 The NOTATION referenced by the specified attribute value was not defined. |
|
1800 B<VC:> L<Notation Attributes|http://www.w3.org/TR/REC-xml#notatn> |
|
1801 |
|
1802 |
|
1803 =back |
|
1804 |
|
1805 =head2 WARNING Messages (200 and up) |
|
1806 |
|
1807 =over 4 |
|
1808 |
|
1809 =item * |
|
1810 |
|
1811 B<200> - undefined ID [$id] was referenced [$n] times |
|
1812 |
|
1813 The specified ID was referenced $n times, but never defined in an attribute |
|
1814 value with type ID. |
|
1815 B<VC:> L<IDREF|http://www.w3.org/TR/REC-xml#idref> |
|
1816 |
|
1817 |
|
1818 =back |
|
1819 |
|
1820 =head2 INFO Messages (300 and up) |
|
1821 |
|
1822 =over 4 |
|
1823 |
|
1824 =item * |
|
1825 |
|
1826 B<300> - [$n] references to ID [$id] |
|
1827 |
|
1828 The specified ID was referenced $n times. |
|
1829 |
|
1830 |
|
1831 =back |
|
1832 |
|
1833 =head2 Not checked |
|
1834 |
|
1835 The following errors are already checked by L<XML::Parser> (expat) and |
|
1836 are currently not checked by XML::Checker: |
|
1837 |
|
1838 (?? TODO - add more info) |
|
1839 |
|
1840 =over 4 |
|
1841 |
|
1842 =item root element is missing |
|
1843 |
|
1844 L<XML::Parser> (expat) throws 'no element found' exception. |
|
1845 See no_root.xml for an example. |
|
1846 |
|
1847 =back |
|
1848 |
|
1849 =head1 XML::Checker |
|
1850 |
|
1851 XML::Checker can be easily plugged into your application. |
|
1852 It uses mostly the same style of event handlers (or callbacks) as L<XML::Parser>. |
|
1853 See L<XML::Parser> manual page for descriptions of most handlers. |
|
1854 |
|
1855 It also implements PerlSAX style event handlers. See L<PerlSAX interface>. |
|
1856 |
|
1857 Currently, the XML::Checker object is a blessed hash with the following |
|
1858 (potentially useful) entries: |
|
1859 |
|
1860 $checker->{RootElement} - root element name as found in the DOCTYPE |
|
1861 $checker->{NOTATION}->{$notation} - is 1 if the NOTATION was defined |
|
1862 $checker->{ENTITY}->{$name} - contains the (first) ENTITY value if defined |
|
1863 $checker->{Unparsed}->{$entity} - is 1 if the unparsed ENTITY was defined |
|
1864 $checker->{ID}->{$id} - is 1 if the ID was defined |
|
1865 $checker->{IDREF}->{$id} - number of times the ID was referenced |
|
1866 |
|
1867 # Less useful: |
|
1868 $checker->{ERule}->{$tag} - the ELEMENT rules by Element tag name |
|
1869 $checker->{ARule}->{$tag} - the ATTLIST rules by Element tag name |
|
1870 $checker->{Context} - context stack used internally |
|
1871 $checker->{CurrARule} - current ATTLIST rule for the current Element |
|
1872 |
|
1873 =head2 XML:Checker methods |
|
1874 |
|
1875 This section is only interesting when using XML::Checker directly. |
|
1876 XML::Checker supports most event handlers that L<XML::Parser> supports with minor |
|
1877 differences. Note that the XML::Checker event handler methods are |
|
1878 instance methods and not static, so don't forget to call them like this, |
|
1879 without passing $expat (as in the L<XML::Parser>) handlers: |
|
1880 |
|
1881 $checker->Start($tagName); |
|
1882 |
|
1883 =over 4 |
|
1884 |
|
1885 =item Constructor |
|
1886 |
|
1887 $checker = new XML::Checker; |
|
1888 $checker = new XML::Checker (%user_args); |
|
1889 |
|
1890 User data may be stored by client applications. Only $checker->{User} is |
|
1891 guaranteed not to clash with internal hash keys. |
|
1892 |
|
1893 =item getRootElement () |
|
1894 |
|
1895 $tagName = $checker->getRootElement; |
|
1896 |
|
1897 Returns the root element name as found in the DOCTYPE |
|
1898 |
|
1899 =back |
|
1900 |
|
1901 =head2 Expat interface |
|
1902 |
|
1903 XML::Checker supports what I call the I<Expat> interface, which is |
|
1904 the collection of methods you normally specify as the callback handlers |
|
1905 when using XML::Parser. |
|
1906 |
|
1907 Only the following L<XML::Parser> handlers are currently supported: |
|
1908 Init, Final, Char, Start, End, Element, Attlist, Doctype, |
|
1909 Unparsed, Entity, Notation. |
|
1910 |
|
1911 I don't know how to correctly support the Default handler for all L<XML::Parser> |
|
1912 releases. The Start handler works a little different (see below) and I |
|
1913 added Attr, InitDomElem, FinalDomElem, CDATA and EntityRef handlers. |
|
1914 See L<XML::Parser> for a description of the handlers that are not listed below. |
|
1915 |
|
1916 Note that this interface may disappear, when the PerlSAX interface stabilizes. |
|
1917 |
|
1918 =over 4 |
|
1919 |
|
1920 =item Start ($tag) |
|
1921 |
|
1922 $checker->Start($tag); |
|
1923 |
|
1924 Call this when an Element with the specified $tag name is encountered. |
|
1925 Different from the Start handler in L<XML::Parser>, in that no attributes |
|
1926 are passed in (use the Attr handler for those.) |
|
1927 |
|
1928 =item Attr ($tag, $attrName, $attrValue, $isSpecified) |
|
1929 |
|
1930 $checker->Attr($tag,$attrName,$attrValue,$spec); |
|
1931 |
|
1932 Checks an attribute with the specified $attrName and $attrValue against the |
|
1933 ATTLIST definition of the element with the specified $tag name. |
|
1934 $isSpecified means whether the attribute was specified (1) or defaulted (0). |
|
1935 |
|
1936 =item EndAttr () |
|
1937 |
|
1938 $checker->EndAttr; |
|
1939 |
|
1940 This should be called after all attributes are passed with Attr(). |
|
1941 It will check which of the #REQUIRED attributes were not specified and generate |
|
1942 the appropriate error (159) for each one that is missing. |
|
1943 |
|
1944 =item CDATA ($text) |
|
1945 |
|
1946 $checker->CDATA($text); |
|
1947 |
|
1948 This should be called whenever CDATASections are encountered. |
|
1949 Similar to Char handler (but might perform different checks later...) |
|
1950 |
|
1951 =item EntityRef ($entity, $isParameterEntity) |
|
1952 |
|
1953 $checker->EntityRef($entity,$isParameterEntity); |
|
1954 |
|
1955 Checks the ENTITY reference. Set $isParameterEntity to 1 for |
|
1956 entity references that start with '%'. |
|
1957 |
|
1958 =item InitDomElem () and FinalDomElem () |
|
1959 |
|
1960 Used by XML::DOM::Element::check() to initialize (and cleanup) the |
|
1961 context stack when checking a single element. |
|
1962 |
|
1963 =back |
|
1964 |
|
1965 =head2 PerlSAX interface |
|
1966 |
|
1967 XML::Checker now also supports the PerlSAX interface, so you can use XML::Checker |
|
1968 wherever you use PerlSAX handlers. |
|
1969 |
|
1970 XML::Checker implements the following methods: start_document, end_document, |
|
1971 start_element, end_element, characters, processing_instruction, comment, |
|
1972 start_cdata, end_cdata, entity_reference, notation_decl, unparsed_entity_decl, |
|
1973 entity_decl, element_decl, attlist_decl, doctype_decl, xml_decl |
|
1974 |
|
1975 Not implemented: set_document_locator, ignorable_whitespace |
|
1976 |
|
1977 See PerlSAX.pod for details. (It is called lib/PerlSAX.pod in the libxml-perl |
|
1978 distribution which can be found at CPAN.) |
|
1979 |
|
1980 =head1 CAVEATS |
|
1981 |
|
1982 This is an alpha release. Almost everything is subject to change. |
|
1983 |
|
1984 =head1 AUTHOR |
|
1985 |
|
1986 Send bug reports, hints, tips, suggestions to Enno Derksen at |
|
1987 <F<enno@att.com>>. |
|
1988 |
|
1989 =head1 SEE ALSO |
|
1990 |
|
1991 The home page of XML::Checker at L<http://www.erols.com/enno/checker/index.html> |
|
1992 |
|
1993 The XML spec (Extensible Markup Language 1.0) at L<http://www.w3.org/TR/REC-xml> |
|
1994 |
|
1995 The L<XML::Parser> and L<XML::Parser::Expat> manual pages. |
|
1996 |
|
1997 The other packages that come with XML::Checker: |
|
1998 L<XML::Checker::Parser>, L<XML::DOM::ValParser> |
|
1999 |
|
2000 The DOM Level 1 specification at L<http://www.w3.org/TR/REC-DOM-Level-1> |
|
2001 |
|
2002 The PerlSAX specification. It is currently in lib/PerlSAX.pod in the |
|
2003 libxml-perl distribution by Ken MacLeod. |
|
2004 |
|
2005 The original SAX specification (Simple API for XML) can be found at |
|
2006 L<http://www.megginson.com/SAX> and L<http://www.megginson.com/SAX/SAX2> |
|