#!/usr/bin/perl

# This code used to generate a memory error in valgrind/etc.
# Testing it.

use strict;
use warnings;

use Test::More tests => 2;

use utf8;

package Test::XML::Ordered;

use XML::LibXML::Reader;

use Test::More;

use parent 'Exporter';

use vars '@EXPORT_OK';

@EXPORT_OK = (qw(is_xml_ordered));

sub new
{
    my $class = shift;
    my $self = {};

    bless $self, $class;

    $self->_init(@_);

    return $self;
}

sub _got
{
    return shift->{got_reader};
}

sub _expected
{
    return shift->{expected_reader};
}

sub _init
{
    my ($self, $args) = @_;

    $self->{got_reader} =
        XML::LibXML::Reader->new(@{$args->{got_params}});
    $self->{expected_reader} =
        XML::LibXML::Reader->new(@{$args->{expected_params}});

    $self->{diag_message} = $args->{diag_message};

    $self->{got_end} = 0;
    $self->{expected_end} = 0;

    return;
}

sub _got_end
{
    return shift->{got_end};
}

sub _expected_end
{
    return shift->{expected_end};
}

sub _read_got
{
    my $self = shift;

    if ($self->_got->read() <= 0)
    {
        $self->{got_end} = 1;
    }

    return;
}

sub _read_expected
{
    my $self = shift;

    if ($self->_expected->read() <= 0)
    {
        $self->{expected_end} = 1;
    }

    return;
}

sub _next_elem
{
    my $self = shift;

    $self->_read_got();
    $self->_read_expected();

    return;
}

sub _ns
{
    my $elem = shift;
    my $ns = $elem->namespaceURI();

    return defined($ns) ? $ns : "";
}

sub _compare_loop
{
    my $self = shift;

    my $calc_prob = sub {
        my $args = shift;

        if (!exists($args->{param}))
        {
            die "No 'param' specified.";
        }
        return
        {
            verdict => 0,
            param => $args->{param},
        }
    };

    NODE_LOOP:
    while ((!$self->_got_end()) && (!$self->_expected_end()))
    {
        my $type = $self->_got->nodeType();
        my $exp_type = $self->_expected->nodeType();

        if ($type == XML_READER_TYPE_SIGNIFICANT_WHITESPACE())
        {
            $self->_read_got();
            redo NODE_LOOP;
        }
        elsif ($exp_type == XML_READER_TYPE_SIGNIFICANT_WHITESPACE())
        {
            $self->_read_expected();
            redo NODE_LOOP;
        }
        elsif ($type != $exp_type)
        {
            return $calc_prob->({param => "nodeType"});
        }
        elsif ($type == XML_READER_TYPE_TEXT())
        {
            my $got_text = $self->_got->value();
            my $expected_text = $self->_expected->value();

            foreach my $t ($got_text, $expected_text)
            {
                $t =~ s{\A\s+}{}ms;
                $t =~ s{\s+\z}{}ms;
                $t =~ s{\s+}{ }ms;
            }
            if ($got_text ne $expected_text)
            {
                return $calc_prob->({param => "text"});
            }
        }
        elsif ($type == XML_READER_TYPE_ELEMENT())
        {
            if ($self->_got->name() ne $self->_expected->name())
            {
                return $calc_prob->({param => "element_name"});
            }
            if (_ns($self->_got) ne _ns($self->_expected))
            {
                return $calc_prob->({param => "mismatch_ns"});
            }
        }
    }
    continue
    {
        $self->_next_elem();
    }

    return { verdict => 1};
}

