WebHACC/Language/DOM.pm

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

use Scalar::Util qw[refaddr];

sub generate_structure_dump_section ($) {
  my $self = shift;
  
  my $out = $self->output;

  $out->start_section (id => 'document-tree', title => 'Document Tree',
                       short_title => 'Tree');

  $out->start_tag ('ol', class => 'xoxo');

  my @node = ($self->{structure});
  while (@node) {
    my $child = shift @node;
    unless (ref $child) {
      $out->html ($child);
      next;
    }

    my $node_id = 'node-'.refaddr $child;
    my $nt = $child->node_type;
    if ($nt == $child->ELEMENT_NODE) {
      my $child_nsuri = $child->namespace_uri;
      $out->start_tag ('li', id => $node_id, class => 'tree-element');
      $out->start_tag ('code',
                       title => defined $child_nsuri ? $child_nsuri : '');
      $out->text ($child->tag_name); ## TODO: case
      $out->end_tag ('code');

      if ($child->has_attributes) {
        $out->start_tag ('ul', class => 'attributes');
        for my $attr (sort {$a->[0] cmp $b->[0]} map { [$_->name, $_->value, $_->namespace_uri, 'node-'.refaddr $_] }
                      @{$child->attributes}) {
          $out->start_tag ('li', id => $attr->[3], class => 'tree-attribute');
          $out->start_tag ('code',
                           title => defined $attr->[2] ? $attr->[2] : '');
          $out->html ($attr->[0]); ## ISSUE: case
          $out->end_tag ('code');
          $out->text (' = ');
          $out->start_tag ('q');
          $out->text ($attr->[1]); ## TODO: children
          $out->end_tag ('q');
        }
        $out->end_tag ('ul');
      }

      if ($child->has_child_nodes) {
        $out->start_tag ('ol', class => 'children');
        unshift @node, @{$child->child_nodes}, '</ol></li>';
      }
    } elsif ($nt == $child->TEXT_NODE) {
      $out->start_tag ('li', id => $node_id, class => 'tree-text');
      $out->start_tag ('q', lang => '');
      $out->text ($child->data);
      $out->end_tag ('q');
    } elsif ($nt == $child->CDATA_SECTION_NODE) {
      $out->start_tag ('li', id => $node_id, class => 'tree-cdata');
      $out->start_tag ('code');
      $out->text ('<![CDATA[');
      $out->end_tag ('code');
      $out->start_tag ('q', lang => '');
      $out->text ($child->data);
      $out->end_tag ('q');
      $out->start_tag ('code');
      $out->text (']]>');
      $out->end_tag ('code');
    } elsif ($nt == $child->COMMENT_NODE) {
      $out->start_tag ('li', id => $node_id, class => 'tree-cdata');
      $out->start_tag ('code');
      $out->text ('<!--');
      $out->end_tag ('code');
      $out->start_tag ('q', lang => '');
      $out->text ($child->data);
      $out->end_tag ('q');
      $out->start_tag ('code');
      $out->text ('-->');
      $out->end_tag ('code');
    } elsif ($nt == $child->DOCUMENT_NODE) {
      $out->start_tag ('li', id => $node_id, class => 'tree-document');
      $out->text ('Document');
      $out->start_tag ('ul', class => 'attributes');
      my $cp = $child->manakai_charset;
      if (defined $cp) {
        $out->html (qq[<li><code>charset</code> parameter = <code>]);
        $out->text ($cp);
        $out->html ('</code>');
      }
      $out->html (qq[<li><code>inputEncoding</code> = ]);
      my $ie = $child->input_encoding;
      if (defined $ie) {
        $out->code ($ie);
        if ($child->manakai_has_bom) {
          $out->html (qq[ (with <code class=charname><abbr>BOM</abbr></code>)]);
        }
      } else {
        $out->html (qq[(<code>null</code>)]);
      }
      $out->html (qq[<li>@{[scalar main::get_text ('manakaiIsHTML:'.($child->manakai_is_html?1:0))]}</li>]);
      $out->html (qq[<li>@{[scalar main::get_text ('manakaiCompatMode:'.$child->manakai_compat_mode)]}</li>]);
      unless ($child->manakai_is_html) {
        $out->html (qq[<li>XML version = ]);
        $out->code ($child->xml_version);
        if (defined $child->xml_encoding) {
          $out->html (qq[<li>XML encoding = ]);
          $out->code ($child->xml_encoding);
        } else {
          $out->html (qq[<li>XML encoding = (null)</li>]);
        }
        $out->html (qq[<li>XML standalone = @{[$child->xml_standalone ? 'true' : 'false']}</li>]);
      }
      $out->end_tag ('ul');
      if ($child->has_child_nodes) {
        $out->start_tag ('ol', class => 'children');
        unshift @node, @{$child->child_nodes}, '</ol></li>';
      }
    } elsif ($nt == $child->DOCUMENT_TYPE_NODE) {
      $out->start_tag ('li', id => $node_id, class => 'tree-doctype');
      $out->code ('<!DOCTYPE>');
      $out->start_tag ('ul', class => 'attributes');

      $out->start_tag ('li', class => 'tree-doctype-name');
      $out->text ('Name = ');
      $out->code ($child->name);

      $out->start_tag ('li', class => 'tree-doctype-publicid');
      $out->text ('Public identifier = ');
      $out->code ($child->public_id);

      $out->start_tag ('li', class => 'tree-doctype-systemid');
      $out->text ('System identifier = ');
      $out->code ($child->system_id);

      $out->end_tag ('ul');
    } elsif ($nt == $child->PROCESSING_INSTRUCTION_NODE) {
      $out->start_tag ('li', id => $node_id, class => 'tree-id');
      $out->code ('<?');
      $out->code ($child->target);
      $out->text (' ');
      $out->code ($child->data);
      $out->code ('?>');
    } else { # error
      $out->start_tag ('li', id => $node_id, class => 'tree-unknown');
      $out->text ($child->node_type . ' ' . $child->node_name);
    }
  }
  $out->end_tag ('ol');

  $out->end_section;
} # generate_structure_dump_section

