line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package XML::Schematron::Test; |
2
|
1
|
|
|
1
|
|
8
|
use Moose; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
7
|
|
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
has [qw|expression context message test_type|] => ( |
5
|
|
|
|
|
|
|
traits => ['String'], |
6
|
|
|
|
|
|
|
is => 'rw', |
7
|
|
|
|
|
|
|
isa => 'Str', |
8
|
|
|
|
|
|
|
required => 1, |
9
|
|
|
|
|
|
|
); |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
has pattern => ( |
12
|
|
|
|
|
|
|
is => 'ro', |
13
|
|
|
|
|
|
|
isa => 'Maybe[Str]', |
14
|
|
|
|
|
|
|
default => sub { '[none]' }, |
15
|
|
|
|
|
|
|
); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub as_xsl { |
18
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
19
|
0
|
|
|
|
|
|
my $priority = shift; |
20
|
|
|
|
|
|
|
|
21
|
0
|
|
|
|
|
|
my $context = $self->context; |
22
|
0
|
|
|
|
|
|
my $expression = $self->expression; |
23
|
0
|
|
|
|
|
|
my $message = $self->message; |
24
|
|
|
|
|
|
|
|
25
|
0
|
|
|
|
|
|
$context =~ s/"/'/g; |
26
|
0
|
|
|
|
|
|
$expression =~ s/</</g; |
27
|
0
|
|
|
|
|
|
$expression =~ s/>/>/g; |
28
|
0
|
|
|
|
|
|
$message =~ s/\n//g; |
29
|
0
|
|
|
|
|
|
$message =~ s/^[ \t]+|[ \t]+$//; |
30
|
0
|
|
|
|
|
|
$message .= "\n"; |
31
|
|
|
|
|
|
|
|
32
|
0
|
|
|
|
|
|
my $buffer; |
33
|
0
|
0
|
|
|
|
|
if ( $self->test_type eq 'assert' ) { |
34
|
0
|
|
|
|
|
|
$buffer = sprintf(qq|<xsl:choose><xsl:when test="%s"/><xsl:otherwise>In pattern %s: %s</xsl:otherwise></xsl:choose>|, $expression, $self->pattern, $message) |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
else { |
37
|
0
|
|
|
|
|
|
$buffer = sprintf(qq|<xsl:if test="%s">In pattern %s: %s</xsl:if>|, $expression, $self->pattern, $message); |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
|
40
|
0
|
|
|
|
|
|
return $buffer; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
1; |