| 15 |
$s =~ s/</</g; |
$s =~ s/</</g; |
| 16 |
$s =~ s/>/>/g; |
$s =~ s/>/>/g; |
| 17 |
$s =~ s/"/"/g; |
$s =~ s/"/"/g; |
| 18 |
$s =~ s!([\x00-\x09\x0B-\x1F\x7F-\x80])!sprintf '<var>U+%04X</var>', ord $1!ge; |
$s =~ s{([\x00-\x09\x0B-\x1F\x7F-\xA0\x{FEFF}\x{FFFC}-\x{FFFF}])}{ |
| 19 |
|
sprintf '<var>U+%04X</var>', ord $1; |
| 20 |
|
}ge; |
| 21 |
return $s; |
return $s; |
| 22 |
} # htescape |
} # htescape |
| 23 |
|
|
| 30 |
exit; |
exit; |
| 31 |
} |
} |
| 32 |
|
|
| 33 |
|
binmode STDOUT, ':utf8'; |
| 34 |
|
$| = 1; |
| 35 |
|
|
| 36 |
require Message::DOM::DOMImplementation; |
require Message::DOM::DOMImplementation; |
| 37 |
my $dom = Message::DOM::DOMImplementation->new; |
my $dom = Message::DOM::DOMImplementation->new; |
| 38 |
|
|
|
my $input = get_input_document ($http, $dom); |
|
|
my $inner_html_element = $http->parameter ('e'); |
|
|
|
|
| 39 |
load_text_catalog ('en'); ## TODO: conneg |
load_text_catalog ('en'); ## TODO: conneg |
| 40 |
|
|
| 41 |
my @nav; |
my @nav; |
| 48 |
<link rel="stylesheet" href="../cc-style.css" type="text/css"> |
<link rel="stylesheet" href="../cc-style.css" type="text/css"> |
| 49 |
</head> |
</head> |
| 50 |
<body> |
<body> |
| 51 |
<h1>Web Document Conformance Checker (<em>beta</em>)</h1> |
<h1><a href="../cc-interface">Web Document Conformance Checker</a> |
| 52 |
|
(<em>beta</em>)</h1> |
| 53 |
|
]; |
| 54 |
|
|
| 55 |
|
$| = 0; |
| 56 |
|
my $input = get_input_document ($http, $dom); |
| 57 |
|
my $inner_html_element = $http->parameter ('e'); |
| 58 |
|
|
| 59 |
|
print qq[ |
| 60 |
<div id="document-info" class="section"> |
<div id="document-info" class="section"> |
| 61 |
<dl> |
<dl> |
| 62 |
<dt>Request URI</dt> |
<dt>Request URI</dt> |
| 216 |
if (@{$elements->{table}}) { |
if (@{$elements->{table}}) { |
| 217 |
require JSON; |
require JSON; |
| 218 |
|
|
| 219 |
|
push @nav, ['#tables' => 'Tables']; |
| 220 |
print STDOUT qq[ |
print STDOUT qq[ |
| 221 |
<div id="tables" class="section"> |
<div id="tables" class="section"> |
| 222 |
<h2>Tables</h2> |
<h2>Tables</h2> |
| 233 |
$i++; |
$i++; |
| 234 |
print STDOUT qq[<div class="section" id="table-$i"><h3>] . |
print STDOUT qq[<div class="section" id="table-$i"><h3>] . |
| 235 |
get_node_link ($table_el) . q[</h3>]; |
get_node_link ($table_el) . q[</h3>]; |
| 236 |
|
|
| 237 |
|
## TODO: Make |ContentChecker| return |form_table| result |
| 238 |
|
## so that this script don't have to run the algorithm twice. |
| 239 |
my $table = Whatpm::HTMLTable->form_table ($table_el); |
my $table = Whatpm::HTMLTable->form_table ($table_el); |
| 240 |
|
|
| 241 |
for (@{$table->{column_group}}, @{$table->{column}}, $table->{caption}) { |
for (@{$table->{column_group}}, @{$table->{column}}, $table->{caption}) { |
| 270 |
print STDOUT qq[</div>]; |
print STDOUT qq[</div>]; |
| 271 |
} |
} |
| 272 |
|
|
| 273 |
|
if (keys %{$elements->{id}}) { |
| 274 |
|
push @nav, ['#identifiers' => 'IDs']; |
| 275 |
|
print STDOUT qq[ |
| 276 |
|
<div id="identifiers" class="section"> |
| 277 |
|
<h2>Identifiers</h2> |
| 278 |
|
|
| 279 |
|
<dl> |
| 280 |
|
]; |
| 281 |
|
for my $id (sort {$a cmp $b} keys %{$elements->{id}}) { |
| 282 |
|
print STDOUT qq[<dt>@{[htescape $id]}</dt>]; |
| 283 |
|
for (@{$elements->{id}->{$id}}) { |
| 284 |
|
print STDOUT qq[<dd>].get_node_link ($_).qq[</dd>]; |
| 285 |
|
} |
| 286 |
|
} |
| 287 |
|
print STDOUT qq[</dl></div>]; |
| 288 |
|
} |
| 289 |
|
|
| 290 |
if (keys %{$elements->{term}}) { |
if (keys %{$elements->{term}}) { |
| 291 |
|
push @nav, ['#terms' => 'Terms']; |
| 292 |
print STDOUT qq[ |
print STDOUT qq[ |
| 293 |
<div id="terms" class="section"> |
<div id="terms" class="section"> |
| 294 |
<h2>Terms</h2> |
<h2>Terms</h2> |
| 301 |
print STDOUT qq[<dd>].get_node_link ($_).qq[</dd>]; |
print STDOUT qq[<dd>].get_node_link ($_).qq[</dd>]; |
| 302 |
} |
} |
| 303 |
} |
} |
| 304 |
|
print STDOUT qq[</dl></div>]; |
| 305 |
|
} |
| 306 |
|
|
| 307 |
|
if (keys %{$elements->{class}}) { |
| 308 |
|
push @nav, ['#classes' => 'Classes']; |
| 309 |
|
print STDOUT qq[ |
| 310 |
|
<div id="classes" class="section"> |
| 311 |
|
<h2>Classes</h2> |
| 312 |
|
|
| 313 |
|
<dl> |
| 314 |
|
]; |
| 315 |
|
for my $class (sort {$a cmp $b} keys %{$elements->{class}}) { |
| 316 |
|
print STDOUT qq[<dt>@{[htescape $class]}</dt>]; |
| 317 |
|
for (@{$elements->{class}->{$class}}) { |
| 318 |
|
print STDOUT qq[<dd>].get_node_link ($_).qq[</dd>]; |
| 319 |
|
} |
| 320 |
|
} |
| 321 |
print STDOUT qq[</dl></div>]; |
print STDOUT qq[</dl></div>]; |
| 322 |
} |
} |
| 323 |
} |
} |