sub generate_structure_error_section ($) {
  my $self = shift;
  
  my $out = $self->output;
  $out->start_section (id => 'document-errors', title => 'Document Errors');
  $out->start_tag ('dl', class => 'document-errors-list');

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

  require Whatpm::ContentChecker;
  my $onerror = sub {
    my %opt = @_;
    my ($type, $cls, $msg) = main::get_text ($opt{type}, $opt{level}, $opt{node});
    $type =~ tr/ /-/;
    $type =~ s/\|/%7C/g;
    $out->html (qq[<dt class="$cls">] . $result->get_error_label ($input, \%opt));
    $out->html (qq[<dd class="$cls">] . $result->get_error_level_label (\%opt));
    $out->html ($msg);
    $out->text (' [');
    $out->link ('Description', url => '../error-description#' . $type);
    $out->text (']');
    main::add_error ('structure', \%opt => $result);
  };

  my $onsubdoc = $self->onsubdoc;
  if ($self->{structure}->node_type == $self->{structure}->ELEMENT_NODE) {
    $self->{add_info} = Whatpm::ContentChecker->check_element
        ($self->{structure}, $onerror, $onsubdoc);
  } else {
    $self->{add_info} = Whatpm::ContentChecker->check_document
        ($self->{structure}, $onerror, $onsubdoc);
  }

  $out->end_tag ('dl');
  $out->html (qq[<script>
    addSourceToParseErrorList ('@{[$input->id_prefix]}', 'document-errors-list');
  </script>]);
  $out->end_section;
} # generate_structure_error_section

