--- test/html-webhacc/cc.cgi 2007/06/27 12:35:24 1.2 +++ test/html-webhacc/cc.cgi 2007/07/01 06:21:46 1.7 @@ -33,30 +33,28 @@ exit; } + load_text_catalog ('en'); ## TODO: conneg + + my @nav; print STDOUT qq[Content-Type: text/html; charset=utf-8 Web Document Conformance Checker (BETA) - - +

Web Document Conformance Checker (beta)

+
Document URI
<@{[htescape $input_uri]}>
Internet Media Type
@{[htescape $input_format]}
]; # no
yet + push @nav, ['#document-info' => 'Information']; require Message::DOM::DOMImplementation; my $dom = Message::DOM::DOMImplementation->____new; @@ -73,9 +71,12 @@
Character Encoding
(none)
+
+

Document Source

]; + push @nav, ['#source-string' => 'Source']; print_source_string (\$s); print STDOUT qq[
@@ -83,18 +84,20 @@

Parse Errors

- +
]; } elsif ($input_format eq 'application/xhtml+xml') { @@ -120,9 +123,12 @@
Character Encoding
(none)
+
+

Document Source

]; + push @nav, ['#source-string' => 'Source']; print_source_string (\$t); print STDOUT qq[
@@ -130,15 +136,15 @@

Parse Errors

- + print STDOUT qq[
]; } else { print STDOUT qq[ + +

Media type @{[htescape $input_format]} is not supported!

+
]; + push @nav, ['#result-summary' => 'Result']; } @@ -164,6 +173,7 @@

Document Tree

]; + push @nav, ['#document-tree' => 'Tree']; print_document_tree ($el || $doc); @@ -173,31 +183,108 @@

Document Errors

- + print STDOUT qq[
]; + + if (@{$elements->{table}}) { + require JSON; + + print STDOUT qq[ +
+

Tables

+ + + + +]; + + my $i = 0; + for my $table_el (@{$elements->{table}}) { + $i++; + print STDOUT qq[

] . + get_node_link ($table_el) . q[

]; + + my $table = Whatpm::HTMLTable->form_table ($table_el); + + for (@{$table->{column_group}}, @{$table->{column}}, $table->{caption}) { + 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}; + } + } + } + + print STDOUT '
]; + } + + print STDOUT qq[
]; + } + + if (keys %{$elements->{term}}) { + print STDOUT qq[ +
+

Terms

+ +
+]; + for my $term (sort {$a cmp $b} keys %{$elements->{term}}) { + print STDOUT qq[
@{[htescape $term]}
]; + for (@{$elements->{term}->{$term}}) { + print STDOUT qq[
].get_node_link ($_).qq[
]; + } + } + print STDOUT qq[
]; + } } ## TODO: Show result + + print STDOUT qq[ + ]; @@ -208,12 +295,16 @@ my $s = $_[0]; my $i = 1; print STDOUT qq[
    \n]; - while ($$s =~ /\G([^\x0A]*?)\x0D?\x0A/gc) { - print STDOUT qq[
  1. ], htescape $1, "
    2. \n"; - $i++; - } - if ($$s =~ /\G([^\x0A]+)/gc) { - print STDOUT qq[
  2. ], htescape $1, "
    3. \n"; + if (length $$s) { + while ($$s =~ /\G([^\x0A]*?)\x0D?\x0A/gc) { + print STDOUT qq[
  3. ], htescape $1, "
    4. \n"; + $i++; + } + if ($$s =~ /\G([^\x0A]+)/gc) { + print STDOUT qq[
  4. ], htescape $1, "
    5. \n"; + } + } else { + print STDOUT q[
  5. ]; } print STDOUT "