sub _get_diag_message
{
    my ($self, $status_struct) = @_;

    if ($status_struct->{param} eq "nodeType")
    {
        return
            "Different Node Type!\n"
            . "Got: " . $self->_got->nodeType() . " at line " . $self->_got->lineNumber()
            . "\n"
            . "Expected: " . $self->_expected->nodeType() . " at line " . $self->_expected->lineNumber()
            ;
    }
    elsif ($status_struct->{param} eq "text")
    {
        return
            "Texts differ: Got at " . $self->_got->lineNumber(). " with value <<@{[$self->_got->value()]}>> ; Expected at ". $self->_expected->lineNumber() . " with value <<@{[$self->_expected->value()]}>>.";
    }
    elsif ($status_struct->{param} eq "element_name")
    {
        return
            "Got name: " . $self->_got->name(). " at " . $self->_got->lineNumber() .
            " ; " .
            "Expected name: " . $self->_expected->name() . " at " .$self->_expected->lineNumber();
    }
    elsif ($status_struct->{param} eq "mismatch_ns")
    {
        return
            "Got Namespace: " . _ns($self->_got). " at " . $self->_got->lineNumber() .
            " ; " .
            "Expected Namespace: " . _ns($self->_expected) . " at " .$self->_expected->lineNumber();
    }

    else
    {
        die "Unknown param";
    }
}

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

    my $self = shift;

    $self->_next_elem();

    my $status_struct = $self->_compare_loop();
    my $verdict = $status_struct->{verdict};

    if (!$verdict)
    {
        diag($self->_get_diag_message($status_struct));
    }

    return ok($verdict, $self->{diag_message});
}

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

    my ($got_params, $expected_params, $message) = @_;

    my $comparator =
        Test::XML::Ordered->new(
            {
                got_params => $got_params,
                expected_params => $expected_params,
                diag_message => $message,
            }
        );

    return $comparator->compare();
}

my $xml_source = <<'EOF';
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xmlns:fic="http://web-cpan.berlios.de/modules/XML-Grammar-Fortune/fiction-xml-0.2/">
  <head>
    <title>David vs. Goliath - Part I</title>
  </head>
  <body>
    <div class="fiction story" xml:id="index">
      <h1>David vs. Goliath - Part I</h1>
      <div class="fiction section" xml:id="top">
        <h2>The Top Section</h2>
        <p>
    King David and Goliath were standing by each other.
    </p>
        <p>
    David said unto Goliath: "I will shoot you. I <b>swear</b> I will"
    </p>
        <div class="fiction section" xml:id="goliath">
          <h3>Goliath's Response</h3>
          <p>
    Goliath was not amused.
    </p>
          <p>
    He said to David: "Oh, really. <i>David</i>, the red-headed!".
    </p>
          <p>
    David started listing Goliath's disadvantages:
    </p>
        </div>
      </div>
    </div>
  </body>
</html>
EOF

my $final_source = <<'EOF';
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xmlns:fic="http://web-cpan.berlios.de/modules/XML-Grammar-Fortune/fiction-xml-0.2/">
  <head>
    <title>David vs. Goliath - Part I</title>
  </head>
  <body>
    <div class="fiction story" xml:id="index">
      <h1>David vs. Goliath - Part I</h1>
      <div class="fiction section" xml:id="top">
        <h2>The Top Section</h2>
        <p>
    King David and Goliath were standing by each other.
    </p>
        <p>
    David said unto Goliath: "I will shoot you. I <b>swear</b> I will"
    </p>
        <div class="fiction section" xml:id="goliath">
          <h3>Goliath's Response</h3>
          <p>
    Goliath was not amused.
    </p>
          <p>
    He said to David: "Oh, really. <i>David</i>, the red-headed!".
    </p>
          <p>
    David started listing Goliath's disadvantages:
    </p>
        </div>
      </div>
    </div>
  </body>
</html>
EOF

SKIP: {
    # RT #84564
    # https://bugzilla.gnome.org/show_bug.cgi?id=447899
    if (XML::LibXML::LIBXML_RUNTIME_VERSION() < 20704) {
        skip('Known double-free with libxml2 < 2.7.4', 1);
    }

    my @common = (validation => 0, load_ext_dtd => 0, no_network => 1);
    # TEST
    Test::XML::Ordered::is_xml_ordered(
        [ string => $final_source, @common,],
        [ string => $xml_source, @common,],
        "foo",
    );
}

# TEST
ok (1, "Finished");