remove temp. files from tests per default
used func. 'tempfile' instead of 'tmpnam' and added the possibility
to turn removing of temporary files on/off by setting a debug flag
Change-Id: Ib1ab2a66d92e2c4387faf17ac5738b6fab40582d
diff --git a/t/script.t b/t/script.t
index 5010789..753326c 100644
--- a/t/script.t
+++ b/t/script.t
@@ -2,7 +2,7 @@
use warnings;
use File::Basename 'dirname';
use File::Spec::Functions qw/catfile/;
-use File::Temp ':POSIX';
+use File::Temp qw/tempfile/;
use IO::Uncompress::Unzip qw(unzip $UnzipError);
use Test::More;
@@ -10,6 +10,11 @@
use Test::XML::Loy;
+our %ENV;
+# default: remove temp. file created by func. tempfile
+# to keep temp. files use e.g. 'KORAPXMLTEI_DONTUNLINK=1 prove -lr t/script.t'
+my $_UNLINK = $ENV{KORAPXMLTEI_DONTUNLINK}?0:1;
+
my $f = dirname(__FILE__);
my $script = catfile($f, '..', 'script', 'tei2korapxml');
ok(-f $script, 'Script found');
@@ -29,13 +34,26 @@
# Load example file
my $file = catfile($f, 'data', 'goe_sample.i5.xml');
-my $outzip = tmpnam();
+
+my ($fh, $outzip) = tempfile("KorAP-XML-TEI_script_XXXXXXXXXX", SUFFIX => ".tmp", TMPDIR => 1, UNLINK => $_UNLINK);
# Generate zip file (unportable!)
# TODO:
# Call with aggressive and conservative tokenizations!
stderr_like(
sub { `cat '$file' | perl '$script' > '$outzip'` },
+# approaches for working with $fh (also better use OO interface then)
+# sub { open STDOUT, '>&', $fh; system("cat '$file' | perl '$script'") },
+# sub { open(my $pipe, "cat '$file' | perl '$script'|"); while(<$pipe>){$fh->print($_)}; $fh->close },
+# sub {
+# defined(my $pid = fork) or die "fork: $!";
+# if (!$pid) {
+# open STDOUT, '>&', $fh;
+# exec "cat '$file' | perl '$script'"
+# }
+# waitpid $pid, 0;
+# $fh->close;
+# },
qr!tei2korapxml: .*? text_id=GOE_AGA\.00000!,
'Processing'
);
@@ -47,6 +65,7 @@
ok($zip, 'Zip-File is created');
+# TODO: check wrong encoding in header-files (compare with input document)!
# Read GOE/header.xml
my $header_xml = '';
$header_xml .= $zip->getline while !$zip->eof;
@@ -112,6 +131,7 @@
# Read GOE/AGA/00000/struct/structure.xml
my $struct_xml = '';
$struct_xml .= $zip->getline while !$zip->eof;
+
ok($zip->close, 'Closed');
$t = Test::XML::Loy->new($struct_xml);