1;
1	package WebHACC::Language::DOM;
2	use strict;
3	require WebHACC::Language::Base;
4	push our @ISA, 'WebHACC::Language::Base';
5
6	use Scalar::Util qw[refaddr];
7
8	sub generate_structure_dump_section ($) {
9	my $self = shift;
10
11	my $out = $self->output;
12
13	$out->start_section (id => 'document-tree', title => 'Document Tree',
14	short_title => 'Tree');
15
16	$out->start_tag ('ol', class => 'xoxo');
17
18	my @node = ($self->{structure});
19	while (@node) {
20	my $child = shift @node;
21	unless (ref $child) {
22	$out->html ($child);
23	next;
24	}
25
26	my $node_id = 'node-'.refaddr $child;
27	my $nt = $child->node_type;
28	if ($nt == $child->ELEMENT_NODE) {
29	my $child_nsuri = $child->namespace_uri;
30	$out->start_tag ('li', id => $node_id, class => 'tree-element');
31	$out->start_tag ('code',
32	title => defined $child_nsuri ? $child_nsuri : '');
33	$out->text ($child->tag_name); ## TODO: case
34	$out->end_tag ('code');
35
36	if ($child->has_attributes) {
37	$out->start_tag ('ul', class => 'attributes');
38	for my $attr (sort {$a->[0] cmp $b->[0]} map { [$_->name, $_->value, $_->namespace_uri, 'node-'.refaddr $_] }
39	@{$child->attributes}) {
40	$out->start_tag ('li', id => $attr->[3], class => 'tree-attribute');
41	$out->start_tag ('code',
42	title => defined $attr->[2] ? $attr->[2] : '');
43	$out->html ($attr->[0]); ## ISSUE: case
44	$out->end_tag ('code');
45	$out->text (' = ');
46	$out->start_tag ('q');
47	$out->text ($attr->[1]); ## TODO: children
48	$out->end_tag ('q');
49	}
50	$out->end_tag ('ul');
51	}
52
53	if ($child->has_child_nodes) {
54	$out->start_tag ('ol', class => 'children');
55	unshift @node, @{$child->child_nodes}, '</ol></li>';
56	}
57	} elsif ($nt == $child->TEXT_NODE) {
58	$out->start_tag ('li', id => $node_id, class => 'tree-text');
59	$out->start_tag ('q', lang => '');
60	$out->text ($child->data);
61	$out->end_tag ('q');
62	} elsif ($nt == $child->CDATA_SECTION_NODE) {
63	$out->start_tag ('li', id => $node_id, class => 'tree-cdata');
64	$out->start_tag ('code');
65	$out->text ('<![CDATA[');
66	$out->end_tag ('code');
67	$out->start_tag ('q', lang => '');
68	$out->text ($child->data);
69	$out->end_tag ('q');
70	$out->start_tag ('code');
71	$out->text (']]>');
72	$out->end_tag ('code');
73	} elsif ($nt == $child->COMMENT_NODE) {
74	$out->start_tag ('li', id => $node_id, class => 'tree-cdata');
75	$out->start_tag ('code');
76	$out->text ('<!--');
77	$out->end_tag ('code');
78	$out->start_tag ('q', lang => '');
79	$out->text ($child->data);
80	$out->end_tag ('q');
81	$out->start_tag ('code');
82	$out->text ('-->');
83	$out->end_tag ('code');
84	} elsif ($nt == $child->DOCUMENT_NODE) {
85	$out->start_tag ('li', id => $node_id, class => 'tree-document');
86	$out->text ('Document');
87	$out->start_tag ('ul', class => 'attributes');
88	my $cp = $child->manakai_charset;
89	if (defined $cp) {
90	$out->html (qq[<li><code>charset</code> parameter = <code>]);
91	$out->text ($cp);
92	$out->html ('</code>');
93	}
94	$out->html (qq[<li><code>inputEncoding</code> = ]);
95	my $ie = $child->input_encoding;
96	if (defined $ie) {
97	$out->code ($ie);
98	if ($child->manakai_has_bom) {
99	$out->html (qq[ (with <code class=charname><abbr>BOM</abbr></code>)]);
100	}
101	} else {
102	$out->html (qq[(<code>null</code>)]);
103	}
104	$out->html (qq[<li>@{[scalar main::get_text ('manakaiIsHTML:'.($child->manakai_is_html?1:0))]}</li>]);
105	$out->html (qq[<li>@{[scalar main::get_text ('manakaiCompatMode:'.$child->manakai_compat_mode)]}</li>]);
106	unless ($child->manakai_is_html) {
107	$out->html (qq[<li>XML version = ]);
108	$out->code ($child->xml_version);
109	if (defined $child->xml_encoding) {
110	$out->html (qq[<li>XML encoding = ]);
111	$out->code ($child->xml_encoding);
112	} else {
113	$out->html (qq[<li>XML encoding = (null)</li>]);
114	}
115	$out->html (qq[<li>XML standalone = @{[$child->xml_standalone ? 'true' : 'false']}</li>]);
116	}
117	$out->end_tag ('ul');
118	if ($child->has_child_nodes) {
119	$out->start_tag ('ol', class => 'children');
120	unshift @node, @{$child->child_nodes}, '</ol></li>';
121	}
122	} elsif ($nt == $child->DOCUMENT_TYPE_NODE) {
123	$out->start_tag ('li', id => $node_id, class => 'tree-doctype');
124	$out->code ('<!DOCTYPE>');
125	$out->start_tag ('ul', class => 'attributes');
126
127	$out->start_tag ('li', class => 'tree-doctype-name');
128	$out->text ('Name = ');
129	$out->code ($child->name);
130
131	$out->start_tag ('li', class => 'tree-doctype-publicid');
132	$out->text ('Public identifier = ');
133	$out->code ($child->public_id);
134
135	$out->start_tag ('li', class => 'tree-doctype-systemid');
136	$out->text ('System identifier = ');
137	$out->code ($child->system_id);
138
139	$out->end_tag ('ul');
140	} elsif ($nt == $child->PROCESSING_INSTRUCTION_NODE) {
141	$out->start_tag ('li', id => $node_id, class => 'tree-id');
142	$out->code ('<?');
143	$out->code ($child->target);
144	$out->text (' ');
145	$out->code ($child->data);
146	$out->code ('?>');
147	} else { # error
148	$out->start_tag ('li', id => $node_id, class => 'tree-unknown');
149	$out->text ($child->node_type . ' ' . $child->node_name);
150	}
151	}
152	$out->end_tag ('ol');
153
154	$out->end_section;
155	} # generate_structure_dump_section
156
157	sub generate_structure_error_section ($) {
158	my $self = shift;
159
160	my $out = $self->output;
161	$out->start_section (id => 'document-errors', title => 'Document Errors');
162	$out->start_tag ('dl', class => 'document-errors-list');
163
164	my $input = $self->input;
165	my $result = $self->result;
166
167	require Whatpm::ContentChecker;
168	my $onerror = sub {
169	my %opt = @_;
170	my ($type, $cls, $msg) = main::get_text ($opt{type}, $opt{level}, $opt{node});
171	$type =~ tr/ /-/;
172	$type =~ s/\\|/%7C/g;
173	$out->html (qq[<dt class="$cls">] . $result->get_error_label ($input, \%opt));
174	$out->html (qq[<dd class="$cls">] . $result->get_error_level_label (\%opt));
175	$out->html ($msg);
176	$out->text (' [');
177	$out->link ('Description', url => '../error-description#' . $type);
178	$out->text (']');
179	main::add_error ('structure', \%opt => $result);
180	};
181
182	my $onsubdoc = $self->onsubdoc;
183	if ($self->{structure}->node_type == $self->{structure}->ELEMENT_NODE) {
184	$self->{add_info} = Whatpm::ContentChecker->check_element
185	($self->{structure}, $onerror, $onsubdoc);
186	} else {
187	$self->{add_info} = Whatpm::ContentChecker->check_document
188	($self->{structure}, $onerror, $onsubdoc);
189	}
190
191	$out->end_tag ('dl');
192	$out->html (qq[<script>
193	addSourceToParseErrorList ('@{[$input->id_prefix]}', 'document-errors-list');
194	</script>]);
195	$out->end_section;
196	} # generate_structure_error_section
197
198	1;