/[suikacvs]/markup/html/whatpm/Whatpm/IMTChecker.pm
Suika

Diff of /markup/html/whatpm/Whatpm/IMTChecker.pm

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

revision 1.1 by wakaba, Sat May 26 08:12:34 2007 UTC revision 1.2 by wakaba, Sat Jun 30 13:12:33 2007 UTC
# Line 6  use strict; Line 6  use strict;
6  ## RFC 1521, which contains BNF rules for parameter values.  ## RFC 1521, which contains BNF rules for parameter values.
7    
8  our $Type;  our $Type;
9    
10    my $application_xml_charset = { ## TODO: ...
11      syntax => 'token',
12    };
13    
14    $Type->{application}->{registered} = 1;
15    
16    $Type->{application}->{subtype}->{'rdf+xml'} = { # RFC 3870
17      parameter => {
18        charset => $application_xml_charset,
19      },
20      registered => 1,
21    
22      ## RECOMMENDED that an RDF document follows new RDF/XML spec
23      ## rather than 1999 spec - this is not testable in this layer.
24    };
25    
26    $Type->{application}->{subtype}->{'rss+xml'} = {
27      parameter => {
28      },
29      ## NOTE: Not registered
30    };
31    
32    $Type->{audio}->{registered} = 1;
33    
34    $Type->{image}->{registered} = 1;
35    
36    $Type->{message}->{registered} = 1;
37    
38    $Type->{model}->{registered} = 1;
39    
40    $Type->{multipart}->{registered} = 1;
41    
42    $Type->{text}->{registered} = 1;
43    
44  $Type->{text}->{subtype}->{plain} = {  $Type->{text}->{subtype}->{plain} = {
45    parameter => {    parameter => {
46      charset => {syntax => 'token'}, # RFC 2046 ## TODO: registered?      charset => {syntax => 'token'}, # RFC 2046 ## TODO: registered?
47      'charset-edition' => {}, # RFC 1922      'charset-edition' => {}, # RFC 1922
48      'charset-extension' => {syntax => 'token'}, # RFC 1922 ## TODO: registered?      'charset-extension' => {syntax => 'token'}, # RFC 1922 ## TODO: registered?
49    },    },
50      registered => 1,
51  };  };
52  $Type->{text}->{subtype}->{html} = { # RFC 2854  $Type->{text}->{subtype}->{html} = { # RFC 2854
53    parameter => {    parameter => {
# Line 19  $Type->{text}->{subtype}->{html} = { # R Line 55  $Type->{text}->{subtype}->{html} = { # R
55      level => {obsolete =>1}, # RFC 1866      level => {obsolete =>1}, # RFC 1866
56      version => {obsolete => 1}, # HTML 3.0      version => {obsolete => 1}, # HTML 3.0
57    },    },
58      registered => 1,
59  };  };
60  $Type->{text}->{subtype}->{css} = { # RFC 2318  $Type->{text}->{subtype}->{css} = { # RFC 2318
61    parameter => {    parameter => {
62      charset => {}, ## TODO: US-ASCII, iso-8859-X, utf-8 are recommended ## TODO: Any charset that is a superset of US-ASCII may be used ## NOTE: Syntax and range are not defined.      charset => {}, ## TODO: US-ASCII, iso-8859-X, utf-8 are recommended ## TODO: Any charset that is a superset of US-ASCII may be used ## NOTE: Syntax and range are not defined.
63    },    },
64      registered => 1,
65  };  };
66  $Type->{text}->{subtype}->{javascript} = { # RFC 4329  $Type->{text}->{subtype}->{javascript} = { # RFC 4329
67    parameter => {    parameter => {
# Line 32  $Type->{text}->{subtype}->{javascript} = Line 70  $Type->{text}->{subtype}->{javascript} =
70        my ($value, $onerror) = @_;        my ($value, $onerror) = @_;
71        unless ($value eq '1') {        unless ($value eq '1') {
72          $onerror->(type => 'value syntax error:e4x', level => 'm');          $onerror->(type => 'value syntax error:e4x', level => 'm');
73            ## NOTE: Whether values other than "1" is non-conformant
74            ## or not is not defined actually...
75        }        }
76      }},      }},
77    },    },
78    obsolete => 1,    obsolete => 1,
79      registered => 1,
80  };  };
81  $Type->{text}->{subtype}->{ecmascript} = { # RFC 4329  $Type->{text}->{subtype}->{ecmascript} = { # RFC 4329
82    parameter => {    parameter => {
83      charset => $Type->{text}->{subtype}->{javascript}->{parameter}->{charset},      charset => $Type->{text}->{subtype}->{javascript}->{parameter}->{charset},
84    },    },
85      registered => 1,
86  };  };
87  $Type->{audio}->{subtype}->{mpeg} = { # RFC 3003  $Type->{audio}->{subtype}->{mpeg} = { # RFC 3003
88      registered => 1,
89  };  };
90  my $CodecsParameter = { # RFC 4281  my $CodecsParameter = { # RFC 4281
91    ## TODO: syntax and value check    ## TODO: syntax and value check
# Line 51  $Type->{audio}->{subtype}->{'3gpp'} = { Line 94  $Type->{audio}->{subtype}->{'3gpp'} = {
94    parameter => {    parameter => {
95      codecs => $CodecsParameter, # RFC 4281      codecs => $CodecsParameter, # RFC 4281
96    },    },
97      registered => 1,
98  };  };
99    
100    $Type->{video}->{registered} = 1;
101    
102  $Type->{video}->{subtype}->{'3gpp'} = {  $Type->{video}->{subtype}->{'3gpp'} = {
103    parameter => {    parameter => {
104      codecs => $CodecsParameter, # RFC 4281      codecs => $CodecsParameter, # RFC 4281
105    },    },
106      registered => 1,
107  };  };
108  $Type->{audio}->{subtype}->{'3gpp2'} = { # RFC 4393  $Type->{audio}->{subtype}->{'3gpp2'} = { # RFC 4393
109    parameter => {    parameter => {
110      codecs => $CodecsParameter, # RFC 4393 -> RFC 4281      codecs => $CodecsParameter, # RFC 4393 -> RFC 4281
111    },    },
112      registered => 1,
113  };  };
114  $Type->{video}->{subtype}->{'3gpp2'} = { # RFC 4393  $Type->{video}->{subtype}->{'3gpp2'} = { # RFC 4393
115    parameter => {    parameter => {
116      codecs => $CodecsParameter, # RFC 4393 -> RFC 4281      codecs => $CodecsParameter, # RFC 4393 -> RFC 4281
117    },    },
118      registered => 1,
119  };  };
120  $Type->{application}->{subtype}->{'octet-stream'} = {  $Type->{application}->{subtype}->{'octet-stream'} = {
121    parameter => {    parameter => {
# Line 74  $Type->{application}->{subtype}->{'octet Line 124  $Type->{application}->{subtype}->{'octet
124      padding => {}, # RFC 2046      padding => {}, # RFC 2046
125      type => {}, # RFC 2046      type => {}, # RFC 2046
126    },    },
127      registered => 1,
128  };  };
129  $Type->{application}->{subtype}->{javascript} = { # RFC 4329  $Type->{application}->{subtype}->{javascript} = { # RFC 4329
130    parameter => {    parameter => {
131      charset => $Type->{text}->{subtype}->{javascript}->{parameter}->{charset},      charset => $Type->{text}->{subtype}->{javascript}->{parameter}->{charset},
132    },    },
133      registered => 1,
134  };  };
135  $Type->{application}->{subtype}->{ecmascript} = { # RFC 4329  $Type->{application}->{subtype}->{ecmascript} = { # RFC 4329
136    parameter => {    parameter => {
137      charset => $Type->{text}->{subtype}->{ecmascript}->{parameter}->{charset},      charset => $Type->{text}->{subtype}->{ecmascript}->{parameter}->{charset},
138    },    },
139      registered => 1,
140  };  };
141  $Type->{multipart}->{parameter}->{boundary} = {  $Type->{multipart}->{parameter}->{boundary} = {
142    checker => sub {    checker => sub {
# Line 100  $Type->{message}->{subtype}->{partial} = Line 153  $Type->{message}->{subtype}->{partial} =
153      number => {required => 1}, # RFC 2046      number => {required => 1}, # RFC 2046
154      total => {}, # RFC 2046 # required for the last fragment      total => {}, # RFC 2046 # required for the last fragment
155    },    },
156      registered => 1,
157  };  };
158  $Type->{message}->{subtype}->{'external-body'} = {  $Type->{message}->{subtype}->{'external-body'} = {
159    parameter => {    parameter => {
# Line 112  $Type->{message}->{subtype}->{'external- Line 166  $Type->{message}->{subtype}->{'external-
166      size => {}, # RFC 2046      size => {}, # RFC 2046
167      ## TODO: access-type dependent parameters      ## TODO: access-type dependent parameters
168    },    },
169      registered => 1,
170  };  };
171    
172  sub check_imt ($$$$@) {  sub check_imt ($$$$@) {
# Line 135  sub check_imt ($$$$@) { Line 190  sub check_imt ($$$$@) {
190    
191    my $type_def = $Type->{$type};    my $type_def = $Type->{$type};
192    my $has_param;    my $has_param;
193    
194      if ($type =~ /^x[-\.]/) { ## TODO: Is there x. tree?
195        $onerror->(type => 'private type', level => 's'); ## TODO: What level?
196      } elsif ($type_def and not $type_def->{registered}) {
197        $onerror->(type => 'unregistered type', level => 's'); ## TODO: What level?
198      }
199    
200    if ($type_def) {    if ($type_def) {
201      my $subtype_def = $type_def->{subtype}->{$subtype};      my $subtype_def = $type_def->{subtype}->{$subtype};
202    
203        if ($subtype =~ /^x[-\.]/) {
204          $onerror->(type => 'private subtype', level => 's'); ## TODO: What level?
205        } elsif ($subtype_def and not $subtype_def->{registered}) {
206          $onerror->(type => 'unregistered subtype', level => 's'); ## TODO: What level?
207        }
208        if ($subtype_def->{obsolete}) {
209          $onerror->(type => 'obsolete subtype', level => 's');
210        }
211        
212      if ($subtype_def) {      if ($subtype_def) {
213        for (0..$imt->parameter_length-1) {        for (0..$imt->parameter_length-1) {
214          my $attr = $imt->get_attribute ($_);          my $attr = $imt->get_attribute ($_);
# Line 164  sub check_imt ($$$$@) { Line 236  sub check_imt ($$$$@) {
236              }              }
237            }            }
238          } else {          } else {
239            $onerror->(type => 'parameter not supported:'.$attr, level => 'w');            $onerror->(type => 'parameter:'.$attr, level => 'unsupported');
240          }          }
241        }        }
242    
# Line 174  sub check_imt ($$$$@) { Line 246  sub check_imt ($$$$@) {
246            $onerror->(type => 'parameter missing:'.$_, level => 'm');            $onerror->(type => 'parameter missing:'.$_, level => 'm');
247          }          }
248        }        }
           
       if ($subtype_def->{obsolete}) {  
         $onerror->(type => 'obsolete subtype', level => 's');  
       }  
249      } else {      } else {
250        $onerror->(type => 'subtype not supported', level => 'w');        $onerror->(type => 'subtype', level => 'unsupported');
251      }      }
252    
253      for (keys %{$type_def->{parameter} or {}}) {      for (keys %{$type_def->{parameter} or {}}) {
# Line 189  sub check_imt ($$$$@) { Line 257  sub check_imt ($$$$@) {
257        }        }
258      }      }
259    } else {    } else {
260      $onerror->(type => 'type not supported', level => 'w');      $onerror->(type => 'type', level => 'unsupported');
261    }    }
   ## TODO: registered?  
262  } # check_imt  } # check_imt
263    
264  1;  1;
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24