/[suikacvs]/test/html-webhacc/WebHACC/Language/HTML.pm
Suika

Diff of /test/html-webhacc/WebHACC/Language/HTML.pm

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

revision 1.1 by wakaba, Sun Jul 20 14:58:24 2008 UTC revision 1.11 by wakaba, Mon Sep 15 07:20:40 2008 UTC
# Line 3  use strict; Line 3  use strict;
3  require WebHACC::Language::DOM;  require WebHACC::Language::DOM;
4  push our @ISA, 'WebHACC::Language::DOM';  push our @ISA, 'WebHACC::Language::DOM';
5    
 require Message::DOM::DOMImplementation;  
   
6  sub new ($) {  sub new ($) {
7    return bless {}, shift;    return bless {}, shift;
8  } # new  } # new
# Line 12  sub new ($) { Line 10  sub new ($) {
10  sub generate_syntax_error_section ($) {  sub generate_syntax_error_section ($) {
11    my $self = shift;    my $self = shift;
12        
13      require Message::DOM::DOMImplementation;
14    require Encode;    require Encode;
15    require Whatpm::HTML;    require Whatpm::HTML;
16        
17    my $out = $self->output;    my $out = $self->output;
18    $out->start_section (id => 'parse-errors', title => 'Parse Errors');    $out->start_section (role => 'parse-errors');
19    $out->start_tag (id => 'parse-errors-list');    $out->start_error_list (role => 'parse-errors');
20      $self->result->layer_applicable ('syntax');
21    
22    my $input = $self->input;    my $input = $self->input;
23    my $result = $self->result;    my $result = $self->result;
24    
25    my $onerror = sub {    my $onerror = sub {
26      my (%opt) = @_;      my %opt = @_;
27      my ($type, $cls, $msg) = main::get_text ($opt{type}, $opt{level});      $result->add_error (layer => 'syntax', %opt);
     $out->html (qq[<dt class="$cls">] . $result->get_error_label ($input, \%opt));  
     $type =~ tr/ /-/;  
     $type =~ s/\|/%7C/g;  
     $out->html (qq[<dd class="$cls">] . $result->get_error_level_label (\%opt) , $msg);  
     $out->text (' [');  
     $out->link ('Description',  
                 url => '../error-description#' . $type);  
     $out->text (']');  
28    
29      main::add_error ('syntax', \%opt => $result);      if ($opt{type} eq 'chardecode:no error') {
30          $self->result->layer_uncertain ('encode');
31        } elsif ($opt{type} eq 'chardecode:fallback') {
32          $self->result->layer_uncertain ('charset');
33          $self->result->layer_uncertain ('syntax');
34          $self->result->layer_uncertain ('structure');
35          $self->result->layer_uncertain ('semantics');
36        }
37    };    };
38    
39      $self->result->layer_applicable ('charset');
40      my $char_checker = sub ($) {
41        require Whatpm::Charset::UnicodeChecker;
42        return Whatpm::Charset::UnicodeChecker->new_handle ($_[0], 'html5');
43      }; # $char_checker
44    
45    my $dom = Message::DOM::DOMImplementation->new;    my $dom = Message::DOM::DOMImplementation->new;
46    my $doc = $dom->create_document;    my $doc = $dom->create_document;
47    my $el;    my $el;
48    my $inner_html_element = $input->{inner_html_element};    my $inner_html_element = $input->{inner_html_element};
49    if (defined $inner_html_element and length $inner_html_element) {    if (defined $inner_html_element and length $inner_html_element) {
50      $input->{charset} ||= 'windows-1252'; ## TODO: for now.      $input->{charset} ||= 'utf-8';
51      my $t = \($input->{s});      my $t = \($input->{s});
52      unless ($input->{is_char_string}) {      unless ($input->{is_char_string}) {
53        $t = \(Encode::decode ($input->{charset}, $$t));        $t = \(Encode::decode ($input->{charset}, $$t));
54          $self->result->layer_applicable ('encode');
55      }      }
56            
57      $el = $doc->create_element_ns      $el = $doc->create_element_ns
58          ('http://www.w3.org/1999/xhtml', [undef, $inner_html_element]);          ('http://www.w3.org/1999/xhtml', [undef, $inner_html_element]);
59      Whatpm::HTML->set_inner_html ($el, $$t, $onerror);      Whatpm::HTML->set_inner_html ($el, $$t, $onerror, $char_checker);
60    
61      $self->{structure} = $el;      $self->{structure} = $el;
62        $self->{_structure_root} = $doc;
63            ## NOTE: This is necessary, otherwise it would be garbage collected
64            ## before $el is useless, since $el->owner_document is only a weak
65            ## reference.
66    } else {    } else {
67      if ($input->{is_char_string}) {      if ($input->{is_char_string}) {
68        Whatpm::HTML->parse_char_string ($input->{s} => $doc, $onerror);        Whatpm::HTML->parse_char_string ($input->{s} => $doc,
69                                           $onerror, $char_checker);
70      } else {      } else {
71          $self->result->layer_applicable ('encode');
72        Whatpm::HTML->parse_byte_string        Whatpm::HTML->parse_byte_string
73            ($input->{charset}, $input->{s} => $doc, $onerror);            ($input->{charset}, $input->{s} => $doc, $onerror, $char_checker);
74      }      }
75    
76      $self->{structure} = $doc;      $self->{structure} = $doc;
# Line 66  sub generate_syntax_error_section ($) { Line 78  sub generate_syntax_error_section ($) {
78    $doc->manakai_charset ($input->{official_charset})    $doc->manakai_charset ($input->{official_charset})
79        if defined $input->{official_charset};        if defined $input->{official_charset};
80    
81    $doc->document_uri ($input->{uri});    $doc->document_uri ($input->url);
82    $doc->manakai_entity_base_uri ($input->{base_uri});    $doc->manakai_entity_base_uri ($input->{base_uri});
83    
84    $out->end_tag ('dl');    $doc->input_encoding (undef) if $input->isa ('WebHACC::Input::Text');
85    
86      $out->end_error_list (role => 'parse-errors');
87    $out->end_section;    $out->end_section;
88  } # generate_syntax_error_section  } # generate_syntax_error_section
89    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.11
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24