use Test;
BEGIN { 
    if ($^O eq 'linux' && $ENV{MEMORY_TEST}) {
        plan tests => 26;
    }
    else {
        plan tests => 0;
        print "# Skipping test on this platform\n";
    }
}
use XML::LibXML;
use XML::LibXML::SAX::Builder;
{
    if ($^O eq 'linux' && $ENV{MEMORY_TEST}) {

#        require Devel::Peek;
        my $peek = 0;
    
        ok(1);

        my $times_through = $ENV{MEMORY_TIMES} || 100_000;
    
        print("# BASELINE\n");
        check_mem(1);

        print("# MAKE DOC IN SUB\n");
        {
            my $doc = make_doc();
            ok($doc);
            ok($doc->toString);
        }
        check_mem();
        print("# MAKE DOC IN SUB II\n");
        # same test as the first one. if this still leaks, it's
        # our problem, otherwise it's perl :/
        {
            my $doc = make_doc();
            ok($doc);

            ok($doc->toString);
        }
        check_mem();

        {
            my $elem = XML::LibXML::Element->new("foo");
            my $elem2= XML::LibXML::Element->new("bar");
            $elem->appendChild($elem2);
            ok( $elem->toString );
        }
        check_mem();

        print("# SET DOCUMENT ELEMENT\n");
        {
            my $doc2 = XML::LibXML::Document->new();
            make_doc_elem( $doc2 );
            ok( $doc2 );
            ok( $doc2->documentElement );
        }
        check_mem();

        # multiple parsers:
        print("# MULTIPLE PARSERS\n");
        for (1..$times_through) {
            my $parser = XML::LibXML->new();
        }
        ok(1);

        check_mem();
        # multiple parses
        print("# MULTIPLE PARSES\n");
        for (1..$times_through) {
            my $parser = XML::LibXML->new();
            my $dom = $parser->parse_string("<sometag>foo</sometag>");
        }
        ok(1);

        check_mem();

        # multiple failing parses
        print("# MULTIPLE FAILURES\n");
        for (1..$times_through) {
            # warn("$_\n") unless $_ % 100;
            my $parser = XML::LibXML->new();
            eval {
                my $dom = $parser->parse_string("<sometag>foo</somtag>"); # Thats meant to be an error, btw!
            };
        }
        ok(1);
    
        check_mem();

        # building custom docs
        print("# CUSTOM DOCS\n");
        my $doc = XML::LibXML::Document->new();
        for (1..$times_through)        {
            my $elem = $doc->createElement('x');
            
            if($peek) {
                warn("Doc before elem\n");
                # Devel::Peek::Dump($doc);
                warn("Elem alone\n");
                # Devel::Peek::Dump($elem);
            }
            
            $doc->setDocumentElement($elem);
            
            if ($peek) {
                warn("Elem after attaching\n");
                # Devel::Peek::Dump($elem);
                warn("Doc after elem\n");
                # Devel::Peek::Dump($doc);
            }
        }
        if ($peek) {
            warn("Doc should be freed\n");
            # Devel::Peek::Dump($doc);
        }
        ok(1);
        check_mem();

        {
            my $doc = XML::LibXML->createDocument;
            for (1..$times_through)        {
                make_doc2( $doc );
            }
        }
        ok(1);
        check_mem();

        print("# DTD string parsing\n");

        my $dtdstr;
        {
            local $/; local *DTD;
            open(DTD, 'example/test.dtd') || die $!;
            $dtdstr = <DTD>;
            $dtdstr =~ s/\r//g;
            $dtdstr =~ s/[\r\n]*$//;
            close DTD;
        }

        ok($dtdstr);

        for ( 1..$times_through ) {
            my $dtd = XML::LibXML::Dtd->parse_string($dtdstr);
        }
        ok(1);
        check_mem();

        print( "# DTD URI parsing \n");
        # parse a DTD from a SYSTEM ID
        for ( 1..$times_through ) {
            my $dtd = XML::LibXML::Dtd->new('ignore', 'example/test.dtd');
        }
        ok(1);
        check_mem();

        print("# Document validation\n");
        {
            print "# is_valid()\n";
            my $dtd = XML::LibXML::Dtd->parse_string($dtdstr);
            my $xml;
            eval {
                local $SIG{'__WARN__'} = sub { };
                $xml = XML::LibXML->new->parse_file('example/article_bad.xml');
            };
            for ( 1..$times_through ) {
                my $good;
                eval {
                    local $SIG{'__WARN__'} = sub { };
                    $good = $xml->is_valid($dtd);
                };
            }
            ok(1);
            check_mem();
        
            print "# validate() \n";
            for ( 1..$times_through ) {
                eval {
                    local $SIG{'__WARN__'} = sub { };
                    $xml->validate($dtd);
                };
            }
            ok(1);
            check_mem();
                
        }

        print "# FIND NODES \n";
        my $xml=<<'dromeds.xml';
<?xml version="1.0" encoding="UTF-8"?>
<dromedaries>
    <species name="Camel">
      <humps>1 or 2</humps>
      <disposition>Cranky</disposition>
    </species>                         
    <species name="Llama">
      <humps>1 (sort of)</humps>
      <disposition>Aloof</disposition>
    </species>                        
    <species name="Alpaca">
      <humps>(see Llama)</humps>
      <disposition>Friendly</disposition>
    </species>                           
</dromedaries>
dromeds.xml

        {
            # my $str = "<foo><bar><foo/></bar></foo>";
            my $str = $xml;
            my $doc = XML::LibXML->new->parse_string( $str );
            for ( 1..$times_through ) {
                 processMessage($xml, '/dromedaries/species' );
#                my @nodes = $doc->findnodes("/foo/bar/foo");
            }
            ok(1);
            check_mem();

        }

        {
            my $str = "<foo><bar><foo/></bar></foo>";
            my $doc = XML::LibXML->new->parse_string( $str );
            for ( 1..$times_through ) {
                my $nodes = $doc->find("/foo/bar/foo");
            }
            ok(1);
            check_mem();

        }

#        {
#            print "# ENCODING TESTS \n";
#            my $string = "test ä ø is a test string to test iso encoding";
#            my $encstr = encodeToUTF8( "iso-8859-1" , $string );
#            for ( 1..$times_through ) {
#                my $str = encodeToUTF8( "iso-8859-1" , $string );
#            }
#            ok(1);
#            check_mem();

#            for ( 1..$times_through ) {
#                my $str = encodeToUTF8( "iso-8859-2" , "abc" );
#            }
#            ok(1);
#            check_mem();
#    
#            for ( 1..$times_through ) {
#                my $str = decodeFromUTF8( "iso-8859-1" , $encstr );
#            }
#            ok(1);
#            check_mem();
#        }
        {
            print "# NAMESPACE TESTS \n";

            my $string = '<foo:bar xmlns:foo="bar"><foo:a/><foo:b/></foo:bar>';

            my $doc = XML::LibXML->new()->parse_string( $string );

            for (1..$times_through) {
                my @ns = $doc->documentElement()->getNamespaces();
                # warn "ns : " . $_->localname . "=>" . $_->href foreach @ns;
                my $prefix = $_->localname foreach @ns;
                my $name = $doc->documentElement->nodeName;
            }  
            check_mem();
            ok(1);
        }   

        {
            print "# SAX PARSER\n";

        my %xmlStrings = (
            "SIMPLE"      => "<xml1><xml2><xml3></xml3></xml2></xml1>",
            "SIMPLE TEXT" => "<xml1> <xml2>some text some text some text </xml2> </xml1>",
            "SIMPLE COMMENT" => "<xml1> <xml2> <!-- some text --> <!-- some text --> <!--some text--> </xml2> </xml1>",
            "SIMPLE CDATA" => "<xml1> <xml2><![CDATA[some text some text some text]]></xml2> </xml1>",
            "SIMPLE ATTRIBUTE" => '<xml1  attr0="value0"> <xml2 attr1="value1"></xml2> </xml1>',
            "NAMESPACES SIMPLE" => '<xm:xml1 xmlns:xm="foo"><xm:xml2/></xm:xml1>',
            "NAMESPACES ATTRIBUTE" => '<xm:xml1 xmlns:xm="foo"><xm:xml2 xm:foo="bar"/></xm:xml1>',
        );

            my $handler = sax_null->new;
            my $parser  = XML::LibXML->new;
            $parser->set_handler( $handler );

            check_mem();
       
            foreach my $key ( keys %xmlStrings )  {
                print "# $key \n";
                for (1..$times_through) {
                    my $doc = $parser->parse_string( $xmlStrings{$key} );
                }

                check_mem();
            }
            ok(1);
        }

        {
            print "# PUSH PARSER\n";

        my %xmlStrings = (
            "SIMPLE"      => ["<xml1>","<xml2><xml3></xml3></xml2>","</xml1>"],
            "SIMPLE TEXT" => ["<xml1> ","<xml2>some text some text some text"," </xml2> </xml1>"],
            "SIMPLE COMMENT" => ["<xml1","> <xml2> <!","-- some text --> <!-- some text --> <!--some text-","-> </xml2> </xml1>"],
            "SIMPLE CDATA" => ["<xml1> ","<xml2><!","[CDATA[some text some text some text]","]></xml2> </xml1>"],
            "SIMPLE ATTRIBUTE" => ['<xml1 ','attr0="value0"> <xml2 attr1="value1"></xml2>',' </xml1>'],
            "NAMESPACES SIMPLE" => ['<xm:xml1 xmlns:x','m="foo"><xm:xml2','/></xm:xml1>'],
            "NAMESPACES ATTRIBUTE" => ['<xm:xml1 xmlns:xm="foo">','<xm:xml2 xm:foo="bar"/></xm',':xml1>'],
        );

            my $handler = sax_null->new;
            my $parser  = XML::LibXML->new;

            check_mem();
       if(0) {
            foreach my $key ( keys %xmlStrings )  {
                print "# $key \n";
                for (1..$times_through) {
                    map { $parser->push( $_ ) } @{$xmlStrings{$key}};
                    my $doc = $parser->finish_push();
                }

                check_mem();
            }
            ok(1);
        }
            my %xmlBadStrings = (
                "SIMPLE"      => ["<xml1>"],
                "SIMPLE2"      => ["<xml1>","</xml2>", "</xml1>"],
                "SIMPLE TEXT" => ["<xml1> ","some text some text some text","</xml2>"],
                "SIMPLE CDATA"=> ["<xml1> ","<!","[CDATA[some text some text some text]","</xml1>"],
                "SIMPLE JUNK" => ["<xml1/> ","junk"],
            );

            print "# BAD PUSHED DATA\n";
            foreach my $key ( "SIMPLE","SIMPLE2", "SIMPLE TEXT","SIMPLE CDATA","SIMPLE JUNK" )  {
                print "# $key \n";
                for (1..$times_through) {
                    eval {map { $parser->push( $_ ) } @{$xmlBadStrings{$key}};};
                    eval {my $doc = $parser->finish_push();};
                }

                check_mem();
            }            
            ok(1);
        }

        {
            print "# SAX PUSH PARSER\n";

            my $handler = sax_null->new;
            my $parser  = XML::LibXML->new;
            $parser->set_handler( $handler );
            check_mem();


        my %xmlStrings = (
            "SIMPLE"      => ["<xml1>","<xml2><xml3></xml3></xml2>","</xml1>"],
            "SIMPLE TEXT" => ["<xml1> ","<xml2>some text some text some text"," </xml2> </xml1>"],
            "SIMPLE COMMENT" => ["<xml1","> <xml2> <!","-- some text --> <!-- some text --> <!--some text-","-> </xml2> </xml1>"],
            "SIMPLE CDATA" => ["<xml1> ","<xml2><!","[CDATA[some text some text some text]","]></xml2> </xml1>"],
            "SIMPLE ATTRIBUTE" => ['<xml1 ','attr0="value0"> <xml2 attr1="value1"></xml2>',' </xml1>'],
            "NAMESPACES SIMPLE" => ['<xm:xml1 xmlns:x','m="foo"><xm:xml2','/></xm:xml1>'],
            "NAMESPACES ATTRIBUTE" => ['<xm:xml1 xmlns:xm="foo">','<xm:xml2 xm:foo="bar"/></xm',':xml1>'],
        );
       
            foreach my $key ( keys %xmlStrings )  {
                print "# $key \n";
                for (1..$times_through) {
                    eval {map { $parser->push( $_ ) } @{$xmlStrings{$key}};};
                    eval {my $doc = $parser->finish_push();};
                }

                check_mem();
            }
            ok(1);

            print "# BAD PUSHED DATA\n";

            my %xmlBadStrings = (
                "SIMPLE "      => ["<xml1>"],
                "SIMPLE2"      => ["<xml1>","</xml2>", "</xml1>"],
                "SIMPLE TEXT"  => ["<xml1> ","some text some text some text","</xml2>"],
                "SIMPLE CDATA" => ["<xml1> ","<!","[CDATA[some text some text some text]","</xml1>"],
                "SIMPLE JUNK"  => ["<xml1/> ","junk"],
            );

            foreach my $key ( keys %xmlBadStrings )  {
                print "# $key \n";
                for (1..$times_through) {
                    eval {map { $parser->push( $_ ) } @{$xmlBadStrings{$key}};};
                    eval {my $doc = $parser->finish_push();};
                }

                check_mem();
            }            
            ok(1);
        }
    }
}

