The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl LMS.t'

#########################

use Test::More;
use Encode;
BEGIN { plan tests => 37};
use BS2000::LMS qw(:returncodes);
ok(1); # 1 use was OK

# 2..5: INIT

$library = new BS2000::LMS '$.SYSLIB.CRTE';
ok(defined $library, 'LMS API initialised');
is($library->{return_code}, LMSUP_OK, 'returncode (new)');
is($library->message(), '', 'diagnostics (new)');
like($library->{lms_version}, qr/^\d\d\.\d([A-D]\d\d)?$/, 'LMS version');

# 6..21: TOCPRIM/TOC

@toc_of_cstd = $library->list(type => 'S',
			      name => 'CSTD*',
			      user_time => '<06:20>*', # hopefully they use
                                                       # "normal" hours for
                                                       # integration ;-)
);
is($library->{return_code}, LMSUP_EOF, 'returncode (list)');
is($library->message(), '', 'diagnostics (list)');
ok(defined @toc_of_cstd, 'no error occured (list)');
ok(3 <= @toc_of_cstd, 'at least 3 includes CSTD* in CRTE');
ok(defined $toc_of_cstd[0]{name}, 'name of first CSTD* in CRTE defined');
is($toc_of_cstd[0]{name}, 'CSTDARG', 'first CSTD* in CRTE is CSTDARG');
like($toc_of_cstd[0]{version}, qr/^V\d\d\.\d([A-D]\d\d)?$/, 'element version');
is($toc_of_cstd[1]{storage_form}, 'V', 'storage form is V');
is($toc_of_cstd[2]{secondary_name}, '', 'secondary name is empty');
is($toc_of_cstd[0]{secondary_attribute}, '', 'secondary attribute is empty');
like($toc_of_cstd[1]{user_date},
     qr/^(?:19|20)\d\d-(?:0[1-9]|1[012])-(?:0[1-9]|[12][0-9]|3[01])/,
     'user date looks like a correct date');
like($toc_of_cstd[2]{user_time}, qr/^\d\d:\d\d:\d\d/,
     'user time look like a correct time');
like($toc_of_cstd[0]{creation_date},
     qr/^20\d\d-(?:0[1-9]|1[012])-(?:0[1-9]|[12][0-9]|3[01])/,
     'creation date is 20*');
like($toc_of_cstd[1]{creation_time}, qr/^\d\d:\d\d:\d\d/,
     'creation time look like a correct time');
like($toc_of_cstd[2]{modification_date},
     qr/^20\d\d-(?:0[1-9]|1[012])-(?:0[1-9]|[12][0-9]|3[01])/,
     'modification date is 20*');
like($toc_of_cstd[0]{modification_time}, qr/^\d\d:\d\d:\d\d/,
     'modification time look like a correct time');

# 22..26: extract

use constant TESTFILE => 'CSTDARG';

$tempfile = '/tmp/LMS.t.'.$$;
$count_out = $library->extract($tempfile, type => 'S', name => TESTFILE);
is($library->{return_code}, LMSUP_OK, 'returncode (extract)');
is($library->message(), '', 'diagnostics (extract)');
ok(50 < $count_out && -s $tempfile, 'something written (extract)');
is((stat(_))[7], $count_out, 'correct size (extract, '.$count_out.')');
ok(0 == system('diff /usr/include/'.lc(TESTFILE).' '.$tempfile.' >/dev/null'),
   'correct content (extract)');

# 27..33: add
$templib = 'LMS.T.TESTLIB.'.$$;
$test_lib = new BS2000::LMS $templib;
ok(defined $test_lib, 'TESTLIB created');
is($test_lib->{return_code}, LMSUP_OK, 'returncode (new)');
is($test_lib->message(), '', 'diagnostics (new)');
$count_in = $test_lib->add($tempfile, type => 'S', name => TESTFILE);
ok(50 < $count_in, 'something written (add)');
ok($count_in == $count_out, 'correct size (add, '.$count_in.')');
system('/bin/rm', '-f', $tempfile);
$count_out = $test_lib->extract($tempfile, type => 'S', name => TESTFILE);
ok($library->{return_code} == LMSUP_OK  &&  '' eq $library->message(),
   'extract OK (add)');
ok(0 == system('diff /usr/include/'.lc(TESTFILE).' '.$tempfile.' >/dev/null'),
   'correct content (add)');

# 34..37: add/extract with raw PerlIO:
$count_in = $test_lib->add(['<:raw', $tempfile],
			   type => 'S', name => TESTFILE);
ok(50 < $count_in, 'something written (Encode)');
ok($count_in == $count_out, 'correct size (Encode, '.$count_in.')');
system('/bin/rm', '-f', $tempfile);
$count_out = $test_lib->extract(['>:raw', $tempfile],
				type => 'S', name => TESTFILE);
ok($library->{return_code} == LMSUP_OK  &&  '' eq $library->message(),
   'extract OK (Encode)');
ok(0 == system('diff /usr/include/'.lc(TESTFILE).' '.$tempfile.' >/dev/null'),
   'correct content (Encode)');

# delete temporaries
$test_lib = undef;		# close library (call destructor)
system('/bin/rm', '-f', $tempfile);
system('bs2cmd "DELETE-FILE '.$templib.'"');

# from here on: "delete l8r"

__END__

foreach my $elem (@toc)
{
    print $elem->{$_}, ' '
	foreach (qw(type name version storage_form
		    secondary_name secondary_attribute
		    user_date user_time
		    creation_date creation_time
		    modification_date modification_time
		    access_date access_time
		    hold_state holder element_size));
    printf " %03o\n", $elem->{mode};
}

# search for memory-leaks:
if (0)
{

    print "check memory (before loop)\n";
    sleep 30;
    print "continue ...\n";
    foreach my $count (1..1000)
    {
	my @toc = $library->list();
    }
    print "check memory (after loop)\n";
    sleep 300;
    print "finish ...\n";
}