BEGIN {use_ok(
'XML::Table2XML'
,
qw(parseHeaderForXML addXMLLine commonParent offsetNodesXML)
);
my
@xmltests
=
glob
(
'testdir/*.txt'
);
print
"1.."
.(28 +
@xmltests
).
"\n"
};
my
@xmltests
=
glob
(
'testdir/*.txt'
);
plan
tests
=> (28 +
@xmltests
);
ok(commonParent(
"/a/b/c"
,
"/a/d/e"
) eq
"/a"
,
"commonParent"
);
ok(commonParent(
"/a/b"
,
"/a/b/c"
) eq
"/a/b"
,
"commonParent"
);
ok(commonParent(
"/a/b/c"
,
"/a/b"
) eq
"/a/b"
,
"commonParent"
);
ok(commonParent(
"/a/b/c"
,
"/x/d/e"
) eq
""
,
"commonParent"
);
ok(commonParent(
"/a/b/c"
,
"/a/b/c"
) eq
"/a/b/c"
,
"commonParent"
);
ok(commonParent(
"/a/b/c"
,
""
) eq
""
,
"commonParent"
);
ok(commonParent(
""
,
"/a/b/c"
) eq
""
,
"commonParent"
);
ok(offsetNodesXML(
"/a/b/c"
,
"/a/d/e"
) eq
"<b>"
,
"offsetNodesXML"
);
ok(offsetNodesXML(
"/a/b/c"
,
"/x/d/e"
) eq
"<a><b>"
,
"offsetNodesXML"
);
ok(offsetNodesXML(
"/a/b/c"
,
"/a/b/c"
) eq
""
,
"offsetNodesXML"
);
ok(offsetNodesXML(
"/a/b/c"
,
""
) eq
"<a><b>"
,
"offsetNodesXML"
);
ok(offsetNodesXML(
""
,
"/a/b/c"
) eq
""
,
"offsetNodesXML"
);
ok(offsetNodesXML(
"/a/b/c"
,
"/a/d/e"
, 1) eq
"</c></b>"
,
"offsetNodesXML"
);
ok(offsetNodesXML(
"/a/g/b/c"
,
"/a/g/d/e"
, 1) eq
"</c></b>"
,
"offsetNodesXML"
);
ok(offsetNodesXML(
"/a/g/b/c"
,
"/t/w/d/e"
, 1) eq
"</c></b></g></a>"
,
"offsetNodesXML"
);
ok(offsetNodesXML(
"/a/g/d/e"
,
"/a/g"
, 1) eq
"</e></d>"
,
"offsetNodesXML"
);
ok(offsetNodesXML(
"/a/g/b/c"
,
"/a/g/b/c"
, 1) eq
"</c>"
,
"offsetNodesXML"
);
ok(offsetNodesXML(
"/a/b/c"
,
""
, 1) eq
"</c></b></a>"
,
"offsetNodesXML"
);
ok(offsetNodesXML(
"/a/z"
,
"/a/b/c"
, 1, 1) eq
"</z></a>"
,
"offsetNodesXML"
);
my
$outXML
=
""
;
parseHeaderForXML(
"rootNodeName"
, [
'/@id'
,
'/@name2'
,
'/a'
]);
$outXML
.=addXMLLine([1,
"testName"
,
"testA"
]);
$outXML
.=addXMLLine(
undef
);
is_xml(
'<rootNodeName id="1" name2="testName"><a>testA</a></rootNodeName>'
,
$outXML
,
"invocation test 1, xml correct"
);
like(
$outXML
,
'/^<\?xml version="1\.0"\?>/'
,
"invocation test 1, xmldirective check"
);
unlike(
$outXML
,
'/\n/'
,
"invocation test 1, newline check"
);
$outXML
=
""
;
parseHeaderForXML(
"rootNodeName"
, [
'/@id'
,
'/@name2'
,
'/a'
], 1,
'<?xml version="1.1"?>'
);
$outXML
.=addXMLLine([1,
"testName"
,
"testA"
]);
$outXML
.=addXMLLine(
undef
);
is_xml(
'<rootNodeName id="1" name2="testName"><a>testA</a></rootNodeName>'
,
$outXML
,
"invocation test 2, xml correct"
);
like(
$outXML
,
'/^<\?xml version="1\.1"\?>/'
,
"invocation test 2, xmldirective check"
);
like(
$outXML
,
'/\n/'
,
"invocation test 2, newline check"
);
dies_ok { parseHeaderForXML();}
'expecting to die without rootnode'
;
dies_ok { parseHeaderForXML(
"rootNodeName"
);}
'expecting to die without headers'
;
dies_ok { parseHeaderForXML(
"rootNodeName"
, [
"a"
,
"b"
]);}
'expecting to die without proper headers'
;
for
my
$testfilename
(
@xmltests
) {
my
$rootNodeName
;
my
@headerLine
;
my
@datarows
;
my
$expectedXML
;
readTxtFile(
$testfilename
, \
$rootNodeName
, \
@headerLine
, \
@datarows
);
readXMLFile(
$testfilename
, \
$expectedXML
);
my
$testXML
=
""
;
parseHeaderForXML(
$rootNodeName
, \
@headerLine
);
for
my
$lineData
(
@datarows
) {
$testXML
.=addXMLLine(
$lineData
);
}
$testXML
.=addXMLLine(
undef
);
is_xml(
$expectedXML
,
$testXML
,
"XML comparison:"
.
$testfilename
);
}
sub
readTxtFile {
my
(
$testfilename
,
$rootNodeName
,
$headerLine
,
$datarows
) =
@_
;
open
(TXTIN,
"<$testfilename"
);
$_
= <TXTIN>;
chomp
;
$$rootNodeName
=
$_
;
$_
= <TXTIN>;
chomp
;
@$headerLine
=
split
"\t"
;
while
(<TXTIN>) {
chomp
;
my
@dataline
=
split
"\t"
;
push
@$datarows
, \
@dataline
;
}
close
TXTIN;
}
sub
readXMLFile {
my
(
$testfilename
,
$expectedXML
) =
@_
;
$testfilename
=~ s/\.txt/\.xml/;
open
(TXTIN,
"<$testfilename"
);
my
$oldRecSep
= $/;
undef
$/;
$$expectedXML
= <TXTIN>;
$/ =
$oldRecSep
;
close
TXTIN;
}