sub processMessage {
      my ($msg, $xpath) = @_;
      my $parser = XML::LibXML->new();
                                      
      my $doc  = $parser->parse_string($msg);
      my $elm  = $doc->getDocumentElement;   
      my $node = $doc->findnodes($xpath);      
      my $text = $node->to_literal->value;
#      undef $doc;   # comment this line to make memory leak much worse
#      undef $parser;
}

sub make_doc {
    # code taken from an AxKit XSP generated page
    my ($r, $cgi) = @_;
    my $document = XML::LibXML::Document->createDocument("1.0", "UTF-8");
    # warn("document: $document\n");
    my ($parent);

    { 
        my $elem = $document->createElement(q(p));
        $document->setDocumentElement($elem); 
        $parent = $elem; 
    }

    $parent->setAttribute("xmlns:" . q(param), q(http://axkit.org/XSP/param));
    
    { 
        my $elem = $document->createElementNS(q(http://axkit.org/XSP/param),q(param:foo),);
        $parent->appendChild($elem);
        $parent = $elem;
    }

    $parent = $parent->parentNode;
    # warn("parent now: $parent\n");
    $parent = $parent->parentNode;
    # warn("parent now: $parent\n");

    return $document
}

sub make_doc2 {
    my $docA = shift;
    my $docB = XML::LibXML::Document->new;
    my $e1   = $docB->createElement( "A" );
    my $e2   = $docB->createElement( "B" );
    $e1->appendChild( $e2 );
    $docA->setDocumentElement( $e1 );
}

sub check_mem {
    my $initialise = shift;
    # Log Memory Usage
    local $^W;
    my %mem;
    if (open(FH, "/proc/self/status")) {
        my $units;
        while (<FH>) {
            if (/^VmSize.*?(\d+)\W*(\w+)$/) {
                $mem{Total} = $1;
                $units = $2;
            }
            if (/^VmRSS:.*?(\d+)/) {
                $mem{Resident} = $1;
            }
        }
        close FH;

        if ($LibXML::TOTALMEM != $mem{Total}) {
            warn("LEAK! : ", $mem{Total} - $LibXML::TOTALMEM, " $units\n") unless $initialise;
            $LibXML::TOTALMEM = $mem{Total};
        }

        print("# Mem Total: $mem{Total} $units, Resident: $mem{Resident} $units\n");
    }
}

# some tests for document fragments
sub make_doc_elem {
    my $doc = shift;
    my $dd = XML::LibXML::Document->new();
    my $node1 = $doc->createElement('test1');
    my $node2 = $doc->createElement('test2');
    $doc->setDocumentElement( $node1 );
}

package sax_null;

# require Devel::Peek;
# use Data::Dumper;

sub new {
    my $class = shift;
    bless {}, $class;
}

sub start_document {
    my $self = shift;
    my $dummy = shift;
}

sub xml_decl {
    my $self = shift;
    my $dummy = shift;
}

sub start_element {
    my $self = shift;
    my $dummy = shift;
    # warn Dumper( $dummy );
}

sub end_element {
    my $self = shift;
    my $dummy = shift;
}

sub start_cdata {
    my $self = shift;
    my $dummy = shift;
}

sub end_cdata {
    my $self = shift;
    my $dummy = shift;
}

sub start_prefix_mapping {
    my $self = shift;
    my $dummy = shift;
}

sub end_prefix_mapping {
    my $self = shift;
    my $dummy = shift;
}

sub characters {
    my $self = shift;
    my $dummy = shift;
}

sub comment {
    my $self = shift;
    my $dummy = shift;
}


sub end_document {
    my $self = shift;
    my $dummy = shift;
}

sub error {
    my $self = shift;
    my $msg  = shift;
    die( $msg );
}

1;