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 |