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

# This test partly comes from ClearSilver/perl/test.pl

use strict;
use Test::More;

use if !$ENV{TEST_ORIGINAL}, 'Text::ClearSilver::Compat';

use Test::Requires qw(ClearSilver);
use Test::Requires qw(Data::ClearSilver::HDF);


note "Testing with ", exists $INC{'Text/ClearSilver.pm'}
    ? 'Text::ClearSilver'
    : 'the original ClearSilver';

foreach (1 .. 2){
    note($_);
    my $hdf = ClearSilver::HDF->new();
    isa_ok $hdf, "ClearSilver::HDF";

    $hdf->readFile("t/data/basic.hdf");

    my $lev2 = $hdf->getObj("TopNode.2nd1");
    ok $lev2, "get_obj";

    is $lev2->objName, "2nd1", "obj_name";

    my $lev3 = $lev2->objChild;
    ok $lev3, "obj_child";

    is $lev3->objName,  "Entry1";
    is $lev3->objValue, "value1", "obj_value";

    my $next = $lev3->objNext;
    ok $next, "obj_next";

    is $next->objName, "Entry2";
    is $next->objValue, "value2";

    $lev2 = $hdf->getChild("TopNode.2nd1");
    ok $lev2, "get_child";

    $hdf->setValue("Data.1", "Value1");
    is $hdf->getValue("Data.1", ''), "Value1", "set_value/get_value";

    is $hdf->getValue("No_Such_Value", ''), '', "no such node";
    is $hdf->getValue("No_Such_Value", "default"), "default", "no such node/default value";

    my $copy = ClearSilver::HDF->new();
    $copy->copy("", $hdf);

    is $hdf->getValue("Data.1", ''), "Value1", "copy";

    $copy->setSymlink("BottomNode", "TopNode");

    ok $copy->getObj("BottomNode.2nd1"), "set_symlink";
    ok !$hdf->getObj("BottomNode.2nd1"), "the original is not affected";

    $copy->removeTree("TopNode");
    ok !$copy->getObj("TopNode"), "remove_tree";
    ok !$copy->getObj("TopNode.2nd1");

    my $data = $hdf->getObj("Sort.Data");

    sub cmp_func {
        return $_[0]->objValue <=> $_[1]->objValue;
    }
    sub cmp_func_rev {
        return $_[1]->objValue <=> $_[0]->objValue;
    }

    $data->sortObj('cmp_func');
    is $data->objChild->objName, "entry3", "sort_obj";

    $data->sortObj('cmp_func_rev');
    is $data->objChild->objName, "entry1", "sort_obj";

    my $cs = ClearSilver::CS->new($hdf);
    isa_ok $cs, "ClearSilver::CS";

    $cs->parseString("<?cs var:TopNode.2nd1.Entry3 ?>");

    {
        no warnings 'uninitialized'; # the origina render() produces warnings :(
        is $cs->render, "value3", "parse_string & render";
        is $cs->render, "value3", "parse_string & render (again)";
    }

    $cs = ClearSilver::CS->new($hdf);
    $cs->parseString("foo <?cs var:TopNode.2nd1.Entry3 ?> bar");

    {
        no warnings 'uninitialized'; # the origina render() produces warnings :(
        is $cs->render, "foo value3 bar";
    }

    $cs = ClearSilver::CS->new($hdf);
    $cs->parseFile("t/data/basic.tcs");

    my $result = do {
        local $/;
        open my $in, "<", "t/data/basic.gold" or die $!;
        <$in>;
    };

    {
        no warnings 'uninitialized'; # the origina render() produces warnings :(
        is $cs->render, $result, "parse_file & render";
    }

    # D::CS::HDF
    $hdf = Data::ClearSilver::HDF->hdf({ foo => 'bar' });
    isa_ok $hdf, 'ClearSilver::HDF', 'Data::ClearSilver::HDF->hdf';
    is $hdf->getObj('foo')->objValue, 'bar';
}

done_testing;