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; |