/[suikacvs]/markup/html/whatpm/Whatpm/ContentChecker/Atom.pm
Suika

Diff of /markup/html/whatpm/Whatpm/ContentChecker/Atom.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.17 by wakaba, Thu Mar 20 10:58:17 2008 UTC revision 1.18 by wakaba, Fri Aug 15 12:46:44 2008 UTC
# Line 47  my $GetAtomAttrsChecker = sub { Line 47  my $GetAtomAttrsChecker = sub {
47        } elsif ($attr_ln eq '') {        } elsif ($attr_ln eq '') {
48          #          #
49        } else {        } else {
50          $self->{onerror}->(node => $attr, level => 'unsupported',          $self->{onerror}->(node => $attr,
51                             type => 'attribute');                             type => 'unknown attribute',
52                               level => $self->{level}->{uncertain});
53          ## ISSUE: No comformance createria for unknown attributes in the spec          ## ISSUE: No comformance createria for unknown attributes in the spec
54        }        }
55    
# Line 67  my $AtomLanguageTagAttrChecker = sub { Line 68  my $AtomLanguageTagAttrChecker = sub {
68    my $value = $attr->value;    my $value = $attr->value;
69    require Whatpm::LangTag;    require Whatpm::LangTag;
70    Whatpm::LangTag->check_rfc3066_language_tag ($value, sub {    Whatpm::LangTag->check_rfc3066_language_tag ($value, sub {
71      my %opt = @_;      $self->{onerror}->(@_, node => $attr);
     my $type = 'LangTag:'.$opt{type};  
     $type .= ':' . $opt{subtag} if defined $opt{subtag};  
     $self->{onerror}->(node => $attr, type => $type, value => $opt{value},  
                        level => $opt{level});  
72    });    });
73    ## ISSUE: RFC 4646 (3066bis)?    ## ISSUE: RFC 4646 (3066bis)?
74  }; # $AtomLanguageTagAttrChecker  }; # $AtomLanguageTagAttrChecker
# Line 97  my %AtomTextConstruct = ( Line 94  my %AtomTextConstruct = (
94          $element_state->{type} = $value;          $element_state->{type} = $value;
95        } else {        } else {
96          ## NOTE: IMT MUST NOT be used here.          ## NOTE: IMT MUST NOT be used here.
97          $self->{onerror}->(node => $attr, type => 'keyword:invalid');          $self->{onerror}->(node => $attr,
98                               type => 'invalid attribute value',
99                               level => $self->{level}->{must});
100        }        }
101      }, # checked in |checker|      }, # checked in |checker|
102    }, {    }, {
# Line 109  my %AtomTextConstruct = ( Line 108  my %AtomTextConstruct = (
108      if ($self->{minus_elements}->{$child_nsuri}->{$child_ln}) {      if ($self->{minus_elements}->{$child_nsuri}->{$child_ln}) {
109        $self->{onerror}->(node => $child_el,        $self->{onerror}->(node => $child_el,
110                           type => 'element not allowed:minus',                           type => 'element not allowed:minus',
111                           level => $self->{must_level});                           level => $self->{level}->{must});
112      } elsif ($self->{plus_elements}->{$child_nsuri}->{$child_ln}) {      } elsif ($self->{plus_elements}->{$child_nsuri}->{$child_ln}) {
113        #        #
114      } else {      } else {
# Line 117  my %AtomTextConstruct = ( Line 116  my %AtomTextConstruct = (
116            $element_state->{type} eq 'html') { # MUST NOT            $element_state->{type} eq 'html') { # MUST NOT
117          $self->{onerror}->(node => $child_el,          $self->{onerror}->(node => $child_el,
118                             type => 'element not allowed:atom|TextConstruct',                             type => 'element not allowed:atom|TextConstruct',
119                             level => $self->{must_level});                             level => $self->{level}->{must});
120        } elsif ($element_state->{type} eq 'xhtml') {        } elsif ($element_state->{type} eq 'xhtml') {
121          if ($child_nsuri eq q<http://www.w3.org/1999/xhtml> and          if ($child_nsuri eq q<http://www.w3.org/1999/xhtml> and
122              $child_ln eq 'div') { # MUST              $child_ln eq 'div') { # MUST
# Line 125  my %AtomTextConstruct = ( Line 124  my %AtomTextConstruct = (
124              $self->{onerror}              $self->{onerror}
125                  ->(node => $child_el,                  ->(node => $child_el,
126                     type => 'element not allowed:atom|TextConstruct',                     type => 'element not allowed:atom|TextConstruct',
127                     level => $self->{must_level});                     level => $self->{level}->{must});
128            } else {            } else {
129              $element_state->{has_div} = 1;              $element_state->{has_div} = 1;
130              ## TODO: SHOULD be suitable for handling as HTML [XHTML10]              ## TODO: SHOULD be suitable for handling as HTML [XHTML10]
# Line 133  my %AtomTextConstruct = ( Line 132  my %AtomTextConstruct = (
132          } else {          } else {
133            $self->{onerror}->(node => $child_el,            $self->{onerror}->(node => $child_el,
134                               type => 'element not allowed:atom|TextConstruct',                               type => 'element not allowed:atom|TextConstruct',
135                               level => $self->{must_level});                               level => $self->{level}->{must});
136          }          }
137        } else {        } else {
138          die "atom:TextConstruct type error: $element_state->{type}";          die "atom:TextConstruct type error: $element_state->{type}";
# Line 151  my %AtomTextConstruct = ( Line 150  my %AtomTextConstruct = (
150        if ($has_significant) {        if ($has_significant) {
151          $self->{onerror}->(node => $child_node,          $self->{onerror}->(node => $child_node,
152                             type => 'character not allowed:atom|TextConstruct',                             type => 'character not allowed:atom|TextConstruct',
153                             level => $self->{must_level});                             level => $self->{level}->{must});
154        }        }
155      } else {      } else {
156        die "atom:TextConstruct type error: $element_state->{type}";        die "atom:TextConstruct type error: $element_state->{type}";
# Line 162  my %AtomTextConstruct = ( Line 161  my %AtomTextConstruct = (
161      if ($element_state->{type} eq 'xhtml') {      if ($element_state->{type} eq 'xhtml') {
162        unless ($element_state->{has_div}) {        unless ($element_state->{has_div}) {
163          $self->{onerror}->(node => $item->{node},          $self->{onerror}->(node => $item->{node},
164                             type => 'element missing:div',                             type => 'child element missing',
165                             level => $self->{must_level});                             text => 'div',
166                               level => $self->{level}->{must});
167        }        }
168      } elsif ($element_state->{type} eq 'html') {      } elsif ($element_state->{type} eq 'html') {
169        ## TODO: SHOULD be suitable for handling as HTML [HTML4]        ## TODO: SHOULD be suitable for handling as HTML [HTML4]
# Line 187  my %AtomPersonConstruct = ( Line 187  my %AtomPersonConstruct = (
187      if ($self->{minus_elements}->{$child_nsuri}->{$child_ln}) {      if ($self->{minus_elements}->{$child_nsuri}->{$child_ln}) {
188        $self->{onerror}->(node => $child_el,        $self->{onerror}->(node => $child_el,
189                           type => 'element not allowed:minus',                           type => 'element not allowed:minus',
190                           level => $self->{must_level});                           level => $self->{level}->{must});
191      } elsif ($self->{plus_elements}->{$child_nsuri}->{$child_ln}) {      } elsif ($self->{plus_elements}->{$child_nsuri}->{$child_ln}) {
192        #        #
193      } elsif ($child_nsuri eq $ATOM_NS) {      } elsif ($child_nsuri eq $ATOM_NS) {
# Line 196  my %AtomPersonConstruct = ( Line 196  my %AtomPersonConstruct = (
196            $self->{onerror}            $self->{onerror}
197                ->(node => $child_el,                ->(node => $child_el,
198                   type => 'element not allowed:atom|PersonConstruct',                   type => 'element not allowed:atom|PersonConstruct',
199                   level => $self->{must_level});                   level => $self->{level}->{must});
200          } else {          } else {
201            $element_state->{has_name} = 1;            $element_state->{has_name} = 1;
202          }          }
# Line 205  my %AtomPersonConstruct = ( Line 205  my %AtomPersonConstruct = (
205            $self->{onerror}            $self->{onerror}
206                ->(node => $child_el,                ->(node => $child_el,
207                   type => 'element not allowed:atom|PersonConstruct',                   type => 'element not allowed:atom|PersonConstruct',
208                   level => $self->{must_level});                   level => $self->{level}->{must});
209          } else {          } else {
210            $element_state->{has_uri} = 1;            $element_state->{has_uri} = 1;
211          }          }
# Line 214  my %AtomPersonConstruct = ( Line 214  my %AtomPersonConstruct = (
214            $self->{onerror}            $self->{onerror}
215                ->(node => $child_el,                ->(node => $child_el,
216                   type => 'element not allowed:atom|PersonConstruct',                   type => 'element not allowed:atom|PersonConstruct',
217                   level => $self->{must_level});                   level => $self->{level}->{must});
218          } else {          } else {
219            $element_state->{has_email} = 1;            $element_state->{has_email} = 1;
220          }          }
# Line 222  my %AtomPersonConstruct = ( Line 222  my %AtomPersonConstruct = (
222          $self->{onerror}          $self->{onerror}
223              ->(node => $child_el,              ->(node => $child_el,
224                 type => 'element not allowed:atom|PersonConstruct',                 type => 'element not allowed:atom|PersonConstruct',
225                 level => $self->{must_level});                 level => $self->{level}->{must});
226        }        }
227      } else {      } else {
228        $self->{onerror}        $self->{onerror}
229            ->(node => $child_el,            ->(node => $child_el,
230               type => 'element not allowed:atom|PersonConstruct',               type => 'element not allowed:atom|PersonConstruct',
231               level => $self->{must_level});               level => $self->{level}->{must});
232      }      }
233      ## TODO: extension element      ## TODO: extension element
234    },    },
# Line 237  my %AtomPersonConstruct = ( Line 237  my %AtomPersonConstruct = (
237      if ($has_significant) {      if ($has_significant) {
238        $self->{onerror}->(node => $child_node,        $self->{onerror}->(node => $child_node,
239                           type => 'character not allowed:atom|PersonConstruct',                           type => 'character not allowed:atom|PersonConstruct',
240                           level => $self->{must_level});                           level => $self->{level}->{must});
241      }      }
242    },    },
243    check_end => sub {    check_end => sub {
# Line 245  my %AtomPersonConstruct = ( Line 245  my %AtomPersonConstruct = (
245    
246      unless ($element_state->{has_name}) {      unless ($element_state->{has_name}) {
247        $self->{onerror}->(node => $item->{node},        $self->{onerror}->(node => $item->{node},
248                           type => 'element missing:atom|name',                           type => 'child element missing:atom',
249                           level => $self->{must_level});                           text => 'name',
250                             level => $self->{level}->{must});
251      }      }
252    
253      $AtomChecker{check_end}->(@_);      $AtomChecker{check_end}->(@_);
# Line 290  $Element->{$ATOM_NS}->{uri} = { Line 291  $Element->{$ATOM_NS}->{uri} = {
291    
292      ## NOTE: There MUST NOT be any white space.      ## NOTE: There MUST NOT be any white space.
293      Whatpm::URIChecker->check_iri_reference ($element_state->{value}, sub {      Whatpm::URIChecker->check_iri_reference ($element_state->{value}, sub {
294        my %opt = @_;        $self->{onerror}->(@_, node => $item->{node});
       $self->{onerror}->(node => $item->{node}, level => $opt{level},  
                          type => 'URI::'.$opt{type}.  
                          (defined $opt{position} ? ':'.$opt{position} : ''));  
295      });      });
296    
297      $AtomChecker{check_end}->(@_);      $AtomChecker{check_end}->(@_);
# Line 314  $Element->{$ATOM_NS}->{email} = { Line 312  $Element->{$ATOM_NS}->{email} = {
312      ## TODO: addr-spec      ## TODO: addr-spec
313      $self->{onerror}->(node => $item->{node},      $self->{onerror}->(node => $item->{node},
314                         type => 'addr-spec not supported',                         type => 'addr-spec not supported',
315                         level => $self->{unsupported_level});                         level => $self->{level}->{uncertain});
316    
317      $AtomChecker{check_end}->(@_);      $AtomChecker{check_end}->(@_);
318    },    },
# Line 345  my %AtomDateConstruct = ( Line 343  my %AtomDateConstruct = (
343    
344        ## Check additional constraints described or referenced in        ## Check additional constraints described or referenced in
345        ## comments of ABNF rules for |date-time|.        ## comments of ABNF rules for |date-time|.
       my $level = $self->{must_level};  
