/[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.3 by wakaba, Sun Aug 5 09:24:56 2007 UTC revision 1.4 by wakaba, Mon Sep 24 04:23:45 2007 UTC
# Line 40  my $GetAtomAttrsChecker = sub { Line 40  my $GetAtomAttrsChecker = sub {
40    };    };
41  }; # $GetAtomAttrsChecker  }; # $GetAtomAttrsChecker
42    
43    my $AtomLanguageTagAttrChecker = sub {
44      ## NOTE: See also $HTMLLanguageTagAttrChecker in HTML.pm.
45    
46      my ($self, $attr) = @_;
47      my $value = $attr->value;
48      require Whatpm::LangTag;
49      Whatpm::LangTag->check_rfc3066_language_tag ($value, sub {
50        my %opt = @_;
51        my $type = 'LangTag:'.$opt{type};
52        $type .= ':' . $opt{subtag} if defined $opt{subtag};
53        $self->{onerror}->(node => $attr, type => $type, value => $opt{value},
54                           level => $opt{level});
55      });
56      ## ISSUE: RFC 4646 (3066bis)?
57    }; # $AtomLanguageTagAttrChecker
58    
59  my $AtomTextConstruct = {  my $AtomTextConstruct = {
60    attrs_checker => $GetAtomAttrsChecker->({    attrs_checker => $GetAtomAttrsChecker->({
61      type => sub { 1 }, # checked in |checker|      type => sub { 1 }, # checked in |checker|
# Line 358  my $AtomDateConstruct = { Line 374  my $AtomDateConstruct = {
374        }        }
375      }      }
376    
377      ## TODO: $s =~ MUST RFC 3339 date-time, uppercase T, Z      ## MUST: RFC 3339 |date-time| with uppercase |T| and |Z|
378      # SHOULD be accurate as possible      if ($s =~ /\A([0-9]{4})-([0-9]{2})-([0-9]{2})T([0-9]{2}):([0-9]{2}):([0-9]{2})(?>\.[0-9]+)?(?>Z|[+-]([0-9]{2}):([0-9]{2}))\z/) {
379          my ($y, $M, $d, $h, $m, $s, $zh, $zm)
380              = ($1, $2, $3, $4, $5, $6, $7, $8);
381          my $node = $todo->{node};
382    
383          ## Check additional constraints described or referenced in
384          ## comments of ABNF rules for |date-time|.
385          my $level = $self->{must_level};
386          if (0 < $M and $M < 13) {      
387            $self->{onerror}->(node => $node, type => 'datetime:bad day',
388                               level => $level)
389                if $d < 1 or
390                    $d > [0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]->[$M];
391            $self->{onerror}->(node => $node, type => 'datetime:bad day',
392                               level => $level)
393                if $M == 2 and $d == 29 and
394                    not ($y % 400 == 0 or ($y % 4 == 0 and $y % 100 != 0));
395          } else {
396            $self->{onerror}->(node => $node, type => 'datetime:bad month',
397                               level => $level);
398          }
399          $self->{onerror}->(node => $node, type => 'datetime:bad hour',
400                             level => $level) if $h > 23;
401          $self->{onerror}->(node => $node, type => 'datetime:bad minute',
402                             level => $level) if $m > 59;
403          $self->{onerror}->(node => $node, type => 'datetime:bad second',
404                             level => $level)
405              if $s > 60; ## NOTE: Validness of leap seconds are not checked.
406          $self->{onerror}->(node => $node, type => 'datetime:bad timezone hour',
407                             level => $level) if $zh > 23;
408          $self->{onerror}->(node => $node, type => 'datetime:bad timezone minute',
409                             level => $level) if $zm > 59;
410        } else {
411          $self->{onerror}->(node => $todo->{node},
412                             type => 'datetime:syntax error',
413                             level => $self->{must_level});
414        }
415        ## NOTE: SHOULD be accurate as possible (cannot be checked)
416    
417      return ($new_todos);      return ($new_todos);
418    },    },
# Line 1049  $Element->{$ATOM_NS}->{link} = { Line 1102  $Element->{$ATOM_NS}->{link} = {
1102                             (defined $opt{position} ? ':'.$opt{position} : ''));                             (defined $opt{position} ? ':'.$opt{position} : ''));
1103        });        });
1104      },      },
1105      hreflang => sub {      hreflang => $AtomLanguageTagAttrChecker,
       my ($self, $attr) = @_;  
       ## TODO: MUST be an RFC 3066 language tag  
       $self->{onerror}->(node => $attr, level => 'unsupported',  
                          type => 'language tag');  
     },  
1106      length => sub { }, # No MUST; in octets.      length => sub { }, # No MUST; in octets.
1107      rel => sub { # MUST      rel => sub { # MUST
1108        my ($self, $attr) = @_;        my ($self, $attr) = @_;
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24