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