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 (role => '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}, '';
}
} 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 ('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');
} 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[
charset
parameter = ]);
$out->text ($cp);
$out->html ('
');
}
$out->html (qq[inputEncoding
= ]);
my $ie = $child->input_encoding;
if (defined $ie) {
$out->code ($ie);
if ($child->manakai_has_bom) {
$out->html (qq[ (with BOM
)]);
}
} else {
$out->html (qq[(null
)]);
}
$out->html (qq[@{[scalar main::get_text ('manakaiIsHTML:'.($child->manakai_is_html?1:0))]}]);
$out->html (qq[@{[scalar main::get_text ('manakaiCompatMode:'.$child->manakai_compat_mode)]}]);
unless ($child->manakai_is_html) {
$out->html (qq[XML version = ]);
$out->code ($child->xml_version);
if (defined $child->xml_encoding) {
$out->html (qq[XML encoding = ]);
$out->code ($child->xml_encoding);
} else {
$out->html (qq[XML encoding = (null)]);
}
$out->html (qq[XML standalone = @{[$child->xml_standalone ? 'true' : 'false']}]);
}
$out->end_tag ('ul');
if ($child->has_child_nodes) {
$out->start_tag ('ol', class => 'children');
unshift @node, @{$child->child_nodes}, '';
}
} elsif ($nt == $child->DOCUMENT_TYPE_NODE) {
$out->start_tag ('li', id => $node_id, class => 'tree-doctype');
$out->code ('');
$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 (role => 'structure-errors');
$out->start_error_list (role => 'structure-errors');
my $input = $self->input;
my $result = $self->result;
require Whatpm::ContentChecker;
my $onerror = sub {
$result->add_error (@_, layer => 'structure');
};
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_error_list (role => 'structure-errors');
$out->end_section;
} # generate_structure_error_section
sub generate_additional_sections ($) {
my $self = shift;
$self->SUPER::generate_additional_sections;
$self->generate_table_section;
$self->generate_listing_section (
key => 'id', id => 'identifiers',
short_title => 'IDs', title => 'Identifiers',
);
$self->generate_listing_section (
key => 'term', id => 'terms',
short_title => 'Terms', title => 'Terms',
);
$self->generate_listing_section (
key => 'class', id => 'classes',
short_title => 'Classes', title => 'Classes',
);
$self->generate_rdf_section;
} # generate_additional_sections
sub generate_table_section ($) {
my $self = shift;
my $tables = $self->{add_info}->{table} || [];
return unless @$tables;
my $out = $self->output;
$out->start_section (id => 'tables', title => 'Tables');
$out->html (q[
]);
require JSON;
my $i = 0;
for my $table (@$tables) {
$i++;
$out->start_section (id => 'table-' . $i,
title => 'Table #' . $i);
$out->start_tag ('dl');
$out->dt ('Table Element');
$out->start_tag ('dd');
$out->node_link ($table->{element});
$out->end_tag ('dl');
delete $table->{element};
for (@{$table->{column_group}}, @{$table->{column}}, $table->{caption},
@{$table->{row}}) {
next unless $_;
delete $_->{element};
}
for (@{$table->{row_group}}) {
next unless $_;
next unless $_->{element};
$_->{type} = $_->{element}->manakai_local_name;
delete $_->{element};
}
for (@{$table->{cell}}) {
next unless $_;
for (@{$_}) {
next unless $_;
for (@$_) {
$_->{id} = refaddr $_->{element} if defined $_->{element};
delete $_->{element};
$_->{is_header} = $_->{is_header} ? 1 : 0;
}
}
}
my $id_prefix = $self->input->id_prefix;
$out->script (q[tableToCanvas (] .
JSON::objToJson ($table) .
q[, document.getElementById ('] . $id_prefix . 'table-' . $i . q[')] .
q[, '] . $id_prefix . q[');]);
$out->end_section;
}
$out->end_section;
} # generate_table_section
sub generate_listing_section ($%) {
my $self = shift;
my %opt = @_;
my $list = $self->{add_info}->{$opt{key}} || {};
return unless keys %$list;
my $out = $self->output;
$out->start_section (id => $opt{id},
title => $opt{title},
short_title => $opt{short_title});
$out->start_tag ('dl');
for my $id (sort {$a cmp $b} keys %$list) {
$out->start_tag ('dt');
$out->code ($id);
for (@{$list->{$id}}) {
$out->start_tag ('dd');
$out->node_link ($_);
}
}
$out->end_tag ('dl');
$out->end_section;
} # generate_listing_section
my $generate_rdf_resource_html = sub ($$) {
my ($resource, $out) = @_;
if (defined $resource->{uri}) {
$out->url ($resource->{uri});
} elsif (defined $resource->{bnodeid}) {
$out->text ('_:' . $resource->{bnodeid});
} elsif ($resource->{nodes}) {
$out->text ('(rdf:XMLLiteral)');
} elsif (defined $resource->{value}) {
$out->start_tag ('q',
lang => defined $resource->{language}
? $resource->{language} : '');
$out->text ($resource->{value});
$out->end_tag ('q');
if (defined $resource->{datatype}) {
$out->text ('^^');
$out->url ($resource->{datatype});
} elsif (length $resource->{language}) {
$out->text ('@' . $resource->{language});
}
} else {
$out->text ('??'); ## NOTE: An error of the implementation.
}
}; # $generate_rdf_resource_html
## TODO: Should we move this method to another module,
## such as Base or RDF?
sub generate_rdf_section ($) {
my $self = shift;
my $list = $self->{add_info}->{rdf} || [];
return unless @$list;
my $out = $self->output;
$out->start_section (id => 'rdf', short_title => 'RDF',
title => 'RDF Triples');
$out->start_tag ('dl');
my $i = 0;
for my $rdf (@$list) {
$out->start_tag ('dt', id => 'rdf-' . $i++);
$out->node_link ($rdf->[0]);
$out->start_tag ('dd');
$out->start_tag ('dl');
for my $triple (@{$rdf->[1]}) {
$out->start_tag ('dt');
$out->node_link ($triple->[0]);
$out->start_tag ('dd');
$out->text ('Subject: ');
$generate_rdf_resource_html->($triple->[1] => $out);
$out->start_tag ('dd');
$out->text ('Predicate: ');
$generate_rdf_resource_html->($triple->[2] => $out);
$out->start_tag ('dd');
$out->text ('Object: ');
$generate_rdf_resource_html->($triple->[3] => $out);
}
$out->end_tag ('dl');
}
$out->end_tag ('dl');
$out->end_section;
} # generate_rdf_section
1;