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

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

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

revision 1.2 by wakaba, Fri Nov 23 14:47:49 2007 UTC revision 1.3 by wakaba, Sat Feb 16 03:47:33 2008 UTC
# Line 44  sub _parse ($$$$$) { Line 44  sub _parse ($$$$$) {
44    
45      my $u1 = shift;      my $u1 = shift;
46            
47      unless (lc $u1->uri_scheme eq lc $m_scheme) {      unless (lc $u1->uri_scheme eq lc $m_scheme) { ## TODO: case
48        return 0;        return 0;
49      }      }
50    
# Line 106  sub _parse ($$$$$) { Line 106  sub _parse ($$$$$) {
106      my $line = $1;      my $line = $1;
107    
108      ## Step 15      ## Step 15
     next START_OF_LINE if $line =~ /^#/;  
   
     ## Step 16  
109      $line =~ s/[\x20\x09]+\z//;      $line =~ s/[\x20\x09]+\z//;
110    
111        ## Step 16-17
112        if ($line eq '' or $line =~ /^#/) {
113          next START_OF_LINE;
114        }
115    
116      if ($line eq 'CACHE:') {      if ($line eq 'CACHE:') {
117        ## Step 17        ## Step 18
118        $mode = 'explicit';        $mode = 'explicit';
119        next START_OF_LINE;        next START_OF_LINE;
120      } elsif ($line eq 'FALLBACK:') {      } elsif ($line eq 'FALLBACK:') {
121        ## Step 18        ## Step 19
122        $mode = 'fallback';        $mode = 'fallback';
123        next START_OF_LINE;        next START_OF_LINE;
124      } elsif ($line eq 'NETWORK:') {      } elsif ($line eq 'NETWORK:') {
125        ## Step 19        ## Step 20
126        $mode = 'online whitelist';        $mode = 'online whitelist';
127        next START_OF_LINE;        next START_OF_LINE;
128      }      }
# Line 138  sub _parse ($$$$$) { Line 140  sub _parse ($$$$$) {
140      ## NOTE: "Relative URIs MUST be given relative to the manifest's own URI."      ## NOTE: "Relative URIs MUST be given relative to the manifest's own URI."
141      ## requirement in writing section can't be tested.      ## requirement in writing section can't be tested.
142    
143      ## Step 20      ## Step 21
144      if ($mode eq 'explicit') {      if ($mode eq 'explicit') {
145        my $uri = Message::DOM::DOMImplementation->create_uri_reference ($line);        my $uri = Message::DOM::DOMImplementation->create_uri_reference ($line);
146    
# Line 166  sub _parse ($$$$$) { Line 168  sub _parse ($$$$$) {
168                     value => $uri->uri_reference);                     value => $uri->uri_reference);
169          next START_OF_LINE;          next START_OF_LINE;
170        }        }
       ## ISSUE: case-insensitive?  
