WebHACC/Language/HTML.pm

package WebHACC::Language::HTML;
use strict;
require WebHACC::Language::DOM;
push our @ISA, 'WebHACC::Language::DOM';

sub new ($) {
  return bless {}, shift;
} # new

sub generate_syntax_error_section ($) {
  my $self = shift;
  
  require Message::DOM::DOMImplementation;
  require Encode;
  require Whatpm::HTML;
  
  $self->result->layer_uncertain ('charset');

  my $out = $self->output;
  $out->start_section (role => 'parse-errors');
  $out->start_error_list (role => 'parse-errors');
  $self->result->layer_applicable ('syntax');

  my $input = $self->input;
  my $result = $self->result;

  my $onerror = sub {
    my %opt = @_;
    $result->add_error (layer => 'syntax', %opt);

    if ($opt{type} eq 'chardecode:no error') {
      $self->result->layer_uncertain ('encode');
    } elsif ($opt{type} eq 'chardecode:fallback') {
      $self->result->layer_uncertain ('charset');
      $self->result->layer_uncertain ('syntax');
      $self->result->layer_uncertain ('structure');
      $self->result->layer_uncertain ('semantics');
    }
  };

  my $dom = Message::DOM::DOMImplementation->new;
  my $doc = $dom->create_document;
  my $el;
  my $inner_html_element = $input->{inner_html_element};
  if (defined $inner_html_element and length $inner_html_element) {
    $input->{charset} ||= 'utf-8';
    my $t = \($input->{s});
    unless ($input->{is_char_string}) {
      $t = \(Encode::decode ($input->{charset}, $$t));
      $self->result->layer_applicable ('encode');
    }
    
    $el = $doc->create_element_ns
        ('http://www.w3.org/1999/xhtml', [undef, $inner_html_element]);
    Whatpm::HTML->set_inner_html ($el, $$t, $onerror);

    $self->{structure} = $el;
    $self->{_structure_root} = $doc;
        ## NOTE: This is necessary, otherwise it would be garbage collected
        ## before $el is useless, since $el->owner_document is only a weak
        ## reference.
  } else {
    if ($input->{is_char_string}) {
      Whatpm::HTML->parse_char_string ($input->{s} => $doc, $onerror);
    } else {
      $self->result->layer_applicable ('encode');
      Whatpm::HTML->parse_byte_string
          ($input->{charset}, $input->{s} => $doc, $onerror);
    }

    $self->{structure} = $doc;
  }
  $doc->manakai_charset ($input->{official_charset})
      if defined $input->{official_charset};

  $doc->document_uri ($input->{uri});
  $doc->manakai_entity_base_uri ($input->{base_uri});

  $out->end_error_list (role => 'parse-errors');
  $out->end_section;
} # generate_syntax_error_section

sub source_charset ($) {
  my $self = shift;
  return $self->input->{charset} || ($self->{structure}->owner_document || $self->{structure})->input_encoding;
  ## TODO: Can we always use input_encoding?
} # source_charset

1;
1	package WebHACC::Language::HTML;
2	use strict;
3	require WebHACC::Language::DOM;
4	push our @ISA, 'WebHACC::Language::DOM';
5
6	sub new ($) {
7	return bless {}, shift;
8	} # new
9
10	sub generate_syntax_error_section ($) {
11	my $self = shift;
12
13	require Message::DOM::DOMImplementation;
14	require Encode;
15	require Whatpm::HTML;
16
17	$self->result->layer_uncertain ('charset');
18
19	my $out = $self->output;
20	$out->start_section (role => 'parse-errors');
21	$out->start_error_list (role => 'parse-errors');
22	$self->result->layer_applicable ('syntax');
23
24	my $input = $self->input;
25	my $result = $self->result;
26
27	my $onerror = sub {
28	my %opt = @_;
29	$result->add_error (layer => 'syntax', %opt);
30
31	if ($opt{type} eq 'chardecode:no error') {
32	$self->result->layer_uncertain ('encode');
33	} elsif ($opt{type} eq 'chardecode:fallback') {
34	$self->result->layer_uncertain ('charset');
35	$self->result->layer_uncertain ('syntax');
36	$self->result->layer_uncertain ('structure');
37	$self->result->layer_uncertain ('semantics');
38	}
39	};
40
41	my $dom = Message::DOM::DOMImplementation->new;
42	my $doc = $dom->create_document;
43	my $el;
44	my $inner_html_element = $input->{inner_html_element};
45	if (defined $inner_html_element and length $inner_html_element) {
46	$input->{charset} \|\|= 'utf-8';
47	my $t = \($input->{s});
48	unless ($input->{is_char_string}) {
49	$t = \(Encode::decode ($input->{charset}, $$t));
50	$self->result->layer_applicable ('encode');
51	}
52
53	$el = $doc->create_element_ns
54	('http://www.w3.org/1999/xhtml', [undef, $inner_html_element]);
55	Whatpm::HTML->set_inner_html ($el, $$t, $onerror);
56
57	$self->{structure} = $el;
58	$self->{_structure_root} = $doc;
59	## NOTE: This is necessary, otherwise it would be garbage collected
60	## before $el is useless, since $el->owner_document is only a weak
61	## reference.
62	} else {
63	if ($input->{is_char_string}) {
64	Whatpm::HTML->parse_char_string ($input->{s} => $doc, $onerror);
65	} else {
66	$self->result->layer_applicable ('encode');
67	Whatpm::HTML->parse_byte_string
68	($input->{charset}, $input->{s} => $doc, $onerror);
69	}
70
71	$self->{structure} = $doc;
72	}
73	$doc->manakai_charset ($input->{official_charset})
74	if defined $input->{official_charset};
75
76	$doc->document_uri ($input->{uri});
77	$doc->manakai_entity_base_uri ($input->{base_uri});
78
79	$out->end_error_list (role => 'parse-errors');
80	$out->end_section;
81	} # generate_syntax_error_section
82
83	sub source_charset ($) {
84	my $self = shift;
85	return $self->input->{charset} \|\| ($self->{structure}->owner_document \|\| $self->{structure})->input_encoding;
86	## TODO: Can we always use input_encoding?
87	} # source_charset
88
89	1;