1#!perl -w
2
3# This test partly comes from ClearSilver/perl/test.pl
4
5use strict;
6use Test::More;
7
8use if !$ENV{TEST_ORIGINAL}, 'Text::ClearSilver::Compat';
9
10use Test::Requires qw(ClearSilver);
11use Test::Requires qw(Data::ClearSilver::HDF);
12
13
14note "Testing with ", exists $INC{'Text/ClearSilver.pm'}
15    ? 'Text::ClearSilver'
16    : 'the original ClearSilver';
17
18foreach (1 .. 2){
19    note($_);
20    my $hdf = ClearSilver::HDF->new();
21    isa_ok $hdf, "ClearSilver::HDF";
22
23    $hdf->readFile("t/data/basic.hdf");
24
25    my $lev2 = $hdf->getObj("TopNode.2nd1");
26    ok $lev2, "get_obj";
27
28    is $lev2->objName, "2nd1", "obj_name";
29
30    my $lev3 = $lev2->objChild;
31    ok $lev3, "obj_child";
32
33    is $lev3->objName,  "Entry1";
34    is $lev3->objValue, "value1", "obj_value";
35
36    my $next = $lev3->objNext;
37    ok $next, "obj_next";
38
39    is $next->objName, "Entry2";
40    is $next->objValue, "value2";
41
42    $lev2 = $hdf->getChild("TopNode.2nd1");
43    ok $lev2, "get_child";
44
45    $hdf->setValue("Data.1", "Value1");
46    is $hdf->getValue("Data.1", ''), "Value1", "set_value/get_value";
47
48    is $hdf->getValue("No_Such_Value", ''), '', "no such node";
49    is $hdf->getValue("No_Such_Value", "default"), "default", "no such node/default value";
50
51    my $copy = ClearSilver::HDF->new();
52    $copy->copy("", $hdf);
53
54    is $hdf->getValue("Data.1", ''), "Value1", "copy";
55
56    $copy->setSymlink("BottomNode", "TopNode");
57
58    ok $copy->getObj("BottomNode.2nd1"), "set_symlink";
59    ok !$hdf->getObj("BottomNode.2nd1"), "the original is not affected";
60
61    $copy->removeTree("TopNode");
62    ok !$copy->getObj("TopNode"), "remove_tree";
63    ok !$copy->getObj("TopNode.2nd1");
64
65    my $data = $hdf->getObj("Sort.Data");
66
67    sub cmp_func {
68        return $_[0]->objValue <=> $_[1]->objValue;
69    }
70    sub cmp_func_rev {
71        return $_[1]->objValue <=> $_[0]->objValue;
72    }
73
74    $data->sortObj('cmp_func');
75    is $data->objChild->objName, "entry3", "sort_obj";
76
77    $data->sortObj('cmp_func_rev');
78    is $data->objChild->objName, "entry1", "sort_obj";
79
80    my $cs = ClearSilver::CS->new($hdf);
81    isa_ok $cs, "ClearSilver::CS";
82
83    $cs->parseString("<?cs var:TopNode.2nd1.Entry3 ?>");
84
85    {
86        no warnings 'uninitialized'; # the origina render() produces warnings :(
87        is $cs->render, "value3", "parse_string & render";
88        is $cs->render, "value3", "parse_string & render (again)";
89    }
90
91    $cs = ClearSilver::CS->new($hdf);
92    $cs->parseString("foo <?cs var:TopNode.2nd1.Entry3 ?> bar");
93
94    {
95        no warnings 'uninitialized'; # the origina render() produces warnings :(
96        is $cs->render, "foo value3 bar";
97    }
98
99    $cs = ClearSilver::CS->new($hdf);
100    $cs->parseFile("t/data/basic.tcs");
101
102    my $result = do {
103        local $/;
104        open my $in, "<", "t/data/basic.gold" or die $!;
105        <$in>;
106    };
107
108    {
109        no warnings 'uninitialized'; # the origina render() produces warnings :(
110        is $cs->render, $result, "parse_file & render";
111    }
112
113    # D::CS::HDF
114    $hdf = Data::ClearSilver::HDF->hdf({ foo => 'bar' });
115    isa_ok $hdf, 'ClearSilver::HDF', 'Data::ClearSilver::HDF->hdf';
116    is $hdf->getObj('foo')->objValue, 'bar';
117}
118
119done_testing;
120