#!perl -T
use
5.10.1;
Readonly
our
%payloadKeys
=> (
'dataField'
=> {
type
=>
$ProfileData
,
description
=>
'A field containing data.'
,
},
);
plan
tests
=> (1 + 2 + 2 + 3 + 3)
+ 4
+ 7
+ 2
;
my
(
$volume
,
$test_path
,
$test_file
) = File::Spec->splitpath(abs_path(__FILE__));
Readonly
my
$key_file
=>
File::Spec->catpath(
$volume
,
File::Spec->catdir((
$test_path
,
'files'
)),
'key.key'
);
diag
"Running test with file $key_file"
;
local
$/;
my
$reference_fh
;
if
(
open
$reference_fh
,
'<'
,
$key_file
) {
pass(
'Open reference file'
);
}
else
{
fail(
'Open reference file'
);
diag
"OS error: $!"
;
}
binmode
$reference_fh
;
my
$reference_data
= <
$reference_fh
>;
diag
'Reference file size is '
.
length
(
$reference_data
);
close
$reference_fh
;
undef
$reference_fh
;
my
$side1_object
= new Local::Data;
my
$side1_payload
=
$side1_object
->payload;
my
$side2_object
= new Local::Data;
my
$side2_payload
=
$side2_object
->payload;
my
$side1_fh
;
if
(
open
$side1_fh
,
'<'
,
$key_file
) {
pass(
'Open file via open'
);
}
else
{
fail(
'Open file via open'
);
diag
"OS error: $!"
;
}
binmode
$side1_fh
;
lives_ok {
$side1_payload
->{dataField} =
$side1_fh
}
'Put basic FH into object'
;
undef
$side1_fh
;
my
$side2_IO
;
if
(
$side2_IO
= IO::File->new(
$key_file
,
'<'
)) {
pass(
'Open file via IO::File'
);
}
else
{
fail(
'Open file via IO::File'
);
diag
"OS error: $!"
;
}
$side2_IO
->
binmode
;
lives_ok {
$side2_payload
->{dataField} =
$side2_IO
}
'Put IO::File into object'
;
undef
$side2_IO
;
my
$side1_handle
=
$side1_payload
->{dataField};
my
$side1_data
=
''
;
my
$side1_read
= 0;
ok(openhandle
$side1_handle
,
'FH object is still open'
);
while
(
my
$chars_read
=
read
(
$side1_handle
,
my
$data_read
, 4096)) {
$side1_read
+=
$chars_read
;
$side1_data
.=
$data_read
;
}
cmp_ok(
$side1_read
,
'=='
,
length
(
$reference_data
),
'FH method read correct # bytes'
);
ok(
$side1_data
eq
$reference_data
,
'FH method read correct data'
);
undef
$side1_data
;
undef
$side1_handle
;
my
$side2_handle
=
$side2_payload
->{dataField};
my
$side2_data
=
''
;
my
$side2_read
= 0;
ok(openhandle
$side2_handle
,
'IO::File object is still open'
);
while
(
my
$chars_read
=
read
(
$side2_handle
,
my
$data_read
, 4096)) {
$side2_read
+=
$chars_read
;
$side2_data
.=
$data_read
;
}
cmp_ok(
$side2_read
,
'=='
,
length
(
$reference_data
),
'IO::File method read correct # bytes'
);
cmp_ok(
$side2_data
,
'eq'
,
$reference_data
,
'IO::File method read correct data'
);
undef
$side2_data
;
undef
$side2_handle
;
undef
$side1_payload
;
undef
$side2_payload
;
undef
$side1_object
;
undef
$side2_object
;
my
$string
=
"Kohlens\N{U+00E4}ure ohne die "
.
"Rindfleischetikettierungs\N{U+00FC}berwachungsaufgabenu\N{U+0308}bertragungsgesetz!"
;
my
$encoded_string
= encode(
'UTF-8'
,
$string
, Encode::LEAVE_SRC);
my
$string_object
= new Local::Data;
my
$string_payload
=
$string_object
->payload;
dies_ok {
$string_payload
->{dataField} =
$string
; }
'Put utf8 data into payload'
;
lives_ok {
$string_payload
->{dataField} =
$encoded_string
; }
'Put encoded data into payload'
;
my
$encoded_handle
=
$string_payload
->{dataField};
seek
$encoded_handle
, 0, SEEK_SET;
my
$encoded_candidate
= <
$encoded_handle
>;
cmp_ok(
length
(
$encoded_candidate
),
'=='
,
length
(
$encoded_string
),
'Check string length'
);
cmp_ok(
$encoded_candidate
,
'eq'
,
$encoded_string
,
'Check string contents'
);
undef
$encoded_handle
;
undef
$string_payload
;
undef
$string_object
;
my
$orig_umask
=
umask
;
if
(
defined
$orig_umask
) {
umask
0077;
}
Readonly
my
$tempdir
=> tempdir(
'data_testXXXX'
,
TMPDIR
=> 1);
Readonly
my
$filename
=> File::Spec->catfile((
$tempdir
),
'write_only.t'
);
Readonly
my
$closed_file
=> File::Spec->catfile((
$tempdir
),
'closed.t'
);
diag
"Write-only file is at $filename\n"
;
diag
"Closed file is at $closed_file\n"
;
my
$closed_handle
;
if
(
open
$closed_handle
,
'>'
,
$closed_file
) {
pass(
'Open temporary file'
)
}
else
{
diag
"OS error: $!"
;
fail(
'Open temporary file'
);
}
print
$closed_handle
"Karl is awesome?\n"
;
close
$closed_handle
;
my
$closed_object
= new Local::Data;
my
$closed_payload
=
$closed_object
->payload;
dies_ok {
$closed_payload
->{dataField} =
$closed_handle
; }
'Put a closed filehandle into payload'
;
my
$write_handle
;
if
(
open
$write_handle
,
'>'
,
$filename
) {
pass(
'Open temporary file'
)
}
else
{
diag
"OS error: $!"
;
fail(
'Open temporary file'
);
}
print
$write_handle
"Karl is awesome!\n"
;
my
$write_only_object
= new Local::Data;
my
$write_only_payload
=
$write_only_object
->payload;
dies_ok {
$write_only_payload
->{dataField} =
$write_handle
; }
'Put a write-only object into payload'
;
undef
$write_only_payload
;
undef
$write_only_object
;
close
$write_handle
;
if
(
unlink
$closed_file
) {
pass(
'Delete temporary file'
);
}
else
{
diag
"OS error: $!"
;
fail(
'Delete temporary file'
);
}
if
(
unlink
$filename
) {
pass(
'Delete temporary file'
);
}
else
{
diag
"OS error: $!"
;
fail(
'Delete temporary file'
);
}
if
(
rmdir
$tempdir
) {
pass(
'Delete temporary directory'
);
}
else
{
diag
"OS error: $!"
;
fail(
'Delete temporary directory'
);
}
umask
$orig_umask
if
defined
$orig_umask
;
my
(
$pipe_read
,
$pipe_write
);
pipe
$pipe_read
,
$pipe_write
;
ok(!
seek
(
$pipe_write
, 2, SEEK_CUR),
"Make sure we can't seek"
);
my
$seek_object
= new Local::Data;
my
$seek_payload
=
$seek_object
->payload;
dies_ok {
$seek_payload
->{dataField} =
$pipe_write
; }
'Set the pipe as the payload'
;
undef
$seek_payload
;
undef
$seek_object
;
close
$pipe_write
;
close
$pipe_read
;
done_testing();