The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

use strict;

BEGIN   { $| = 1; print "1..12\n"; }
END     { print "not ok 1\n" unless $::XBaseloaded; }

$| = 1;

print "Load the module: use XBase\n";
use XBase;
$::XBaseloaded = 1;
print "ok 1\n";

my $dir = ( -d "t" ? "t" : "." );

$XBase::Base::DEBUG = 1;        # We want to see any problems


print "Open table $dir/ndx-char\n";
my $table = new XBase "$dir/ndx-char" or do
	{
	print XBase->errstr, "not ok 2\n";
	exit
	};
print "ok 2\n";


print "prepare_select_with_index\n";
my $cur = $table->prepare_select_with_index("$dir/ndx-char.ndx") or
	print $table->errstr, 'not ';
print "ok 3\n";


my $result = '';
print "Fetch all data\n";
while (my @data = $cur->fetch)
	{ $result .= "@data\n"; }

my $expected_result = '';
my $line;
while (defined($line = <DATA>))
	{ last if $line eq "__END_DATA__\n"; $expected_result .= $line; }

if ($result ne $expected_result)
	{ print "Expected:\n${expected_result}Got:\n${result}not "; }
print "ok 4\n";


print "find_eq('6g') and fetch\n";
$cur->find_eq('6g');
$result = ''; $expected_result = '';
while (my @data = $cur->fetch())
	{ $result .= "@data\n"; }
while (defined($line = <DATA>))
	{ last if $line eq "__END_DATA__\n"; $expected_result .= $line; }

if ($result ne $expected_result)
	{ print "Expected:\n${expected_result}Got:\n${result}not "; }
print "ok 5\n";

print "find_eq('6e') and fetch (it doesn't exist, so the result should be the same)\n";
$cur->find_eq('6e');
$result = '';
while (my @data = $cur->fetch())
	{ $result .= "@data\n"; }

if ($result ne $expected_result)
	{ print "Expected:\n${expected_result}Got:\n${result}not "; }
print "ok 6\n";

print "Before we look at the numeric and data index files, let's check
if it makes sense (because of the way we implement double floats ;-)\n";

my $doubleoneseven = pack 'd', 1.7;
my $okoneseven = '3ffb333333333333';

if (join('', unpack 'H16', $doubleoneseven) ne $okoneseven
	and join('', unpack 'H16', reverse($doubleoneseven)) ne $okoneseven)
	{
	print "Number 1.7 encoded as natural double on your machine gives ",
		join('', unpack 'H16', $doubleoneseven),
		",\nwhich is not what I would expect.\n";
	print STDERR <<EOF;

	The following tests will probably fail because your machine
	encodes double numbers differently than XBase::Index expects.
	If they do, you can still use XBase and DBD::XBase. Send me
	perl -V and make test TEST_VERBOSE=1 and I will see what we
	could do about it.
EOF
	}
else
	{ print "Looks good.\n"; }


print "Open ndx-num and index\n";
$table = new XBase "$dir/ndx-num.dbf" or print XBase->errstr, 'not ';
print "ok 7\n";
$cur = $table->prepare_select_with_index("$dir/ndx-num.ndx") or
					print $table->errstr, 'not ';
print "ok 8\n";

print "find_eq(1042) and fetch results\n";
$cur->find_eq(1042);
$result = ''; $expected_result = '';
while (my @data = $cur->fetch())
	{ last if $data[0] != 1042; $result .= "@data\n"; }
while (defined($line = <DATA>))
	{ last if $line eq "__END_DATA__\n"; $expected_result .= $line; }

if ($result ne $expected_result)
	{ print "Expected:\n${expected_result}Got:\n${result}not "; }
print "ok 9\n";


print "Open ndx-date and index\n";
$table = new XBase "$dir/ndx-date.dbf" or print XBase->errstr, 'not ';
print "ok 10\n";
$cur = $table->prepare_select_with_index("$dir/ndx-date.ndx") or
					print $table->errstr, 'not ';
print "ok 11\n";

print "find_eq(2450795), which is Julian date for 1997/12/12 and fetch results\n";

### use Data::Dumper;
### print Dumper $cur;

$cur->find_eq(2450795);

### print Dumper $cur;

$result = ''; $expected_result = '';
while (my @data = $cur->fetch())
	{ $result .= "@data\n"; }
while (defined($line = <DATA>))
	{ last if $line eq "__END_DATA__\n"; $expected_result .= $line; }

if ($result ne $expected_result)
	{ print "Expected:\n${expected_result}Got:\n${result}not "; }
print "ok 12\n";



__END__
1
1
10
10
15
1z
2
2
2h
2z
3
3
3a
4
4
4e
5
5
5b
6
6
6g
7
7
8
8
8d
9
__END_DATA__
6g
7
7
8
8
8d
9
__END_DATA__
1042
1042
1042
1042
1042
1042
__END_DATA__
19971212
19971212
19971212
19971213
19971213
19971213
19971214
19971214
19971214
19971215
19971215
19971215
19971216
19971216
19971216
__END_DATA__