| 194 |
require Whatpm::ContentChecker; |
require Whatpm::ContentChecker; |
| 195 |
my $onerror = sub { |
my $onerror = sub { |
| 196 |
my %opt = @_; |
my %opt = @_; |
| 197 |
my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level}); |
my ($type, $cls, $msg) = get_text ($opt{type}, $opt{level}, $opt{node}); |
| 198 |
$type =~ tr/ /-/; |
$type =~ tr/ /-/; |
| 199 |
$type =~ s/\|/%7C/g; |
$type =~ s/\|/%7C/g; |
| 200 |
$msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]]; |
$msg .= qq[ [<a href="../error-description#@{[htescape ($type)]}">Description</a>]]; |
| 279 |
<dl> |
<dl> |
| 280 |
]; |
]; |
| 281 |
for my $id (sort {$a cmp $b} keys %{$elements->{id}}) { |
for my $id (sort {$a cmp $b} keys %{$elements->{id}}) { |
| 282 |
print STDOUT qq[<dt>@{[htescape $id]}</dt>]; |
print STDOUT qq[<dt><code>@{[htescape $id]}</code></dt>]; |
| 283 |
for (@{$elements->{id}->{$id}}) { |
for (@{$elements->{id}->{$id}}) { |
| 284 |
print STDOUT qq[<dd>].get_node_link ($_).qq[</dd>]; |
print STDOUT qq[<dd>].get_node_link ($_).qq[</dd>]; |
| 285 |
} |
} |
| 313 |
<dl> |
<dl> |
| 314 |
]; |
]; |
| 315 |
for my $class (sort {$a cmp $b} keys %{$elements->{class}}) { |
for my $class (sort {$a cmp $b} keys %{$elements->{class}}) { |
| 316 |
print STDOUT qq[<dt>@{[htescape $class]}</dt>]; |
print STDOUT qq[<dt><code>@{[htescape $class]}</code></dt>]; |
| 317 |
for (@{$elements->{class}->{$class}}) { |
for (@{$elements->{class}->{$class}}) { |
| 318 |
print STDOUT qq[<dd>].get_node_link ($_).qq[</dd>]; |
print STDOUT qq[<dd>].get_node_link ($_).qq[</dd>]; |
| 319 |
} |
} |
| 534 |
} # load_text_catalog |
} # load_text_catalog |
| 535 |
|
|
| 536 |
sub get_text ($) { |
sub get_text ($) { |
| 537 |
my ($type, $level) = @_; |
my ($type, $level, $node) = @_; |
| 538 |
$type = $level . ':' . $type if defined $level; |
$type = $level . ':' . $type if defined $level; |
| 539 |
my @arg; |
my @arg; |
| 540 |
{ |
{ |
| 543 |
$msg =~ s{<var>\$([0-9]+)</var>}{ |
$msg =~ s{<var>\$([0-9]+)</var>}{ |
| 544 |
defined $arg[$1] ? htescape ($arg[$1]) : '(undef)'; |
defined $arg[$1] ? htescape ($arg[$1]) : '(undef)'; |
| 545 |
}ge; |
}ge; |
| 546 |
|
$msg =~ s{<var>{\@([A-Za-z0-9:_.-]+)}</var>}{ |
| 547 |
|
UNIVERSAL::can ($node, 'get_attribute_ns') |
| 548 |
|
? htescape ($node->get_attribute_ns (undef, $1)) : '' |
| 549 |
|
}ge; |
| 550 |
|
$msg =~ s{<var>{\@}</var>}{ |
| 551 |
|
UNIVERSAL::can ($node, 'value') ? htescape ($node->value) : '' |
| 552 |
|
}ge; |
| 553 |
return ($type, $Msg->{$type}->[0], $msg); |
return ($type, $Msg->{$type}->[0], $msg); |
| 554 |
} elsif ($type =~ s/:([^:]*)$//) { |
} elsif ($type =~ s/:([^:]*)$//) { |
| 555 |
unshift @arg, $1; |
unshift @arg, $1; |