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

use File::Spec;

use XML::LibXML;

use XML::Grammar::Fiction::ToHTML;
use XML::Grammar::Fiction::ToDocBook;

my @tests = (qw(
        sections-and-paras
        sections-p-b-i
    ));

sub load_xml
{
    my $path = shift;

    open my $in, "<", $path;
    my $contents;
    {
        local $/;
        $contents = <$in>
    }
    close($in);
    return $contents;
}

# TEST:$num_texts=2

my %converters =
(
    'xhtml' =>
    {
        class => "XML::Grammar::Fiction::ToHTML",
        method => "translate_to_html",
    },
    'db' =>
    {
        class => "XML::Grammar::Fiction::ToDocBook",
        method => "translate_to_docbook",
    },
);

foreach my $conv_id (keys(%converters))
{
    my $h_ref = $converters{$conv_id};
    $h_ref->{obj} = $h_ref->{class}->new(
        {
            data_dir => File::Spec->catdir(File::Spec->curdir(), "extradata"),
        }
    );
}

foreach my $fn (@tests)
{
    my $xpc = XML::LibXML::XPathContext->new();
    $xpc->registerNs('x', q{http://www.w3.org/1999/xhtml});
    $xpc->registerNs('db', q{http://docbook.org/ns/docbook});

    # This is a closure that returns a closure (like shown in "On Lisp" :
    # http://www.paulgraham.com/onlisptext.html ) for a finder in
    # one of the documents
    my $create_finder = sub {
        my $format_id = shift;

        my $format_hash = $converters{$format_id};
        my $m = $format_hash->{method};

        my $xml_fn = "t/fiction/data/xml/$fn.xml";

        my $text = $format_hash->{'obj'}->$m(
            {
                source => { file => $xml_fn, },
                output => "string",
            }
        );
        if ($format_id eq "xhtml")
        {
            my $file_contents = load_xml($xml_fn);
            {
                my $from_string_text =
                    $format_hash->{'obj'}->$m(
                    {
                        source => { string_ref => \$file_contents, },
                        output => "string",
                    }
                );

                # TEST*$num_texts
                is ($from_string_text, $text, "From-string-ref text is OK.")
            }

            {
                my $parser = XML::LibXML->new();
                my $file_dom = $parser->parse_string($file_contents);

                my $from_string_text =
                    $format_hash->{'obj'}->$m(
                    {
                        source => { dom => $file_dom, },
                        output => "string",
                    }
                );

                # TEST*$num_texts
                is ($from_string_text, $text, "From-dom text is OK.")
            }
        }
        my $parser = XML::LibXML->new();

        $parser->load_ext_dtd(0);

        my $doc = $parser->parse_string($text);

        return sub {
            my $xpath = shift;
            return $xpc->findnodes($xpath, $doc);
        };
    };

    my $xhtml_find = $create_finder->("xhtml");
    my $db_find = $create_finder->("db");

    # TEST*$num_texts
    is (
        scalar(() = $xhtml_find->(q{//x:html})),
        1,
        "Found one article with id index",
    );

    {
        my @title = $db_find->(q{//db:article/db:info/db:title});

        # TEST*$num_texts
        is (
            scalar(@title),
            1,
            "Found one global <db:title>",
        );

        # TEST*$num_texts
        is ($title[0]->textContent(), "David vs. Goliath - Part I");
    }

    # TEST:$num_xhtml_top_titles=2;
    # TEST:$n=$num_texts*$num_xhtml_top_titles;
    foreach my $xpath (
        q{//x:html/x:head/x:title},
        q{//x:html/x:body/x:div/x:h1},
    )
    {
        my @title = $xhtml_find->($xpath);

        # TEST*$n
        is (
            scalar(@title),
            1,
            "Found one global <x:title>",
        );

        # TEST*$n
        is ($title[0]->textContent(), "David vs. Goliath - Part I",
            "XHTML <title> has good content"
        );
    }

    # TEST*$num_texts
    ok (
        (scalar(() = $xhtml_find->(q{//x:div}))
            >=
            1
        ),
        "Found role=description sections",
    );

    {
        my @elems = $xhtml_find->(q{//x:div[@xml:id="top"]/x:h2});
        # TEST*$num_texts
        is (scalar(@elems), 1, "One element");

        # TEST*$num_texts
        is ($elems[0]->textContent(), "The Top Section",
            "<h2> element contains the right thing.");
    }

    # TEST:$num_with_styles=1;
    if ($fn eq "sections-p-b-i")
    {
        {
            my @elems;

            @elems = $xhtml_find->(q{//x:div/x:p/x:b});
            # TEST*$num_with_styles
            is (
                scalar(@elems),
                1,
                "Found bold tag",
            );

            # TEST*$num_with_styles
            like ($elems[0]->toString(), qr{swear},
                "Elem[0] is the right <b> tag."
            );

            @elems = $xhtml_find->(q{//x:div/x:p/x:i});
            # TEST*$num_with_styles
            is (
                scalar(@elems),
                1,
                "Found italic tag",
            );

            # TEST*$num_with_styles
            like ($elems[0]->toString(), qr{David},
                "<i>[0] contains the right contents."
            );
        }

        {
            my @elems;

            @elems = $db_find->(q{//db:article/db:section/db:para/db:emphasis[@role="bold"]});
            # TEST*$num_with_styles
            is (
                scalar(@elems),
                1,
                "DocBook: found bold tag",
            );

            # TEST*$num_with_styles
            is ($elems[0]->textContent(), "swear",
                "Elem[0] is the right <emphasis role=bold> tag."
            );

            @elems = $db_find->(
                q{//db:article//db:section/db:para/db:emphasis[not(@role)]}
            );
            # TEST*$num_with_styles
            is (
                scalar(@elems),
                1,
                "Found italic tag",
            );

            # TEST*$num_with_styles
            is ($elems[0]->textContent(), "David",
                "<i>[0] contains the right contents.",
            );
        }

        # Test the DocBook/XML incorporation of the <title> tag.
        {
            my @elems;

            @elems = $db_find->(
                q{//db:section[@xml:id='goliath']/db:info/db:title}
            );
            # TEST*$num_with_styles
            is (
                scalar(@elems),
                1,
                "DocBook: found one title tag",
            );

            # TEST*$num_with_styles
            is ($elems[0]->textContent(), "Goliath's Response",
                "title#goliath contains the right content.",
            );
        }
    }
}

1;