| 677 |
my $input = shift; |
my $input = shift; |
| 678 |
my $s; |
my $s; |
| 679 |
unless ($input->{is_char_string}) { |
unless ($input->{is_char_string}) { |
| 680 |
require Encode; |
open my $byte_stream, '<', $_[0]; |
| 681 |
my $enc = Encode::find_encoding ($_[1]); ## TODO: charset name -> Perl name |
require Message::Charset::Info; |
| 682 |
return unless $enc; |
my $charset = Message::Charset::Info->get_by_iana_name ($_[1]); |
| 683 |
|
my ($char_stream, $e_status) = $charset->get_decode_handle |
| 684 |
|
($byte_stream, allow_error_reporting => 1, allow_fallback => 1); |
| 685 |
|
return unless $char_stream; |
| 686 |
|
|
| 687 |
|
$char_stream->onerror (sub { |
| 688 |
|
my (undef, $type, %opt) = @_; |
| 689 |
|
if ($opt{octets}) { |
| 690 |
|
${$opt{octets}} = "\x{FFFD}"; |
| 691 |
|
} |
| 692 |
|
}); |
| 693 |
|
|
| 694 |
$s = \($enc->decode (${$_[0]})); |
my $t = ''; |
| 695 |
|
while (1) { |
| 696 |
|
my $c = $char_stream->getc; |
| 697 |
|
last unless defined $c; |
| 698 |
|
$t .= $c; |
| 699 |
|
} |
| 700 |
|
$s = \$t; |
| 701 |
|
## TODO: Output for each line, don't concat all of lines. |
| 702 |
} else { |
} else { |
| 703 |
$s = $_[0]; |
$s = $_[0]; |
| 704 |
} |
} |
| 1199 |
|
|
| 1200 |
print STDOUT qq[<tr class="@{[$uncertain ? 'uncertain' : '']}"><th scope=row>$label</th><td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : '']}">$result->{$_->[1]}->{must}$uncertain</td><td class="@{[$result->{$_->[1]}->{should} ? 'SEE-RESULT' : '']}">$result->{$_->[1]}->{should}$uncertain</td><td>$result->{$_->[1]}->{warning}$uncertain</td>]; |
print STDOUT qq[<tr class="@{[$uncertain ? 'uncertain' : '']}"><th scope=row>$label</th><td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : '']}">$result->{$_->[1]}->{must}$uncertain</td><td class="@{[$result->{$_->[1]}->{should} ? 'SEE-RESULT' : '']}">$result->{$_->[1]}->{should}$uncertain</td><td>$result->{$_->[1]}->{warning}$uncertain</td>]; |
| 1201 |
if ($uncertain) { |
if ($uncertain) { |
| 1202 |
print qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : $result->{$_->[1]}->{should} ? 'SEE-RESULT' : '']}">−∞..$result->{$_->[1]}->{score_max}</td>]; |
print qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : $result->{$_->[1]}->{should} ? 'SEE-RESULT' : '']}">−∞..$result->{$_->[1]}->{score_max}]; |
| 1203 |
} elsif ($result->{$_->[1]}->{score_min} != $result->{$_->[1]}->{score_max}) { |
} elsif ($result->{$_->[1]}->{score_min} != $result->{$_->[1]}->{score_max}) { |
| 1204 |
print qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : 'SEE-RESULT']}">$result->{$_->[1]}->{score_min}..$result->{$_->[1]}->{score_max}</td></tr>]; |
print qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : 'SEE-RESULT']}">$result->{$_->[1]}->{score_min}..$result->{$_->[1]}->{score_max}]; |
| 1205 |
} else { |
} else { |
| 1206 |
print qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : '']}">$result->{$_->[1]}->{score_min}</td></tr>]; |
print qq[<td class="@{[$result->{$_->[1]}->{must} ? 'FAIL' : '']}">$result->{$_->[1]}->{score_min}]; |
| 1207 |
} |
} |
| 1208 |
|
print qq[ / 20]; |
| 1209 |
} |
} |
| 1210 |
|
|
| 1211 |
$score_max += $score_base; |
$score_max += $score_base; |
| 1212 |
|
|
| 1213 |
print STDOUT qq[ |
print STDOUT qq[ |
| 1214 |
<tr class=uncertain><th scope=row>Semantics</th><td>0?</td><td>0?</td><td>0?</td><td>−∞..$score_base</td></tr> |
<tr class=uncertain><th scope=row>Semantics</th><td>0?</td><td>0?</td><td>0?</td><td>−∞..$score_base / 20 |
| 1215 |
</tbody> |
</tbody> |
| 1216 |
<tfoot><tr class=uncertain><th scope=row>Total</th> |
<tfoot><tr class=uncertain><th scope=row>Total</th> |
| 1217 |
<td class="@{[$must_error ? 'FAIL' : '']}">$must_error?</td> |
<td class="@{[$must_error ? 'FAIL' : '']}">$must_error?</td> |
| 1218 |
<td class="@{[$should_error ? 'SEE-RESULT' : '']}">$should_error?</td> |
<td class="@{[$should_error ? 'SEE-RESULT' : '']}">$should_error?</td> |
| 1219 |
<td>$warning?</td> |
<td>$warning?</td> |
| 1220 |
<td class="@{[$must_error ? 'FAIL' : $should_error ? 'SEE-RESULT' : '']}"><strong>−∞..$score_max</strong></td></tr></tfoot> |
<td class="@{[$must_error ? 'FAIL' : $should_error ? 'SEE-RESULT' : '']}"><strong>−∞..$score_max</strong> / 100 |
| 1221 |
</table> |
</table> |
| 1222 |
|
|
| 1223 |
<p><strong>Important</strong>: This conformance checking service |
<p><strong>Important</strong>: This conformance checking service |