The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 10;

package MyGrammar::MultiXSLT;

use MooX 'late';

use File::Spec;

use XML::GrammarBase::Role::RelaxNG;
use XML::GrammarBase::Role::XSLT;

with('XML::GrammarBase::Role::RelaxNG');
with XSLT( output_format => 'html' );
with XSLT( output_format => 'docbook' );

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

has '+to_html_xslt_transform_basename' =>
    ( default => 'fiction-xml-to-html.xslt' );
has '+to_docbook_xslt_transform_basename' =>
    ( default => 'fiction-xml-to-docbook.xslt' );

package main;

use Test::XML::Ordered qw(is_xml_ordered);

use File::Temp qw(tempfile);

my @is_xml_common = ( validation => 0, load_ext_dtd => 0, no_network => 1 );

sub my_is_xml
{
    local $Test::Builder::Level = $Test::Builder::Level + 1;

    my ( $got, $expected, $blurb ) = @_;

    return is_xml_ordered(
        [ @{$got},      @is_xml_common, ],
        [ @{$expected}, @is_xml_common, ],
        {}, $blurb,
    );
}

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 $args = shift;

    my $input_fn      = $args->{input_fn};
    my $output_fn     = $args->{output_fn};
    my $output_format = $args->{output_format};

    my $xslt = MyGrammar::MultiXSLT->new();

    {
        my $final_source = $xslt->perform_xslt_translation(
            {
                output_format => $output_format,
                source        => { file => $input_fn, },
                output        => "string",
            }
        );

        my $xml_source = _utf8_slurp($output_fn);

        # TEST:$c++;
        my_is_xml(
            [ string => $final_source, ],
            [ string => $xml_source, ],
"'$input_fn' generated good output on source/input_filename - output - string"
        );
    }

    {
        my $final_source = $xslt->perform_xslt_translation(
            {
                output_format => $output_format,
                source        => { string_ref => \( _utf8_slurp($input_fn) ) },
                output        => "string",
            }
        );

        my $xml_source = _utf8_slurp($output_fn);

        # TEST:$c++;
        my_is_xml(
            [ string => $final_source, ],
            [ string => $xml_source, ],
"'$input_fn' generated good output on source/string_ref - output - string"
        );
    }

    {
        my $final_dom = $xslt->perform_xslt_translation(
            {
                output_format => $output_format,
                source        => { string_ref => \( _utf8_slurp($input_fn) ) },
                output        => "dom",
            }
        );

        my $xml_source = _utf8_slurp($output_fn);

        # TEST:$c++;
        my_is_xml(
            [ string => $final_dom->toString(), ],
            [ string => $xml_source, ],
"'$input_fn' generated good output on source/string_ref - output - dom"
        );
    }

    {
        my ( $fh, $filename ) = tempfile();

        $xslt->perform_xslt_translation(
            {
                output_format => $output_format,
                source        => { string_ref => \( _utf8_slurp($input_fn) ) },
                output        => { file => $filename, },
            }
        );

        my $xml_source   = _utf8_slurp($output_fn);
        my $final_source = _utf8_slurp($filename);

        # TEST:$c++;
        my_is_xml(
            [ string => $final_source, ],
            [ string => $xml_source, ],
"'$input_fn' generated good output on source/string_ref - output/file"
        );
    }

    {
        my ( $fh, $filename ) = tempfile();

        binmode( $fh, ':encoding(utf8)' );

        $xslt->perform_xslt_translation(
            {
                output_format => $output_format,
                source        => { string_ref => \( _utf8_slurp($input_fn) ) },
                output        => { fh => $fh, },
            }
        );

        close($fh);

        my $xml_source   = _utf8_slurp($output_fn);
        my $final_source = _utf8_slurp($filename);

        # TEST:$c++;
        my_is_xml(
            [ string => $final_source, ],
            [ string => $xml_source, ],
            "'$input_fn' generated good output on source/string_ref - output/fh"
        );
    }
    return;
}

# TEST:$test_file=$c;

# TEST*$test_file
test_file(
    {
        output_format => 'html',
        input_fn      => File::Spec->catfile(
            File::Spec->curdir(), "t", "data", "fiction-xml-test.xml",
        ),
        output_fn => File::Spec->catfile(
            File::Spec->curdir(), "t",
            "data",               "fiction-xml-test-html-xslt-output.xhtml",
        ),
    }
);

# TEST*$test_file
test_file(
    {
        output_format => 'docbook',
        input_fn      => File::Spec->catfile(
            File::Spec->curdir(), "t", "data", "fiction-xml-test.xml",
        ),
        output_fn => File::Spec->catfile(
            File::Spec->curdir(), "t", "data",
            "fiction-xml-test-docbook-xslt-output.docbook.xml",
        ),
    }
);