346        if (0 < $M and $M < 13) {              if (0 < $M and $M < 13) {      
347          $self->{onerror}->(node => $node, type => 'datetime:bad day',          $self->{onerror}->(node => $node, type => 'datetime:bad day',
348                             level => $level)                             level => $self->{level}->{must})
349              if $d < 1 or              if $d < 1 or
350                  $d > [0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]->[$M];                  $d > [0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]->[$M];
351          $self->{onerror}->(node => $node, type => 'datetime:bad day',          $self->{onerror}->(node => $node, type => 'datetime:bad day',
352                             level => $level)                             level => $self->{level}->{must})
353              if $M == 2 and $d == 29 and              if $M == 2 and $d == 29 and
354                  not ($y % 400 == 0 or ($y % 4 == 0 and $y % 100 != 0));                  not ($y % 400 == 0 or ($y % 4 == 0 and $y % 100 != 0));
355        } else {        } else {
356          $self->{onerror}->(node => $node, type => 'datetime:bad month',          $self->{onerror}->(node => $node, type => 'datetime:bad month',
357                             level => $level);                             level => $self->{level}->{must});
358        }        }
359        $self->{onerror}->(node => $node, type => 'datetime:bad hour',        $self->{onerror}->(node => $node, type => 'datetime:bad hour',
360                           level => $level) if $h > 23;                           level => $self->{level}->{must}) if $h > 23;
361        $self->{onerror}->(node => $node, type => 'datetime:bad minute',        $self->{onerror}->(node => $node, type => 'datetime:bad minute',
362                           level => $level) if $m > 59;                           level => $self->{level}->{must}) if $m > 59;
363        $self->{onerror}->(node => $node, type => 'datetime:bad second',        $self->{onerror}->(node => $node, type => 'datetime:bad second',
364                           level => $level)                           level => $self->{level}->{must})
365            if $s > 60; ## NOTE: Validness of leap seconds are not checked.            if $s > 60; ## NOTE: Validness of leap seconds are not checked.
366        $self->{onerror}->(node => $node, type => 'datetime:bad timezone hour',        $self->{onerror}->(node => $node, type => 'datetime:bad timezone hour',
367                           level => $level) if $zh > 23;                           level => $self->{level}->{must}) if $zh > 23;
368        $self->{onerror}->(node => $node, type => 'datetime:bad timezone minute',        $self->{onerror}->(node => $node, type => 'datetime:bad timezone minute',
369                           level => $level) if $zm > 59;                           level => $self->{level}->{must}) if $zm > 59;
370      } else {      } else {
371        $self->{onerror}->(node => $item->{node},        $self->{onerror}->(node => $item->{node},
372                           type => 'datetime:syntax error',                           type => 'datetime:syntax error',
373                           level => $self->{must_level});                           level => $self->{level}->{must});
374      }      }
375      ## NOTE: SHOULD be accurate as possible (cannot be checked)      ## NOTE: SHOULD be accurate as possible (cannot be checked)
376    
# Line 393  $Element->{$ATOM_NS}->{entry} = { Line 390  $Element->{$ATOM_NS}->{entry} = {
390      if ($self->{minus_elements}->{$child_nsuri}->{$child_ln}) {      if ($self->{minus_elements}->{$child_nsuri}->{$child_ln}) {
391        $self->{onerror}->(node => $child_el,        $self->{onerror}->(node => $child_el,
392                           type => 'element not allowed:minus',                           type => 'element not allowed:minus',
393                           level => $self->{must_level});                           level => $self->{level}->{must});
394      } elsif ($self->{plus_elements}->{$child_nsuri}->{$child_ln}) {      } elsif ($self->{plus_elements}->{$child_nsuri}->{$child_ln}) {
395        #        #
396      } elsif ($child_nsuri eq $ATOM_NS) {      } elsif ($child_nsuri eq $ATOM_NS) {
# Line 445  $Element->{$ATOM_NS}->{entry} = { Line 442  $Element->{$ATOM_NS}->{entry} = {
442          $not_allowed = 1;          $not_allowed = 1;
443        }        }
444        if ($not_allowed) {        if ($not_allowed) {
445          $self->{onerror}->(node => $child_el, type => 'element not allowed');          $self->{onerror}->(node => $child_el, type => 'element not allowed',
446                               level => $self->{level}->{must});
447        }        }
448      } elsif ($child_nsuri eq $THR_NS and $child_ln eq 'in-reply-to') {      } elsif ($child_nsuri eq $THR_NS and $child_ln eq 'in-reply-to') {
449        ## ISSUE: Where |thr:in-reply-to| is allowed is not explicit;y        ## ISSUE: Where |thr:in-reply-to| is allowed is not explicit;y
# Line 455  $Element->{$ATOM_NS}->{entry} = { Line 453  $Element->{$ATOM_NS}->{entry} = {
453        #        #
454      } else {      } else {
455        ## TODO: extension element        ## TODO: extension element
456        $self->{onerror}->(node => $child_el, type => 'element not allowed');        $self->{onerror}->(node => $child_el, type => 'element not allowed',
457                             level => $self->{level}->{must});
458      }      }
459    },    },
460    check_child_text => sub {    check_child_text => sub {
461      my ($self, $item, $child_node, $has_significant, $element_state) = @_;      my ($self, $item, $child_node, $has_significant, $element_state) = @_;
462      if ($has_significant) {      if ($has_significant) {
463        $self->{onerror}->(node => $child_node, type => 'character not allowed',        $self->{onerror}->(node => $child_node, type => 'character not allowed',
464                           level => $self->{must_level});                           level => $self->{level}->{must});
465      }      }
466    },    },
467    check_end => sub {    check_end => sub {
# Line 493  $Element->{$ATOM_NS}->{entry} = { Line 492  $Element->{$ATOM_NS}->{entry} = {
492          }          }
493                    
494          $self->{onerror}->(node => $item->{node},          $self->{onerror}->(node => $item->{node},
495                             type => 'element missing:atom|author',                             type => 'child element missing:atom',
496                             level => $self->{must_level});                             text => 'author',
497                               level => $self->{level}->{must});
498        } # A        } # A
499      }      }
500    
# Line 506  $Element->{$ATOM_NS}->{entry} = { Line 506  $Element->{$ATOM_NS}->{entry} = {
506    
507      unless ($element_state->{has_element}->{id}) { # MUST      unless ($element_state->{has_element}->{id}) { # MUST
508        $self->{onerror}->(node => $item->{node},        $self->{onerror}->(node => $item->{node},
509                           type => 'element missing:atom|id');                           type => 'child element missing:atom',
510                             text => 'id',
511                             level => $self->{level}->{must});
512      }      }
513      unless ($element_state->{has_element}->{title}) { # MUST      unless ($element_state->{has_element}->{title}) { # MUST
514        $self->{onerror}->(node => $item->{node},        $self->{onerror}->(node => $item->{node},
515                           type => 'element missing:atom|title');                           type => 'child element missing:atom',
516                             text => 'title',
517                             level => $self->{level}->{must});
518      }      }
519      unless ($element_state->{has_element}->{updated}) { # MUST      unless ($element_state->{has_element}->{updated}) { # MUST
520        $self->{onerror}->(node => $item->{node},        $self->{onerror}->(node => $item->{node},
521                           type => 'element missing:atom|updated');                           type => 'child element missing:atom',
522                             text => 'updated',
523                             level => $self->{level}->{must});
524      }      }
525      if (not $element_state->{has_element}->{content} and      if (not $element_state->{has_element}->{content} and
526          not $element_state->{has_element}->{'link.alternate'}) {          not $element_state->{has_element}->{'link.alternate'}) {
527        $self->{onerror}->(node => $item->{node},        $self->{onerror}->(node => $item->{node},
528                           type => 'element missing:atom|link|alternate');                           type => 'child element missing:atom:link:alternate',
529                             level => $self->{level}->{must});
530      }      }
531    
532      if ($element_state->{require_summary} and      if ($element_state->{require_summary} and
533          not $element_state->{has_element}->{summary}) {          not $element_state->{has_element}->{summary}) {
534        $self->{onerror}->(node => $item->{node},        $self->{onerror}->(node => $item->{node},
535                           type => 'element missing:atom|summary',                           type => 'child element missing:atom',
536                           level => $self->{must_level});                           text => 'summary',
537                             level => $self->{level}->{must});
538      }      }
539    },    },
540  };  };
# Line 543  $Element->{$ATOM_NS}->{feed} = { Line 551  $Element->{$ATOM_NS}->{feed} = {
551      if ($self->{minus_elements}->{$child_nsuri}->{$child_ln}) {      if ($self->{minus_elements}->{$child_nsuri}->{$child_ln}) {
552        $self->{onerror}->(node => $child_el,        $self->{onerror}->(node => $child_el,
553                           type => 'element not allowed:minus',                           type => 'element not allowed:minus',
554                           level => $self->{must_level});                           level => $self->{level}->{must});
555      } elsif ($self->{plus_elements}->{$child_nsuri}->{$child_ln}) {      } elsif ($self->{plus_elements}->{$child_nsuri}->{$child_ln}) {
556        #        #
557      } elsif ($child_nsuri eq $ATOM_NS) {      } elsif ($child_nsuri eq $ATOM_NS) {
# Line 597  $Element->{$ATOM_NS}->{feed} = { Line 605  $Element->{$ATOM_NS}->{feed} = {
605        } else {        } else {
606          $not_allowed = 1;          $not_allowed = 1;
607        }        }
608        $self->{onerror}->(node => $child_el, type => 'element not allowed')        $self->{onerror}->(node => $child_el, type => 'element not allowed',
609                             level => $self->{level}->{must})
610            if $not_allowed;            if $not_allowed;
611      } else {      } else {
612        ## TODO: extension element        ## TODO: extension element
613        $self->{onerror}->(node => $child_el, type => 'element not allowed');        $self->{onerror}->(node => $child_el, type => 'element not allowed',
614                             level => $self->{level}->{must});
615      }      }
616    },    },
617    check_child_text => sub {    check_child_text => sub {
618      my ($self, $item, $child_node, $has_significant, $element_state) = @_;      my ($self, $item, $child_node, $has_significant, $element_state) = @_;
619      if ($has_significant) {      if ($has_significant) {
620        $self->{onerror}->(node => $child_node, type => 'character not allowed',        $self->{onerror}->(node => $child_node, type => 'character not allowed',
621                           level => $self->{must_level});                           level => $self->{level}->{must});
622      }      }
623    },    },
624    check_end => sub {    check_end => sub {
# Line 617  $Element->{$ATOM_NS}->{feed} = { Line 627  $Element->{$ATOM_NS}->{feed} = {
627      if ($element_state->{has_no_author_entry} and      if ($element_state->{has_no_author_entry} and
628          not $element_state->{has_element}->{author}) {          not $element_state->{has_element}->{author}) {
629        $self->{onerror}->(node => $item->{node},        $self->{onerror}->(node => $item->{node},
630                           type => 'element missing:atom|author',                           type => 'child element missing:atom',
631                           level => $self->{must_level});                           text => 'author',
632                             level => $self->{level}->{must});
633        ## ISSUE: If there is no |atom:entry| element,        ## ISSUE: If there is no |atom:entry| element,
634        ## there should be an |atom:author| element?        ## there should be an |atom:author| element?
635      }      }
# Line 627  $Element->{$ATOM_NS}->{feed} = { Line 638  $Element->{$ATOM_NS}->{feed} = {
638    
639      unless ($element_state->{has_element}->{id}) { # MUST      unless ($element_state->{has_element}->{id}) { # MUST
640        $self->{onerror}->(node => $item->{node},        $self->{onerror}->(node => $item->{node},
641                           type => 'element missing:atom|id');                           type => 'child element missing:atom',
642                             text => 'id',
643                             level => $self->{level}->{must});
644      }      }
645      unless ($element_state->{has_element}->{title}) { # MUST      unless ($element_state->{has_element}->{title}) { # MUST
646        $self->{onerror}->(node => $item->{node},        $self->{onerror}->(node => $item->{node},
647                           type => 'element missing:atom|title');                           type => 'child element missing:atom',
648                             text => 'title',
649                             level => $self->{level}->{must});
650      }      }
651      unless ($element_state->{has_element}->{updated}) { # MUST      unless ($element_state->{has_element}->{updated}) { # MUST
652        $self->{onerror}->(node => $item->{node},        $self->{onerror}->(node => $item->{node},
653                           type => 'element missing:atom|updated');                           type => 'element missing:atom',
654                             text => 'updated',
655                             level => $self->{level}->{must});
656      }      }
657      unless ($element_state->{has_element}->{'link.self'}) {      unless ($element_state->{has_element}->{'link.self'}) {
658        $self->{onerror}->(node => $item->{node}, level => 's',        $self->{onerror}->(node => $item->{node},
659                           type => 'element missing:atom|link|self');                           type => 'element missing:atom:link:self',
660                             level => $self->{level}->{should});
661      }      }
662    
663      $AtomChecker{check_end}->(@_);      $AtomChecker{check_end}->(@_);
# Line 662  $Element->{$ATOM_NS}->{content} = { Line 680  $Element->{$ATOM_NS}->{content} = {
680    
681        ## NOTE: There MUST NOT be any white space.        ## NOTE: There MUST NOT be any white space.
682        Whatpm::URIChecker->check_iri_reference ($attr->value, sub {        Whatpm::URIChecker->check_iri_reference ($attr->value, sub {
683          my %opt = @_;          $self->{onerror}->(@_, node => $item->{node});
         $self->{onerror}->(node => $item->{node}, level => $opt{level},  
                            type => 'URI::'.$opt{type}.  
                            (defined $opt{position} ? ':'.$opt{position} : ''));  
684        });        });
685      },      },
686      type => sub {      type => sub {
# Line 696  $Element->{$ATOM_NS}->{content} = { Line 711  $Element->{$ATOM_NS}->{content} = {
711            }            }
712            require Whatpm::IMTChecker;            require Whatpm::IMTChecker;
713            Whatpm::IMTChecker->check_imt (sub {            Whatpm::IMTChecker->check_imt (sub {
714              my %opt = @_;              $self->{onerror}->(@_, node => $attr);
             $self->{onerror}->(node => $attr, level => $opt{level},  
                                type => 'IMT:'.$opt{type});  
715            }, @type);            }, @type);
716          } else {          } else {
717            $self->{onerror}->(node => $attr, type => 'IMT:syntax error',            $self->{onerror}->(node => $attr, type => 'IMT:syntax error',
718                               level => $self->{must_level});                               level => $self->{level}->{must});
719          }          }
720        }        }
721    
# Line 716  $Element->{$ATOM_NS}->{content} = { Line 729  $Element->{$ATOM_NS}->{content} = {
729          $value = 'mime_text';          $value = 'mime_text';
730        } elsif ($value =~ m!^(?>message|multipart)/!i) {        } elsif ($value =~ m!^(?>message|multipart)/!i) {
731          $self->{onerror}->(node => $attr, type => 'IMT:composite',          $self->{onerror}->(node => $attr, type => 'IMT:composite',
732                             level => $self->{must_level});                             level => $self->{level}->{must});
733          $item->{parent_state}->{require_summary} = 1;          $item->{parent_state}->{require_summary} = 1;
734        } else {        } else {
735          $item->{parent_state}->{require_summary} = 1;          $item->{parent_state}->{require_summary} = 1;
# Line 735  $Element->{$ATOM_NS}->{content} = { Line 748  $Element->{$ATOM_NS}->{content} = {
748      if ($self->{minus_elements}->{$child_nsuri}->{$child_ln}) {      if ($self->{minus_elements}->{$child_nsuri}->{$child_ln}) {
749        $self->{onerror}->(node => $child_el,        $self->{onerror}->(node => $child_el,
750                           type => 'element not allowed:minus',                           type => 'element not allowed:minus',
751                           level => $self->{must_level});                           level => $self->{level}->{must});
752      } elsif ($self->{plus_elements}->{$child_nsuri}->{$child_ln}) {      } elsif ($self->{plus_elements}->{$child_nsuri}->{$child_ln}) {
753        #        #
754      } else {      } else {
# Line 745  $Element->{$ATOM_NS}->{content} = { Line 758  $Element->{$ATOM_NS}->{content} = {
758          # MUST NOT          # MUST NOT
759          $self->{onerror}->(node => $child_el,          $self->{onerror}->(node => $child_el,
760                             type => 'element not allowed:atom|content',                             type => 'element not allowed:atom|content',
761                             level => $self->{must_level});                             level => $self->{level}->{must});
762        } elsif ($element_state->{type} eq 'xhtml') {        } elsif ($element_state->{type} eq 'xhtml') {
763          if ($element_state->{has_div}) {          if ($element_state->{has_div}) {
764            $self->{onerror}->(node => $child_el,            $self->{onerror}->(node => $child_el,
765                               type => 'element not allowed:atom|content',                               type => 'element not allowed:atom|content',
766                               level => $self->{must_level});                               level => $self->{level}->{must});
767          } else {          } else {
768            ## TODO: SHOULD be suitable for handling as HTML [XHTML10]            ## TODO: SHOULD be suitable for handling as HTML [XHTML10]
769            $element_state->{has_div} = 1;            $element_state->{has_div} = 1;
# Line 760  $Element->{$ATOM_NS}->{content} = { Line 773  $Element->{$ATOM_NS}->{content} = {
773          if ($element_state->{has_src}) {          if ($element_state->{has_src}) {
774            $self->{onerror}->(node => $child_el,            $self->{onerror}->(node => $child_el,
775                               type => 'element not allowed:atom|content',                               type => 'element not allowed:atom|content',
776                               level => $self->{must_level});                               level => $self->{level}->{must});
777          }          }
778        } else {        } else {
779          ## NOTE: Elements are not explicitly disallowed.          ## NOTE: Elements are not explicitly disallowed.
# Line 777  $Element->{$ATOM_NS}->{content} = { Line 790  $Element->{$ATOM_NS}->{content} = {
790      if ($has_significant) {      if ($has_significant) {
791        if ($element_state->{has_src}) {        if ($element_state->{has_src}) {
792          $self->{onerror}->(node => $child_node,          $self->{onerror}->(node => $child_node,
793                             type => 'character not allowed',                             type => 'character not allowed:empty',
794                             level => $self->{must_level});                             level => $self->{level}->{must});
795        } elsif ($element_state->{type} eq 'xhtml' or        } elsif ($element_state->{type} eq 'xhtml' or
796                 $element_state->{type} eq 'xml') {                 $element_state->{type} eq 'xml') {
797          $self->{onerror}->(node => $child_node,          $self->{onerror}->(node => $child_node,
798                             type => 'character not allowed:atom|content',                             type => 'character not allowed:atom|content',
799                             level => $self->{must_level});                             level => $self->{level}->{must});
800        }        }
801      }      }
802    
# Line 798  $Element->{$ATOM_NS}->{content} = { Line 811  $Element->{$ATOM_NS}->{content} = {
811      if ($element_state->{has_src}) {      if ($element_state->{has_src}) {
812        if (not $element_state->{has_type}) {        if (not $element_state->{has_type}) {
813          $self->{onerror}->(node => $item->{node},          $self->{onerror}->(node => $item->{node},
814                             type => 'attribute missing:type',                             type => 'attribute missing',
815                             level => $self->{should_level});                             text => 'type',
816                               level => $self->{level}->{should});
817        } elsif ($element_state->{type} eq 'text' or        } elsif ($element_state->{type} eq 'text' or
818                 $element_state->{type} eq 'html' or                 $element_state->{type} eq 'html' or
819                 $element_state->{type} eq 'xhtml') {                 $element_state->{type} eq 'xhtml') {
820          $self->{onerror}          $self->{onerror}
821              ->(node => $item->{node}->get_attribute_node_ns (undef, 'type'),              ->(node => $item->{node}->get_attribute_node_ns (undef, 'type'),
822                 type => 'not IMT', level => $self->{must_level});                 type => 'not IMT', level => $self->{level}->{must});
823        }        }
824      }      }
825    
826      if ($element_state->{type} eq 'xhtml') {      if ($element_state->{type} eq 'xhtml') {
827        unless ($element_state->{has_div}) {        unless ($element_state->{has_div}) {
828          $self->{onerror}->(node => $item->{node},          $self->{onerror}->(node => $item->{node},
829                             type => 'element missing:div',                             type => 'element missing',
830                             level => $self->{must_level});                             text => 'div',
831                               level => $self->{level}->{must});
832        }        }
833      } elsif ($element_state->{type} eq 'html') {      } elsif ($element_state->{type} eq 'html') {
834        ## TODO: SHOULD be suitable for handling as HTML [HTML4]        ## TODO: SHOULD be suitable for handling as HTML [HTML4]
# Line 828  $Element->{$ATOM_NS}->{content} = { Line 843  $Element->{$ATOM_NS}->{content} = {
843        ## If no @src, this would normally mean it contains a        ## If no @src, this would normally mean it contains a
844        ## single child element that would serve as the root element.        ## single child element that would serve as the root element.
845        $self->{onerror}->(node => $item->{node},        $self->{onerror}->(node => $item->{node},
                          level => $self->{unsupported_level},  
846                           type => 'atom|content not supported',                           type => 'atom|content not supported',
847                           value => $item->{node}->get_attribute_ns                           text => $item->{node}->get_attribute_ns
848                               (undef, 'type'));                               (undef, 'type'),
849                             level => $self->{level}->{uncertain});
850      } elsif ($element_state->{type} eq 'text' or      } elsif ($element_state->{type} eq 'text' or
851               $element_state->{type} eq 'mime-text') {               $element_state->{type} eq 'mime-text') {
852        #        #
# Line 842  $Element->{$ATOM_NS}->{content} = { Line 857  $Element->{$ATOM_NS}->{content} = {
857    
858        ## NOTE: SHOULD be suitable for the indicated media type.        ## NOTE: SHOULD be suitable for the indicated media type.
859        $self->{onerror}->(node => $item->{node},        $self->{onerror}->(node => $item->{node},
                          level => $self->{unsupported_level},  
860                           type => 'atom|content not supported',                           type => 'atom|content not supported',
861                           value => $item->{node}->get_attribute_ns                           text => $item->{node}->get_attribute_ns
862                               (undef, 'type'));                               (undef, 'type'),
863                             level => $self->{level}->{uncertain});
864      }      }
865    
866      $AtomChecker{check_end}->(@_);      $AtomChecker{check_end}->(@_);
# Line 863  $Element->{$ATOM_NS}->{category} = { Line 878  $Element->{$ATOM_NS}->{category} = {
878        my ($self, $attr) = @_;        my ($self, $attr) = @_;
879        ## NOTE: There MUST NOT be any white space.        ## NOTE: There MUST NOT be any white space.
880        Whatpm::URIChecker->check_iri ($attr->value, sub {        Whatpm::URIChecker->check_iri ($attr->value, sub {
881          my %opt = @_;          $self->{onerror}->(@_, node => $attr);
         $self->{onerror}->(node => $attr, level => $opt{level},  
                            type => 'URI::'.$opt{type}.  
                            (defined $opt{position} ? ':'.$opt{position} : ''));  
882        });        });
883      },      },
884      term => sub {      term => sub {
# Line 885  $Element->{$ATOM_NS}->{category} = { Line 897  $Element->{$ATOM_NS}->{category} = {
897      my ($self, $item, $element_state) = @_;      my ($self, $item, $element_state) = @_;
898      unless ($element_state->{has_term}) {      unless ($element_state->{has_term}) {
899        $self->{onerror}->(node => $item->{node},        $self->{onerror}->(node => $item->{node},
900                           type => 'attribute missing:term');                           type => 'attribute missing',
901                             text => 'term',
902                             level => $self->{level}->{must});
903      }      }
904    
905      $AtomChecker{check_end}->(@_);      $AtomChecker{check_end}->(@_);
# Line 904  $Element->{$ATOM_NS}->{generator} = { Line 918  $Element->{$ATOM_NS}->{generator} = {
918        my ($self, $attr) = @_;        my ($self, $attr) = @_;
919        ## NOTE: There MUST NOT be any white space.        ## NOTE: There MUST NOT be any white space.
920        Whatpm::URIChecker->check_iri_reference ($attr->value, sub {        Whatpm::URIChecker->check_iri_reference ($attr->value, sub {
921          my %opt = @_;          $self->{onerror}->(@_, node => $attr);
         $self->{onerror}->(node => $attr, level => $opt{level},  
                            type => 'URI::'.$opt{type}.  
                            (defined $opt{position} ? ':'.$opt{position} : ''));  
922        });        });
923        ## NOTE: Dereferencing SHOULD produce a representation        ## NOTE: Dereferencing SHOULD produce a representation
924        ## that is relevant to the agent.        ## that is relevant to the agent.
# Line 941  $Element->{$ATOM_NS}->{icon} = { Line 952  $Element->{$ATOM_NS}->{icon} = {
952      ## NOTE: No MUST.      ## NOTE: No MUST.
953      ## NOTE: There MUST NOT be any white space.      ## NOTE: There MUST NOT be any white space.
954      Whatpm::URIChecker->check_iri_reference ($element_state->{value}, sub {      Whatpm::URIChecker->check_iri_reference ($element_state->{value}, sub {
955        my %opt = @_;        $self->{onerror}->(@_, node => $item->{node});
       $self->{onerror}->(node => $item->{node}, level => $opt{level},  
                          type => 'URI::'.$opt{type}.  
                          (defined $opt{position} ? ':'.$opt{position} : ''));  
956      });      });
957    
958      ## NOTE: Image SHOULD be 1:1 and SHOULD be small      ## NOTE: Image SHOULD be 1:1 and SHOULD be small
# Line 969  $Element->{$ATOM_NS}->{id} = { Line 977  $Element->{$ATOM_NS}->{id} = {
977    
978      ## NOTE: There MUST NOT be any white space.      ## NOTE: There MUST NOT be any white space.
979      Whatpm::URIChecker->check_iri ($element_state->{value}, sub {      Whatpm::URIChecker->check_iri ($element_state->{value}, sub {
980        my %opt = @_;        $self->{onerror}->(@_, node => $item->{node});
       $self->{onerror}->(node => $item->{node}, level => $opt{level},  
                          type => 'URI::'.$opt{type}.  
                          (defined $opt{position} ? ':'.$opt{position} : ''));  
981      });      });
982      ## TODO: SHOULD be normalized      ## TODO: SHOULD be normalized
983    
# Line 1001  my $AtomIMTAttrChecker = sub { Line 1006  my $AtomIMTAttrChecker = sub {
1006          }          }
1007          require Whatpm::IMTChecker;          require Whatpm::IMTChecker;
1008          Whatpm::IMTChecker->check_imt (sub {          Whatpm::IMTChecker->check_imt (sub {
1009            my %opt = @_;            $self->{onerror}->(@_, node => $attr);
           $self->{onerror}->(node => $attr, level => $opt{level},  
                              type => 'IMT:'.$opt{type});  
1010          }, @type);          }, @type);
1011        } else {        } else {
1012          $self->{onerror}->(node => $attr, type => 'IMT:syntax error');          $self->{onerror}->(node => $attr, type => 'IMT:syntax error',
1013                               level => $self->{level}->{must});
1014        }        }
1015  }; # $AtomIMTAttrChecker  }; # $AtomIMTAttrChecker
1016    
# Line 1014  my $AtomIRIReferenceAttrChecker = sub { Line 1018  my $AtomIRIReferenceAttrChecker = sub {
1018    my ($self, $attr) = @_;    my ($self, $attr) = @_;
1019    ## NOTE: There MUST NOT be any white space.    ## NOTE: There MUST NOT be any white space.
1020    Whatpm::URIChecker->check_iri_reference ($attr->value, sub {    Whatpm::URIChecker->check_iri_reference ($attr->value, sub {
1021      my %opt = @_;      $self->{onerror}->(@_, node => $attr);
     $self->{onerror}->(node => $attr, level => $opt{level},  
                        type => 'URI::'.$opt{type}.  
                        (defined $opt{position} ? ':'.$opt{position} : ''));  
1022    });    });
1023  }; # $AtomIRIReferenceAttrChecker  }; # $AtomIRIReferenceAttrChecker
1024    
# Line 1036  $Element->{$ATOM_NS}->{link} = { Line 1037  $Element->{$ATOM_NS}->{link} = {
1037    
1038        ## NOTE: There MUST NOT be any white space.        ## NOTE: There MUST NOT be any white space.
1039        Whatpm::URIChecker->check_iri ($value, sub {        Whatpm::URIChecker->check_iri ($value, sub {
1040          my %opt = @_;          $self->{onerror}->(@_, node => $attr);
         $self->{onerror}->(node => $attr, level => $opt{level},  
                            type => 'URI::'.$opt{type}.  
                            (defined $opt{position} ? ':'.$opt{position} : ''));  
1041        });        });
1042    
1043        ## TODO: Warn if unregistered        ## TODO: Warn if unregistered
# Line 1069  $Element->{$ATOM_NS}->{link} = { Line 1067  $Element->{$ATOM_NS}->{link} = {
1067    
1068      unless ($item->{node}->has_attribute_ns (undef, 'href')) { # MUST      unless ($item->{node}->has_attribute_ns (undef, 'href')) { # MUST
1069        $self->{onerror}->(node => $item->{node},        $self->{onerror}->(node => $item->{node},
1070                           type => 'attribute missing:href');                           type => 'attribute missing',
1071                             text => 'href',
1072                             level => $self->{level}->{must});
1073      }      }
1074    
1075      if ($item->{node}->rel eq $LINK_REL . 'enclosure' and      if ($item->{node}->rel eq $LINK_REL . 'enclosure' and
1076          not $item->{node}->has_attribute_ns (undef, 'length')) {          not $item->{node}->has_attribute_ns (undef, 'length')) {
1077        $self->{onerror}->(node => $item->{node}, level => 's',        $self->{onerror}->(node => $item->{node},
1078                           type => 'attribute missing:length');                           type => 'attribute missing',
1079                             text => 'length',
1080                             level => $self->{level}->{should});
1081      }      }
1082    },    },
1083  };  };
# Line 1097  $Element->{$ATOM_NS}->{logo} = { Line 1099  $Element->{$ATOM_NS}->{logo} = {
1099    
1100      ## NOTE: There MUST NOT be any white space.      ## NOTE: There MUST NOT be any white space.
1101      Whatpm::URIChecker->check_iri_reference ($element_state->{value}, sub {      Whatpm::URIChecker->check_iri_reference ($element_state->{value}, sub {
1102        my %opt = @_;        $self->{onerror}->(@_, node => $item->{node});
       $self->{onerror}->(node => $item->{node}, level => $opt{level},  
                          type => 'URI::'.$opt{type}.  
                          (defined $opt{position} ? ':'.$opt{position} : ''));  
1103      });      });
1104            
1105      ## NOTE: Image SHOULD be 2:1      ## NOTE: Image SHOULD be 2:1
# Line 1123  $Element->{$ATOM_NS}->{source} = { Line 1122  $Element->{$ATOM_NS}->{source} = {
1122      if ($self->{minus_elements}->{$child_nsuri}->{$child_ln}) {      if ($self->{minus_elements}->{$child_nsuri}->{$child_ln}) {
1123        $self->{onerror}->(node => $child_el,        $self->{onerror}->(node => $child_el,
1124                           type => 'element not allowed:minus',                           type => 'element not allowed:minus',
1125                           level => $self->{must_level});                           level => $self->{level}->{must});
1126      } elsif ($self->{plus_elements}->{$child_nsuri}->{$child_ln}) {      } elsif ($self->{plus_elements}->{$child_nsuri}->{$child_ln}) {
1127        #        #
1128      } elsif ($child_nsuri eq $ATOM_NS) {      } elsif ($child_nsuri eq $ATOM_NS) {
# Line 1173  $Element->{$ATOM_NS}->{source} = { Line 1172  $Element->{$ATOM_NS}->{source} = {
1172          $not_allowed = 1;          $not_allowed = 1;
1173        }        }
1174        if ($not_allowed) {        if ($not_allowed) {
1175          $self->{onerror}->(node => $child_el, type => 'element not allowed');          $self->{onerror}->(node => $child_el, type => 'element not allowed',
1176                               level => $self->{level}->{must});
1177        }        }
1178      } else {      } else {
1179        ## TODO: extension element        ## TODO: extension element
1180        $self->{onerror}->(node => $child_el, type => 'element not allowed');        $self->{onerror}->(node => $child_el, type => 'element not allowed',
1181                             level => $self->{level}->{must});
1182      }      }
1183    },    },
1184    check_child_text => sub {    check_child_text => sub {
1185      my ($self, $item, $child_node, $has_significant, $element_state) = @_;      my ($self, $item, $child_node, $has_significant, $element_state) = @_;
1186      if ($has_significant) {      if ($has_significant) {
1187        $self->{onerror}->(node => $child_node, type => 'character not allowed',        $self->{onerror}->(node => $child_node, type => 'character not allowed',
1188                           level => $self->{must_level});                           level => $self->{level}->{must});
1189      }      }
1190    },    },
1191  };  };
# Line 1225  $Element->{$THR_NS}->{'in-reply-to'} = { Line 1226  $Element->{$THR_NS}->{'in-reply-to'} = {
1226        ## NOTE: Same as |atom:id|.        ## NOTE: Same as |atom:id|.
1227        ## NOTE: There MUST NOT be any white space.        ## NOTE: There MUST NOT be any white space.
1228        Whatpm::URIChecker->check_iri ($attr->value, sub {        Whatpm::URIChecker->check_iri ($attr->value, sub {
1229          my %opt = @_;          $self->{onerror}->(@_, node => $attr);
         $self->{onerror}->(node => $attr, level => $opt{level},  
                            type => 'URI::'.$opt{type}.  
                            (defined $opt{position} ? ':'.$opt{position} : ''));  
1230        });        });
1231    
1232        ## TODO: Check against ID guideline...        ## TODO: Check against ID guideline...
# Line 1249  $Element->{$THR_NS}->{'in-reply-to'} = { Line 1247  $Element->{$THR_NS}->{'in-reply-to'} = {
1247        
1248      unless ($element_state->{has_ref}) {      unless ($element_state->{has_ref}) {
1249        $self->{onerror}->(node => $item->{node},        $self->{onerror}->(node => $item->{node},
1250                           type => 'attribute missing:ref',                           type => 'attribute missing',
1251                           level => $self->{must_level});                           text => 'ref',
1252                             level => $self->{level}->{must});
1253      }      }
1254    
1255      $AtomChecker{check_end}->(@_);      $AtomChecker{check_end}->(@_);
# Line 1271  $Element->{$THR_NS}->{total} = { Line 1270  $Element->{$THR_NS}->{total} = {
1270      if ($self->{minus_elements}->{$child_nsuri}->{$child_ln}) {      if ($self->{minus_elements}->{$child_nsuri}->{$child_ln}) {
1271        $self->{onerror}->(node => $child_el,        $self->{onerror}->(node => $child_el,
1272                           type => 'element not allowed:minus',                           type => 'element not allowed:minus',
1273                           level => $self->{must_level});                           level => $self->{level}->{must});
1274      } elsif ($self->{plus_elements}->{$child_nsuri}->{$child_ln}) {      } elsif ($self->{plus_elements}->{$child_nsuri}->{$child_ln}) {
1275        #        #
1276      } else {      } else {
1277        $self->{onerror}->(node => $child_el,        $self->{onerror}->(node => $child_el,
1278                           type => 'element not allowed',                           type => 'element not allowed',
1279                           level => $self->{must_level});                           level => $self->{level}->{must});
1280      }      }
1281    },    },
1282    check_child_text => sub {    check_child_text => sub {
# Line 1290  $Element->{$THR_NS}->{total} = { Line 1289  $Element->{$THR_NS}->{total} = {
1289      ## NOTE: xsd:nonNegativeInteger      ## NOTE: xsd:nonNegativeInteger
1290      unless ($element_state->{value} =~ /\A(?>[0-9]+|-0+)\z/) {      unless ($element_state->{value} =~ /\A(?>[0-9]+|-0+)\z/) {
1291        $self->{onerror}->(node => $item->{node},        $self->{onerror}->(node => $item->{node},
1292                           type => 'syntax error', ## TODO:                           type => 'invalid attribute value',
1293                           level => $self->{must_level});                           level => $self->{level}->{must});
1294      }      }
1295    
1296      $AtomChecker{check_end}->(@_);      $AtomChecker{check_end}->(@_);
Legend:
Removed from v.1.17  
changed lines
  Added in v.1.18
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24