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	wakaba	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;