#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 6;
package MyGrammar::RNG;
use MooX 'late';
use File::Spec;
with ('XML::GrammarBase::Role::RelaxNG');
has '+module_base' => (default => 'XML-GrammarBase');
has '+data_dir' => (default => File::Spec->catdir(File::Spec->curdir(), "t", "data"));
has '+rng_schema_basename' => (default => 'fiction-xml.rng');
package main;
sub _utf8_slurp
{
my $filename = shift;
open my $in, '<', $filename
or die "Cannot open '$filename' for slurping - $!";
binmode $in, ':encoding(utf8)';
local $/;
my $contents = <$in>;
close($in);
return $contents;
}
# TEST:$c=0;
sub test_file
{
my ($filename, $assert_cb) = @_;
{
my $rng = MyGrammar::RNG->new();
my $xml_parser = XML::LibXML->new();
$xml_parser->validation(0);
my $dom = $xml_parser->parse_file($filename);
eval {
$rng->rng_validate_dom($dom);
};
# TEST:$c++;
$assert_cb->($@, "rng_validate_dom()");
}
{
my $rng = MyGrammar::RNG->new();
eval {
$rng->rng_validate_file($filename);
};
# TEST:$c++;
$assert_cb->($@, "rng_validate_file()");
}
{
my $rng = MyGrammar::RNG->new();
eval {
$rng->rng_validate_string(_utf8_slurp($filename));
};
# TEST:$c++;
$assert_cb->($@, "rng_validate_string()");
}
}
# TEST:$test_file=$c;
test_file(
File::Spec->catfile(
File::Spec->curdir(), "t", "data", "fiction-xml-test.xml"
),
sub {
my $Err = shift;
my $blurb = shift;
# TEST*$test_file
is ($Err, '', "$blurb - No exception was thrown", );
}
);
test_file(
File::Spec->catfile(
File::Spec->curdir(), "t", "data", "fiction-xml-invalid-test.xml"
),
sub {
my $Err = shift;
my $blurb = shift;
# TEST*$test_file
ok ($Err, "$blurb - An exception was thrown",);
}
);