| 80 |
if ($input->{media_type} eq 'text/html') { |
if ($input->{media_type} eq 'text/html') { |
| 81 |
require Encode; |
require Encode; |
| 82 |
require Whatpm::HTML; |
require Whatpm::HTML; |
| 83 |
|
|
| 84 |
|
$input->{charset} ||= 'ISO-8859-1'; ## TODO: for now. |
| 85 |
|
|
| 86 |
my $t = Encode::decode ($input->{charset}, $input->{s}); |
my $t = Encode::decode ($input->{charset}, $input->{s}); |
| 87 |
|
|
| 89 |
<div id="parse-errors" class="section"> |
<div id="parse-errors" class="section"> |
| 90 |
<h2>Parse Errors</h2> |
<h2>Parse Errors</h2> |
| 91 |
|
|
| 92 |
<dl> |
<dl>]; |
|
]; |
|
| 93 |
push @nav, ['#parse-errors' => 'Parse Error']; |
push @nav, ['#parse-errors' => 'Parse Error']; |
| 94 |
|
|
| 95 |
my $onerror = sub { |
my $onerror = sub { |
| 96 |
my (%opt) = @_; |
my (%opt) = @_; |
| 97 |
my ($cls, $msg) = get_text ($opt{type}, $opt{level}); |
my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level}); |
| 98 |
if ($opt{column} > 0) { |
if ($opt{column} > 0) { |
| 99 |
print STDOUT qq[<dt class="$cls"><a href="#line-$opt{line}">Line $opt{line}</a> column $opt{column}</dt>\n]; |
print STDOUT qq[<dt class="$cls"><a href="#line-$opt{line}">Line $opt{line}</a> column $opt{column}</dt>\n]; |
| 100 |
} else { |
} else { |
| 101 |
$opt{line} = $opt{line} - 1 || 1; |
$opt{line} = $opt{line} - 1 || 1; |
| 102 |
print STDOUT qq[<dt class="$cls"><a href="#line-$opt{line}">Line $opt{line}</a></dt>\n]; |
print STDOUT qq[<dt class="$cls"><a href="#line-$opt{line}">Line $opt{line}</a></dt>\n]; |
| 103 |
} |
} |
| 104 |
$opt{type} =~ tr/ /-/; |
$type =~ tr/ /-/; |
| 105 |
$opt{type} =~ s/\|/%7C/g; |
$type =~ s/\|/%7C/g; |
| 106 |
$msg .= qq[ [<a href="../error-description#$opt{type}">Description</a>]]; |
$msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]]; |
| 107 |
print STDOUT qq[<dd class="$cls">$msg</dd>\n]; |
print STDOUT qq[<dd class="$cls">$msg</dd>\n]; |
| 108 |
}; |
}; |
| 109 |
|
|
| 116 |
Whatpm::HTML->parse_string ($t => $doc, $onerror); |
Whatpm::HTML->parse_string ($t => $doc, $onerror); |
| 117 |
} |
} |
| 118 |
|
|
| 119 |
print STDOUT qq[ |
print STDOUT qq[</dl> |
|
</dl> |
|
| 120 |
</div> |
</div> |
| 121 |
]; |
]; |
| 122 |
|
|
| 185 |
require Whatpm::ContentChecker; |
require Whatpm::ContentChecker; |
| 186 |
my $onerror = sub { |
my $onerror = sub { |
| 187 |
my %opt = @_; |
my %opt = @_; |
| 188 |
my ($cls, $msg) = get_text ($opt{type}, $opt{level}); |
my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level}); |
| 189 |
$opt{type} = $opt{level} . ':' . $opt{type} if defined $opt{level}; |
$type =~ tr/ /-/; |
| 190 |
$opt{type} =~ tr/ /-/; |
$type =~ s/\|/%7C/g; |
| 191 |
$opt{type} =~ s/\|/%7C/g; |
$msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]]; |
|
$msg .= qq[ [<a href="../error-description#$opt{type}">Description</a>]]; |
|
| 192 |
print STDOUT qq[<dt class="$cls">] . get_node_link ($opt{node}) . |
print STDOUT qq[<dt class="$cls">] . get_node_link ($opt{node}) . |
| 193 |
qq[</dt>\n<dd class="$cls">], $msg, "</dd>\n"; |
qq[</dt>\n<dd class="$cls">], $msg, "</dd>\n"; |
| 194 |
}; |
}; |
| 245 |
for (@$_) { |
for (@$_) { |
| 246 |
$_->{id} = refaddr $_->{element} if defined $_->{element}; |
$_->{id} = refaddr $_->{element} if defined $_->{element}; |
| 247 |
delete $_->{element}; |
delete $_->{element}; |
| 248 |
|
$_->{is_header} = $_->{is_header} ? 1 : 0; |
| 249 |
} |
} |
| 250 |
} |
} |
| 251 |
} |
} |
| 493 |
{ |
{ |
| 494 |
if (defined $Msg->{$type}) { |
if (defined $Msg->{$type}) { |
| 495 |
my $msg = $Msg->{$type}->[1]; |
my $msg = $Msg->{$type}->[1]; |
| 496 |
$msg =~ s/\$([0-9]+)/defined $arg[$1] ? htescape ($arg[$1]) : '(undef)'/ge; |
$msg =~ s{<var>\$([0-9]+)</var>}{ |
| 497 |
return ($Msg->{$type}->[0], $msg); |
defined $arg[$1] ? htescape ($arg[$1]) : '(undef)'; |
| 498 |
|
}ge; |
| 499 |
|
return ($type, $Msg->{$type}->[0], $msg); |
| 500 |
} elsif ($type =~ s/:([^:]*)$//) { |
} elsif ($type =~ s/:([^:]*)$//) { |
| 501 |
unshift @arg, $1; |
unshift @arg, $1; |
| 502 |
redo; |
redo; |
| 503 |
} |
} |
| 504 |
} |
} |
| 505 |
return ('', htescape ($_[0])); |
return ($type, '', htescape ($_[0])); |
| 506 |
} # get_text |
} # get_text |
| 507 |
|
|
| 508 |
} |
} |