171    
172        push @$explicit_uris, $uri->uri_reference;        push @$explicit_uris, $uri->uri_reference;
173      } elsif ($mode eq 'fallback') {      } elsif ($mode eq 'fallback') {
# Line 270  sub _parse ($$$$$) { Line 271  sub _parse ($$$$$) {
271        push @$online_whitelist_uris, $uri->uri_reference;              push @$online_whitelist_uris, $uri->uri_reference;      
272      }      }
273    
274      ## Step 21      ## Step 22
275      #next START_OF_LINE;      #next START_OF_LINE;
276    } # START_OF_LINE    } # START_OF_LINE
277    
278    ## Step 22    ## Step 23
279    return [$explicit_uris, $fallback_uris, $online_whitelist_uris];    return [$explicit_uris, $fallback_uris, $online_whitelist_uris,
280              $m_uri->uri_reference];
281  } # _parse  } # _parse
282    
283  sub check_manifest ($$$) {  sub check_manifest ($$$) {
# Line 286  sub check_manifest ($$$) { Line 288  sub check_manifest ($$$) {
288    
289    require Whatpm::URIChecker;    require Whatpm::URIChecker;
290    
291      my $i = 0;
292    for my $uri (@{$manifest->[0]}) {    for my $uri (@{$manifest->[0]}) {
293      $listed->{$uri} = 1;      $listed->{$uri} = 1;
294    
295      Whatpm::URIChecker->check_iri_reference ($uri, sub {      Whatpm::URIChecker->check_iri_reference ($uri, sub {
296        my %opt = @_;        my %opt = @_;
297        $onerror->(level => $opt{level}, value => $uri,        $onerror->(level => $opt{level}, value => $uri,
298                     index => $i,
299                   type => 'URI::'.$opt{type}.                   type => 'URI::'.$opt{type}.
300                   (defined $opt{position} ? ':'.$opt{position} : ''));                   (defined $opt{position} ? ':'.$opt{position} : ''));
301      });      });
   }  
302    
303    for my $uri (values %{$manifest->[1]}) {      ## ISSUE: Literal equivalence, right?
304      $listed->{$uri} = 1;      if ($uri eq $manifest->[3]) {
305          $onerror->(level => $must_level, value => $uri,
306                     index => $i,
307                     type => 'manifest URI');
308        }
309    
310      Whatpm::URIChecker->check_iri_reference ($uri, sub {      $i++;
311      }
312    
313      for my $uri1 (sort {$a cmp $b} keys %{$manifest->[1]}) {
314        Whatpm::URIChecker->check_iri_reference ($uri1, sub {
315        my %opt = @_;        my %opt = @_;
316        $onerror->(level => $opt{level}, index => 1, value => $uri,        $onerror->(level => $opt{level}, index => 0, value => $uri1,
317                   type => 'URI::'.$opt{type}.                   type => 'URI::'.$opt{type}.
318                   (defined $opt{position} ? ':'.$opt{position} : ''));                   (defined $opt{position} ? ':'.$opt{position} : ''));
319      });      });
   }  
320    
321    for my $uri (keys %{$manifest->[1]}) {      if ($uri1 eq $manifest->[3]) {
322      Whatpm::URIChecker->check_iri_reference ($uri, sub {        $onerror->(level => $must_level, value => $uri1,
323                     index => $i,
324                     type => 'manifest URI');
325        }
326    
327        $i++;
328    
329        my $uri2 = $manifest->[1]->{$uri1};
330        $listed->{$uri2} = 1;
331    
332        Whatpm::URIChecker->check_iri_reference ($uri2, sub {
333        my %opt = @_;        my %opt = @_;
334        $onerror->(level => $opt{level}, index => 0, value => $uri,        $onerror->(level => $opt{level}, index => 1, value => $uri2,
335                     index => $i,
336                   type => 'URI::'.$opt{type}.                   type => 'URI::'.$opt{type}.
337                   (defined $opt{position} ? ':'.$opt{position} : ''));                   (defined $opt{position} ? ':'.$opt{position} : ''));
338      });      });
339    
340        if ($uri2 eq $manifest->[3]) {
341          $onerror->(level => $must_level, value => $uri2,
342                     index => $i,
343                     type => 'manifest URI');
344        }
345    
346        $i++;
347    }    }
348    
349    for my $uri (@{$manifest->[2]}) {    for my $uri (@{$manifest->[2]}) {
350      if ($listed->{$uri}) {      if ($listed->{$uri}) {
351        $onerror->(type => 'both in entries and whitelist',        $onerror->(type => 'both in entries and whitelist',
352                     index => $i,
353                   level => $must_level, value => $uri);                   level => $must_level, value => $uri);
354        ## NOTE: MUST in writing section.        ## NOTE: MUST in writing section.
355      }      }
# Line 327  sub check_manifest ($$$) { Line 357  sub check_manifest ($$$) {
357      Whatpm::URIChecker->check_iri_reference ($uri, sub {      Whatpm::URIChecker->check_iri_reference ($uri, sub {
358        my %opt = @_;        my %opt = @_;
359        $onerror->(level => $opt{level}, value => $uri,        $onerror->(level => $opt{level}, value => $uri,
360                     index => $i,
361                   type => 'URI::'.$opt{type}.                   type => 'URI::'.$opt{type}.
362                   (defined $opt{position} ? ':'.$opt{position} : ''));                   (defined $opt{position} ? ':'.$opt{position} : ''));
363      });      });
364    
365        if ($uri eq $manifest->[3]) {
366          $onerror->(level => $must_level, value => $uri,
367                     index => $i,
368                     type => 'manifest URI');
369        }
370    
371        $i++;
372    }    }
373  } # check_manifest  } # check_manifest
374    
375    
376  =head1 LICENSE  =head1 LICENSE
377    
378  Copyright 2007 Wakaba <w@suika.fam.cx>  Copyright 2007-2008 Wakaba <w@suika.fam.cx>
379    
380  This library is free software; you can redistribute it  This library is free software; you can redistribute it
381  and/or modify it under the same terms as Perl itself.  and/or modify it under the same terms as Perl itself.
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24