/[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.14 by wakaba, Thu Mar 20 08:54:00 2008 UTC revision 1.15 by wakaba, Thu Mar 20 09:38:47 2008 UTC
# Line 5  require Whatpm::ContentChecker; Line 5  require Whatpm::ContentChecker;
5  require Whatpm::URIChecker;  require Whatpm::URIChecker;
6    
7  my $ATOM_NS = q<http://www.w3.org/2005/Atom>;  my $ATOM_NS = q<http://www.w3.org/2005/Atom>;
8    my $THR_NS = q<http://purl.org/syndication/thread/1.0>;
9  my $LINK_REL = q<http://www.iana.org/assignments/relation/>;  my $LINK_REL = q<http://www.iana.org/assignments/relation/>;
10    
11  sub FEATURE_RFC4287 () {  sub FEATURE_RFC4287 () {
# Line 12  sub FEATURE_RFC4287 () { Line 13  sub FEATURE_RFC4287 () {
13    Whatpm::ContentChecker::FEATURE_ALLOWED    Whatpm::ContentChecker::FEATURE_ALLOWED
14  }  }
15    
16    sub FEATURE_RFC4685 () {
17      Whatpm::ContentChecker::FEATURE_STATUS_CR |
18      Whatpm::ContentChecker::FEATURE_ALLOWED
19    }
20    
21  ## MUST be well-formed XML (RFC 4287 references XML 1.0 REC 20040204)  ## MUST be well-formed XML (RFC 4287 references XML 1.0 REC 20040204)
22    
23  ## NOTE: Commants and PIs are not explicitly allowed.  ## NOTE: Commants and PIs are not explicitly allowed.
# Line 440  $Element->{$ATOM_NS}->{entry} = { Line 446  $Element->{$ATOM_NS}->{entry} = {
446        if ($not_allowed) {        if ($not_allowed) {
447          $self->{onerror}->(node => $child_el, type => 'element not allowed');          $self->{onerror}->(node => $child_el, type => 'element not allowed');
448        }        }
449        } elsif ($child_nsuri eq $THR_NS and $child_ln eq 'in-reply-to') {
450          ## ISSUE: Where |thr:in-reply-to| is allowed is not explicit;y
451          ## defined in RFC 4685.
452          #
453      } else {      } else {
454        ## TODO: extension element        ## TODO: extension element
455        $self->{onerror}->(node => $child_el, type => 'element not allowed');        $self->{onerror}->(node => $child_el, type => 'element not allowed');
# Line 965  $Element->{$ATOM_NS}->{id} = { Line 975  $Element->{$ATOM_NS}->{id} = {
975    },    },
976  };  };
977    
978  $Element->{$ATOM_NS}->{link} = {  my $AtomIMTAttrChecker = sub {
   %AtomChecker,  
   check_attrs => $GetAtomAttrsChecker->({  
     href => sub {  
       my ($self, $attr) = @_;  
       ## NOTE: There MUST NOT be any white space.  
       Whatpm::URIChecker->check_iri_reference ($attr->value, sub {  
         my %opt = @_;  
         $self->{onerror}->(node => $attr, level => $opt{level},  
                            type => 'URI::'.$opt{type}.  
                            (defined $opt{position} ? ':'.$opt{position} : ''));  
       });  
     },  
     hreflang => $AtomLanguageTagAttrChecker,  
     length => sub { }, # No MUST; in octets.  
     rel => sub { # MUST  
       my ($self, $attr) = @_;  
       my $value = $attr->value;  
       if ($value =~ /\A(?>[0-9A-Za-z._~!\$&'()*+,;=\x{A0}-\x{D7FF}\x{F900}-\x{FDCF}\x{FDF0}-\x{FFEF}\x{10000}-\x{1FFFD}\x{20000}-\x{2FFFD}\x{30000}-\x{3FFFD}\x{40000}-\x{4FFFD}\x{50000}-\x{5FFFD}\x{60000}-\x{6FFFD}\x{70000}-\x{7FFFD}\x{80000}-\x{8FFFD}\x{90000}-\x{9FFFD}\x{A0000}-\x{AFFFD}\x{B0000}-\x{BFFFD}\x{C0000}-\x{CFFFD}\x{D0000}-\x{DFFFD}\x{E1000}-\x{EFFFD}-]|%[0-9A-Fa-f][0-9A-Fa-f]|\@)+\z/) {  
         $value = $LINK_REL . $value;  
       }  
   
       ## NOTE: There MUST NOT be any white space.  
       Whatpm::URIChecker->check_iri ($value, sub {  
         my %opt = @_;  
         $self->{onerror}->(node => $attr, level => $opt{level},  
                            type => 'URI::'.$opt{type}.  
                            (defined $opt{position} ? ':'.$opt{position} : ''));  
       });  
   
       ## TODO: Warn if unregistered  
     },  
     title => sub { }, # No MUST  
     type => sub {  
       ## NOTE: MUST be a MIME media type.  What is "MIME media type"?  
979        my ($self, $attr) = @_;        my ($self, $attr) = @_;
980        my $value = $attr->value;        my $value = $attr->value;
981        my $lws0 = qr/(?>(?>\x0D\x0A)?[\x09\x20])*/;        my $lws0 = qr/(?>(?>\x0D\x0A)?[\x09\x20])*/;
# Line 1027  $Element->{$ATOM_NS}->{link} = { Line 1003  $Element->{$ATOM_NS}->{link} = {
1003        } else {        } else {
1004          $self->{onerror}->(node => $attr, type => 'IMT:syntax error');          $self->{onerror}->(node => $attr, type => 'IMT:syntax error');
1005        }        }
1006    }; # $AtomIMTAttrChecker
1007    
1008    my $AtomIRIReferenceAttrChecker = sub {
1009      my ($self, $attr) = @_;
1010      ## NOTE: There MUST NOT be any white space.
1011      Whatpm::URIChecker->check_iri_reference ($attr->value, sub {
1012        my %opt = @_;
1013        $self->{onerror}->(node => $attr, level => $opt{level},
1014                           type => 'URI::'.$opt{type}.
1015                           (defined $opt{position} ? ':'.$opt{position} : ''));
1016      });
1017    }; # $AtomIRIReferenceAttrChecker
1018    
1019    $Element->{$ATOM_NS}->{link} = {
1020      %AtomChecker,
1021      check_attrs => $GetAtomAttrsChecker->({
1022        href => $AtomIRIReferenceAttrChecker,
1023        hreflang => $AtomLanguageTagAttrChecker,
1024        length => sub { }, # No MUST; in octets.
1025        rel => sub { # MUST
1026          my ($self, $attr) = @_;
1027          my $value = $attr->value;
1028          if ($value =~ /\A(?>[0-9A-Za-z._~!\$&'()*+,;=\x{A0}-\x{D7FF}\x{F900}-\x{FDCF}\x{FDF0}-\x{FFEF}\x{10000}-\x{1FFFD}\x{20000}-\x{2FFFD}\x{30000}-\x{3FFFD}\x{40000}-\x{4FFFD}\x{50000}-\x{5FFFD}\x{60000}-\x{6FFFD}\x{70000}-\x{7FFFD}\x{80000}-\x{8FFFD}\x{90000}-\x{9FFFD}\x{A0000}-\x{AFFFD}\x{B0000}-\x{BFFFD}\x{C0000}-\x{CFFFD}\x{D0000}-\x{DFFFD}\x{E1000}-\x{EFFFD}-]|%[0-9A-Fa-f][0-9A-Fa-f]|\@)+\z/) {
1029            $value = $LINK_REL . $value;
1030          }
1031    
1032          ## NOTE: There MUST NOT be any white space.
1033          Whatpm::URIChecker->check_iri ($value, sub {
1034            my %opt = @_;
1035            $self->{onerror}->(node => $attr, level => $opt{level},
1036                               type => 'URI::'.$opt{type}.
1037                               (defined $opt{position} ? ':'.$opt{position} : ''));
1038          });
1039    
1040          ## TODO: Warn if unregistered
1041      },      },
1042        title => sub { }, # No MUST
1043        type => $AtomIMTAttrChecker,
1044        ## NOTE: MUST be a MIME media type.  What is "MIME media type"?
1045    }, {    }, {
1046      href => FEATURE_RFC4287,      href => FEATURE_RFC4287,
1047      hreflang => FEATURE_RFC4287,      hreflang => FEATURE_RFC4287,
# Line 1173  $Element->{$ATOM_NS}->{updated} = \%Atom Line 1187  $Element->{$ATOM_NS}->{updated} = \%Atom
1187    
1188  ## TODO: simple extension element and structured extension element  ## TODO: simple extension element and structured extension element
1189    
1190    ## -- Atom Threading 1.0 [RFC 4685]
1191    
1192    $Element->{$THR_NS}->{''} = {
1193      %AtomChecker,
1194      status => 0,
1195    };
1196    
1197    ## ISSUE: Strictly speaking, thr:* element/attribute,
1198    ## where * is an undefined local name, is not disallowed.
1199    
1200    $Element->{$THR_NS}->{'in-reply-to'} = {
1201      %AtomChecker,
1202      status => FEATURE_RFC4685,
1203      check_attrs => $GetAtomAttrsChecker->({
1204        href => $AtomIRIReferenceAttrChecker,
1205            ## TODO: fact-level.
1206            ## TODO: MUST be dereferencable.
1207        ref => sub {
1208          my ($self, $attr, $item, $element_state) = @_;
1209          $element_state->{has_ref} = 1;
1210    
1211          ## NOTE: Same as |atom:id|.
1212          ## NOTE: There MUST NOT be any white space.
1213          Whatpm::URIChecker->check_iri ($attr->value, sub {
1214            my %opt = @_;
1215            $self->{onerror}->(node => $attr, level => $opt{level},
1216                               type => 'URI::'.$opt{type}.
1217                               (defined $opt{position} ? ':'.$opt{position} : ''));
1218          });
1219    
1220          ## TODO: Check against ID guideline...
1221        },
1222        source => $AtomIRIReferenceAttrChecker,
1223            ## TODO: fact-level.
1224            ## TODO: MUST be dereferencable.
1225        type => $AtomIMTAttrChecker,
1226            ## TODO: fact-level.
1227      }, {
1228        href => FEATURE_RFC4685,
1229        source => FEATURE_RFC4685,
1230        ref => FEATURE_RFC4685,
1231        type => FEATURE_RFC4685,
1232      }),
1233      check_end => sub {
1234        my ($self, $item, $element_state) = @_;
1235      
1236        unless ($element_state->{has_ref}) {
1237          $self->{onerror}->(node => $item->{node},
1238                             type => 'attribute missing:ref',
1239                             level => $self->{must_level});
1240        }
1241    
1242        $AtomChecker{check_end}->(@_);
1243      },
1244      ## NOTE: Content model has no constraint.
1245    };
1246    
1247  $Whatpm::ContentChecker::Namespace->{$ATOM_NS}->{loaded} = 1;  $Whatpm::ContentChecker::Namespace->{$ATOM_NS}->{loaded} = 1;
1248    $Whatpm::ContentChecker::Namespace->{$THR_NS}->{loaded} = 1;
1249    
1250  1;  1;
Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24