"; } # print_input_string @@ -233,46 +324,52 @@ my $node_id = 'node-'.refaddr $child; my $nt = $child->node_type; if ($nt == $child->ELEMENT_NODE) { - $r .= qq'
  • ' . htescape ($child->tag_name) . + my $child_nsuri = $child->namespace_uri; + $r .= qq[
  • ] . htescape ($child->tag_name) . ''; ## ISSUE: case if ($child->has_attributes) { $r .= '
      '; - for my $attr (sort {$a->[0] cmp $b->[0]} map { [$_->name, $_->value, 'node-'.refaddr $_] } + for my $attr (sort {$a->[0] cmp $b->[0]} map { [$_->name, $_->value, $_->namespace_uri, 'node-'.refaddr $_] } @{$child->attributes}) { - $r .= qq'
    • ' . htescape ($attr->[0]) . ' = '; ## ISSUE: case? + $r .= qq[
    • ] . htescape ($attr->[0]) . ' = '; ## ISSUE: case? $r .= '' . htescape ($attr->[1]) . '
      • '; ## TODO: children } $r .= '
    '; } - if ($node->has_child_nodes) { + if ($child->has_child_nodes) { $r .= '
      '; - unshift @node, @{$child->child_nodes}, '
    '; + unshift @node, @{$child->child_nodes}, '
    • '; + } else { + $r .= ''; } } elsif ($nt == $child->TEXT_NODE) { - $r .= qq'
  • ' . htescape ($child->data) . '
    • '; + $r .= qq'
  • ' . htescape ($child->data) . '
    • '; } elsif ($nt == $child->CDATA_SECTION_NODE) { - $r .= qq'
  • <[CDATA[' . htescape ($child->data) . ']]>
    • '; + $r .= qq'
  • <[CDATA[' . htescape ($child->data) . ']]>
    • '; } elsif ($nt == $child->COMMENT_NODE) { - $r .= qq'
  • <!--' . htescape ($child->data) . '-->
    • '; + $r .= qq'
  • <!--' . htescape ($child->data) . '-->
    • '; } elsif ($nt == $child->DOCUMENT_NODE) { - $r .= qq'
  • Document
    • '; + $r .= qq'
  • Document'; + $r .= qq[
      ]; + $r .= qq[
    • @{[scalar get_text ('manakaiIsHTML:'.($child->manakai_is_html?1:0))]}
      • ]; + $r .= qq[
    • @{[scalar get_text ('manakaiCompatMode:'.$child->manakai_compat_mode)]}
      • ]; + $r .= qq[
    ]; if ($child->has_child_nodes) { - $r .= '
      '; - unshift @node, @{$child->child_nodes}, '
    '; + $r .= '
      '; + unshift @node, @{$child->child_nodes}, '
    • '; } } elsif ($nt == $child->DOCUMENT_TYPE_NODE) { - $r .= qq'
  • <!DOCTYPE>
      '; - $r .= '
    • Name = @{[htescape ($child->name)]}
      • '; - $r .= '
    • Public identifier = @{[htescape ($child->public_id)]}
      • '; - $r .= '
    • System identifier = @{[htescape ($child->system_id)]}
      • '; + $r .= qq'
    • <!DOCTYPE>
        '; + $r .= qq[
      • Name = @{[htescape ($child->name)]}
        • ]; + $r .= qq[
      • Public identifier = @{[htescape ($child->public_id)]}
        • ]; + $r .= qq[
      • System identifier = @{[htescape ($child->system_id)]}
        • ]; $r .= '
      • '; } elsif ($nt == $child->PROCESSING_INSTRUCTION_NODE) { - $r .= qq'
    • <?@{[htescape ($child->target)]}?>'; - $r .= '
      • @{[htescape ($child->data)]}
      • '; + $r .= qq'
    • <?@{[htescape ($child->target)]} @{[htescape ($child->data)]}?>
      • '; } else { - $r .= qq'
    • @{[$child->node_type]} @{[htescape ($child->node_name)]}
      • '; # error + $r .= qq'
    • @{[$child->node_type]} @{[htescape ($child->node_name)]}
      • '; # error } } @@ -306,6 +403,45 @@ return join '/', @r; } # get_node_path +sub get_node_link ($) { + return qq[] . + htescape (get_node_path ($_[0])) . qq[]; +} # get_node_link + +{ + my $Msg = {}; + +sub load_text_catalog ($) { + my $lang = shift; # MUST be a canonical lang name + open my $file, '<', "cc-msg.$lang.txt" or die "$0: cc-msg.$lang.txt: $!"; + while (<$file>) { + if (s/^([^;]+);([^;]*);//) { + my ($type, $cls, $msg) = ($1, $2, $_); + $msg =~ tr/\x0D\x0A//d; + $Msg->{$type} = [$cls, $msg]; + } + } +} # load_text_catalog + +sub get_text ($) { + my ($type, $level) = @_; + $type = $level . ':' . $type if defined $level; + my @arg; + { + if (defined $Msg->{$type}) { + my $msg = $Msg->{$type}->[1]; + $msg =~ s/\$([0-9]+)/defined $arg[$1] ? htescape ($arg[$1]) : '(undef)'/ge; + return ($Msg->{$type}->[0], $msg); + } elsif ($type =~ s/:([^:]*)$//) { + unshift @arg, $1; + redo; + } + } + return ('', htescape ($_[0])); +} # get_text + +} + =head1 AUTHOR Wakaba . @@ -319,4 +455,4 @@ =cut -## $Date: 2007/06/27 12:35:24 $ +## $Date: 2007/07/01 06:21:46 $